home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBT41S1.ZIP / GETAUTOF.MOD < prev    next >
Encoding:
Text File  |  1988-02-15  |  5.9 KB  |  143 lines
  1. (*----------------------------------------------------------------------*)
  2. (* Get_Auto_File_Name --- Get transfer file name from prior kbd input   *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Get_File_Name_From_String( VAR Name_String : AnyStr;
  6.                                      VAR FileName    : AnyStr;
  7.                                          Period_Last : BOOLEAN );
  8.  
  9. (*----------------------------------------------------------------------*)
  10. (*                                                                      *)
  11. (*     Procedure:  Get_File_Name_From_String                            *)
  12. (*                                                                      *)
  13. (*     Purpose:    Gets file name from a string                         *)
  14. (*                                                                      *)
  15. (*     Calling Sequence:                                                *)
  16. (*                                                                      *)
  17. (*        Get_File_Name_From_String( VAR Name_String : AnyStr;          *)
  18. (*                                   VAR FileName    : AnyStr;          *)
  19. (*                                       Period_Last : BOOLEAN );       *)
  20. (*                                                                      *)
  21. (*----------------------------------------------------------------------*)
  22.  
  23. VAR
  24.    Dot_Pos : INTEGER;
  25.    I       : INTEGER;
  26.    K       : INTEGER;
  27.    L       : INTEGER;
  28.    AllDigs : BOOLEAN;
  29.  
  30. (* STRUCTURED *) CONST
  31.    Legal_File_Name_Chars : SET OF CHAR = ['A'..'Z','0'..'9','$','&',
  32.                                           '#','%','''','(',')','-',
  33.                                           '@','^','{','}','~','`',
  34.                                           '!','_'];
  35.  
  36. BEGIN (* Get_Auto_File_Name *)
  37.  
  38.                                    (* Null file name to start *)
  39.    FileName := '';
  40.                                    (* No '.' in Name_String --    *)
  41.                                    (* no file name then, so exit. *)
  42.    L := LENGTH( Name_String );
  43.  
  44.    IF ( L = 0 ) THEN EXIT;
  45.  
  46.    Dot_Pos := POS( '.' , Name_String );
  47.  
  48.    IF ( Dot_Pos > 0 ) THEN
  49.       BEGIN
  50.                                    (* Pick up first part of file name *)
  51.          I := PRED( Dot_Pos );
  52.          K := 8;
  53.          WHILE ( ( I > 0 ) AND
  54.                  ( K > 0 ) AND
  55.                  ( UpCase( Name_String[I] ) IN Legal_File_Name_Chars ) ) DO
  56.             BEGIN
  57.                FileName := Name_String[I] + FileName;
  58.                DEC( I );
  59.                DEC( K );
  60.             END;
  61.                                    (* Insert '.' *)
  62.  
  63.          FileName := FileName + '.';
  64.  
  65.                                    (* Pick up file extension *)
  66.  
  67.          I       := SUCC( Dot_Pos );
  68.          K       := 3;
  69.          AllDigs := TRUE;
  70.  
  71.          WHILE ( ( I <= L ) AND
  72.                  ( K >  0 ) AND
  73.                  ( UpCase( Name_String[I] ) IN Legal_File_Name_Chars ) ) DO
  74.             BEGIN
  75.                FileName := FileName + Name_String[I];
  76.                AllDigs  := AllDigs AND ( Name_String[I] IN Digits );
  77.                INC( I );
  78.                DEC( K );
  79.             END;
  80.  
  81.       END;
  82.                                    (* Nuke filename whose extension  *)
  83.                                    (* is all digits.  It's probably  *)
  84.                                    (* a program version number rather*)
  85.                                    (* than a file name.              *)
  86.  
  87.    IF ( AllDigs AND ( K < 3 ) ) THEN
  88.       FileName := ''
  89.                                    (* If we don't allow file name to *)
  90.                                    (* end in period, and it does,    *)
  91.                                    (* nuke filename.                 *)
  92.  
  93.    ELSE IF ( FileName[ LENGTH(FileName) ] = '.' ) THEN
  94.       IF ( NOT Period_Last ) THEN
  95.          FileName := '';
  96.  
  97. END   (* Get_Auto_File_Name *);
  98.  
  99. (*----------------------------------------------------------------------*)
  100. (* Get_Auto_File_Name --- Get transfer file name from prior kbd input   *)
  101. (*----------------------------------------------------------------------*)
  102.  
  103. PROCEDURE Get_Auto_File_Name( VAR Keybrd_Line : AnyStr;
  104.                               VAR FileName    : AnyStr );
  105.  
  106. (*----------------------------------------------------------------------*)
  107. (*                                                                      *)
  108. (*     Procedure:  Get_Auto_File_Name                                   *)
  109. (*                                                                      *)
  110. (*     Purpose:    Gets transfer file name from prior kbd input or      *)
  111. (*                 screen display.                                      *)
  112. (*                                                                      *)
  113. (*     Calling Sequence:                                                *)
  114. (*                                                                      *)
  115. (*        Get_Auto_File_Name( VAR Keybrd_Line : AnyStr;                 *)
  116. (*                            VAR FileName    : AnyStr );               *)
  117. (*                                                                      *)
  118. (*----------------------------------------------------------------------*)
  119.  
  120. VAR
  121.    Y : INTEGER;
  122.    S : AnyStr;
  123.  
  124. BEGIN (* Get_Auto_File_Name *)
  125.                                    (* Try current keyboard input *)
  126.  
  127.    Get_File_Name_From_String( Keybrd_Line , FileName , TRUE );
  128.  
  129.                                    (* Exit if file name found *)
  130.    IF ( FileName <> '' ) THEN EXIT;
  131.  
  132.                                    (* Scan screen contents from current *)
  133.                                    (* line back to top of screen.       *)
  134.    Y := WhereY;
  135.  
  136.    WHILE ( ( Y > 0 ) AND ( FileName = '' ) ) DO
  137.       BEGIN
  138.          Get_Screen_Text_Line     ( S , Y , 1 );
  139.          Get_File_Name_From_String( S , FileName , FALSE );
  140.          DEC( Y );
  141.       END;
  142.  
  143. END   (* Get_Auto_File_Name *);