; Copyright (c) 1987-1989 Borland International.  All Rights Reserved.
;
; General permission to re-distribute all or part of this script is granted,
; provided that this statement, including the above copyright notice, is not
; removed.  You may add your own copyright notice to secure copyright
; protection for new matter that you add to this script, but Borland
; International will not support, nor assume any legal responsibility for,
; material added or changes made to this script.
;
; Revs.:  MJP 5/20/87, DCY 12/13/88
; ****************************************************************************
; GetFile prompts a user to enter a file name in Paradox fashion.  That is, a
; user can either enter a file name or just press [Enter] for a sub-menu of
; files in the current (or otherwise specified) directory.
;
; If a user presses [Esc], GetFile returns a null ("") string.  Otherwise, it
; returns the file name selected.
;
; GetFile requires the following arguments:
;
;    Mask: File mask of acceptable file names and files to be displayed in
;          sub-menu (e.g. "??Table.DB", "*.SC")
;   Prmpt: Prompt to appear on top prompt line (e.g., "Table:", "Script:")
;     Msg: Message to display underneath prompt line
;   FName: Default file name (or null string "" for none)
;     Rqd: (Logical) If True, requires file name to already exist
;
; NOTE:  There is no way to specify that the file cannot exist, because it
;        is not clear what to do if it does.  (Put up a "Cancel/Replace"
;        menu?  Put up a Cancel/Modify/Replace menu?  Disallow the
;        selection entirely?)
;
Proc GetFile(Mask,Prmpt,Msg,FName,Rqd)
   Private;Mask        ;Specifies which files to display
          ;Prmpt       ;Top prompt line
          ;Msg         ;Second prompt line
          ;FName       ;Currently selected file name
          ;Rqd         ;Determines whether file must already exist
           Ext,        ;Stores the file extension of the mask
           OldMask,    ;Stores the original mask, as it is subject to change
           OldFName,   ;Stores current FName before destroyed by show command
           AWidth,     ;Maximum width for Accept, based upon length of Prmpt
           X           ;General purpose scratch variable

   X = Match(Mask,"..\".\"..",X,Ext)
   Ext = "." + Upper(Ext)
   OldMask = Mask
   AWidth = "A"+Strval(79-Len(Prmpt))

   Style Attribute AtMenu
   While True
      Canvas Off
      @ 0,0             ;Display prompt information
      ?? Spaces(80)+Msg+Spaces(80-Len(Msg))
      @ 0,0
      ?? Prmpt+" "
      Canvas On
      Accept AWidth                         ;Accept the file name
         Default FName
      To FName
      Switch
         Case not Retval:                   ;Esc was pressed
            Style
            Return ""
         Case IsBlank(FName) or DirExists(FName)=1: ;Enter was pressed
            If Match(FName,"..@",X,X)               ;Is FName non-blank?
               Then If X <> "\\" and X <> ":"       ;Is last character "\"?
                       Then FName = FName+"\\"      ;Append backslash to
                    Endif                           ; directory name
                    X = Search(".",Mask)-1          ;Remove dirname from mask
                    While Substr(Mask,X,1) <> "\\" and Substr(Mask,X,1) <> ":"
                          and X > 0
                       X = X-1
                    Endwhile
                    Mask = FName+Substr(Mask,X+1,255);Ignore specified
            Endif                                   ; directory name since the
            OldFName = FName                        ; user specified one
            ShowFiles                         ;Show specified files
               NoExt
               Mask
               Prmpt+" "+FName
            To FName
            If FName = "None"                 ;No files were selected by Mask
               Then Message "None found"
            Endif
            If FName = "Esc" or FName = "None"  ;User did not select a file
               Then FName = OldFName        ;Restore user-specified file name
                    Mask = OldMask          ;Restore original mask value
               Else Style
                    Return OldFName+FName   ;Attach path name to file name
            Endif
         Case Rqd:                          ;File must already exist
            Switch
               Case DirExists(FName) = -1:  ;Assumes valid directory names
                  Message "Invalid file name"  ; are valid file names
               Case IsFile(FName+Ext):
                  Style
                  Return FName
               Otherwise:
                  Message FName+" does not exist"
            Endswitch
         Otherwise:                         ;We don't care if file name exists
            If DirExists(FName) = -1        ;Make sure it's a valid name
               Then Message "Invalid file name"
               Else If Substr(FName,Len(FName),1) = "\\"
                       Then Message FName+" does not exist"
                       Else Style
                            Return FName
                    Endif
            Endif
      Endswitch
   Endwhile
Endproc