Stars of Shareware: DFÜ und Kommunikation/SOS-DFUE.ISO/programm/dos/terminal/depty309/scripts.exe/FILEPICK.DSL

Text File | 1993-10-15 | 10.7 KB | 288 lines

(*   FilePick.DSL script  V.1.1  by Michael Spalter July 1992

    This script mostly consists of a pair of user defined
    functions which provide the user with a file picklist.
    The user can also move around the directory structure by
    selecting parent and sub-directories.

    This script should be considered as an excellent example
    of a DSL program, especially with regard to screen
    management, string handling and mathematical calculations.
    The script contains all major constuctions supported by
    DSL and a good selection of DSL functions and procedures.

    There are two shortcomings of this script program, in
    order to keep it simpler than it might be otherwise.
    Ideally, all subdirectories would be in the list of
    files, regardless of the wildcard; as it stands,
    subdirectories are only shown if the directory matches
    the wildcard, (e.g. *.* or *.). Secondly, this file
    picker does not support scrolling so if a directory has
    more than 80 files, on the first 80 are shown.  Users
    may wish to add these features themselves as en exercise.
    Also, users who are fairly proficient in DSL will also
    spot several areas in which this script could be made to
    run more efficiently, including some major changes to
    the way it works. If we optimised this script, it would
    be very difficult to comprehend for many users so we submit
    it as it is as a working example. Deleting the comments
    throughout this file will make it substantially shorter,
    but please leave the comments in if you intend redistributing
    the file as it is most useful to others that way.

    ASKFILENAME is the main function which does most of the
    work; GETNAME is used by ASKFILENAME. The main body
    of the script consists of only nine lines, which you will
    find right at the bottom. It simply calls the ASKFILENAME
    function and then loads the file selected into Deputy's
    built in text editor. This is a somewhat trivial example,
    and no doubt you will have better uses for these functions. *)


Script FilePick;    (* This is the start of the script *)

(* There are only two variables used by the main script,
   which must always be defined here at the start. 'SELECTED'
   is the string used to store the filename eventually selected.
   'USERSPEC' is the wildcard or filespec which the user enters  *)

VAR Selected : STRING[30];   (* It may include a path, hence the length *)
    UserSpec : STRING[30];

(* Now we go straight into defining our own functions.
   The GETNAME function takes two arguments: an integer and
   a string. The function returns a filename corresponding
   to the position in the directory specified by the integer
   argument. The string contains a wildcard or 'filespec'
   which the file should match, for example '*.*' or '*.txt'

   Note that the first thing we do is define the variable
   which we use in the function. These are specific to
   this function only and may not be shared by any other
   function or procedure.                                      *)

FUNCTION GetName(Position : INTEGER; Wildcard : STRING) : STRING;
VAR
Filename : STRING[12];   Attrib : INTEGER;
Found : BOOLEAN;         Round : INTEGER;
BEGIN
Found := DirFirst(Wildcard,16,Filename,Attrib);
   IF Position>1 THEN
     For Round := 1 TO (Position-1) DO
     Found:=DirNext(Filename,Attrib);
     END;
   END;
   IF (Attrib AND 16)=16 THEN   (*  Is it a directory ?  If so,    *)
   Filename:='['+Filename+']';  (*  enclose it in square brackets  *)
   END;
Return(Filename);
END GetName;

(* And now we define the large function 'ASKFILENAME' *)

FUNCTION AskFilename(Wildcard : STRING) : STRING;
VAR
Filename : STRING[12];  CurName: STRING[12];
Found : BOOLEAN;        Whandle : INTEGER;
Attrib : INTEGER;       Count : INTEGER;
Round : INTEGER;        Current : INTEGER;
Key : INTEGER;          Next : INTEGER;
Line : INTEGER;         Row : INTEGER;
Xoffset : INTEGER;      Yoffset : INTEGER;
WinWidth : INTEGER;     Winheight : INTEGER;
ReDisplay : BOOLEAN;    OrigDir : STRING[30];
NewName : STRING[30];   XRound : INTEGER;

BEGIN
ReDisplay:=TRUE;
OrigDir:=CurrentDir;
Escape(FALSE);
Key:=0; Round:=0;
Cursor(FALSE);  ClrScr;

(* First we test whether the submitted wildcard is a plain
   path name, without any wildcard. We use the ChDir
   function which returns TRUE if the directory change was
   successful. There is also allowance for the user entering
   just a drive name, such as 'C:'. If this section determines
   that it is just a directory, then the wildcard defaults to
   *.* in that directory.                                           *)

  Found:=ChDir(Wildcard);
  IF Found OR ((Slice(Wildcard,1,1)=":") AND (Length(Wildcard)=2)) THEN
  Chdir(Wildcard);
  WildCard:='*.*';
  END;

  (* If it wasn't a plain path it must either be a
     combined path and wildcard or just a wildcard.
     This function has to be fairly robust in that
     a user can potentially enter any combination of
     drive, path and filename wildcard.

     Now we check if the wildcard contain a '\'
     character - if it does, then we can assume that
     it contains a pathname. So we now run through
     the string, character by character, continuously
     searching for a valid path. Once we get to the end of
     the string, we separate the last valid path found from
     anything which followed it. Anything which followed
     it is assumed to be a filename wildcard.                  *)

  IF ( POS(Wildcard,'\')<>-1 ) THEN
  Round:=1;
     REPEAT
     Found:=ChDir(Slice(Wildcard,0,Round));
     IF Found THEN Count:=Round; END;
     INC(Round);
     UNTIL Round=Length(Wildcard);
  WildCard:=Slice(Wildcard,Count,(Length(Wildcard)-Count));
  END;

   (* Now we check for any drive designations which are
      redundant as they were taken care of earlier. If
      we find anything like 'C:' we chop it off.           *)

     IF Slice(Wildcard,1,1)=':' THEN
     WildCard:=Slice(Wildcard,2,(Length(Wildcard)-2));
     END;

   (* And finally we chop off any leading '\' characters   *)

     IF  Slice(Wildcard,0,1)='\' THEN
     Wildcard:= Slice(Wildcard,1,(Length(Wildcard)-1));
     END;

  (* This next section is the continous loop which
     only exits once a file has been selected.     *)

  While ReDisplay AND (Key<>27) DO

  (* First we count the number of files in the
     directory which match the wildcard.       *)

  Found:=DirFirst(Wildcard,16,Filename,Attrib);
  IF Filename='' THEN ChDir(OrigDir); RETURN(''); END;
  Count:=1; Key:=0;
     WHILE Found AND (COUNT<81) DO
     Found:=DirNext(Filename,Attrib);
     INC(count);
     END;
     DEC(Count);
     IF Count<4 THEN
     WinWidth:=(Count*15);
     ELSE WinWidth:=60;
     END;
  IF Count>80 THEN Count:=80; END;

(* Now, using that information, we calculate the size
   of window required. This program is currently limited
   to 80 files as it does not support scrolling   *)

  WinHeight:=(((COUNT+1) DIV 4)+2);
    IF (COUNT MOD 4)=0 THEN DEC(WinHeight); END;
    IF Winheight>21 THEN WinHeight:=21; END;
    IF Slice(CurrentDir,Length(CurrentDir)-1,1)<>'\' THEN
    CurName:='\';  ELSE CurName:='';   END;
  Whandle := Window(5,2,WinWidth,WinHeight,
     (' '+CurrentDir+CurName+Wildcard+' '),27);
  UseWindow(Whandle);

  (*  Now that we've drawn the window and selected it,
      we can display all of the filenames:   *)

  Found:=DirFirst(Wildcard,16,Filename,Attrib);
  Count:=1;
     WHILE (Found AND (Count<81)) DO
     Row:=((((Count-1) MOD 4)*15)+1);
     Line:=((Count-1) DIV 4);
          IF (Attrib AND 16)=16 THEN Filename:='['+Filename+']'; END;
     GoToXY(Row,Line); Write(Filename);
     Found:=DirNext(Filename,Attrib);
     INC(count);
     END;

  DEC(count);
  Current := 1;
  While Keypressed DO Rdkey; END;  (* This clears the keyboard buffer *)

  (* Now we start the loop which moves the highlight bar
     around the screen. This loop only exits when the  user
     presses <ENTER> to select a file/dir or presses ESCAPE.  *)

    Cursor(FALSE);
    While (Key<>13) AND (Key<>27) DO
    Line:=((Current-1) DIV 4);
    Row:=((((Current-1) MOD 4)*15)+1);
    CurName:=GetName(Current,Wildcard);
       REPEAT
       BackGnd(Red); ForeGnd(Yellow);      (* This re-writes the current  *)
       GoToXY(Row,Line); Write(CurName);   (* filename in highlighed text *)
       REPEAT UNTIL KeyPressed;
       Key:=RdKey;
         Case Key OF
         328: Next:=Current-4; |    (* UP    *)
         336: Next:=Current+4; |    (* DOWN  *)
         331: Next:=Current-1; |    (* LEFT  *)
         333: Next:=Current+1; |    (* RIGHT *)
         END;
     BackGnd(Blue); ForeGnd(LCyan);
     GoToXY(Row,Line); Write(CurName);          (* Re-write in normal text *)
         IF  (Next<1) OR (Next>Count) THEN Next:=Current; END;
       UNTIL (Next<>Current) OR (Key=13) OR (Key=27);

   (* This point is only reached once the user has selected something *)

     Current:=Next; ReDisplay:=False;

     (* Now, we test if the selection is a directory and
        if it is, we change to that directory and then
        set a special flag 'ReDisplay' to tell the script that
        the directory needs redrawing  *)

        IF (Slice(CurName,0,1)='[') THEN

        ReDisplay:=TRUE;
        END;
     END;

  (* This point is only reached once either another directory
     has been selected, a file has been selected or ESCAPE has
     been pressed.                                               *)

     ChDir(Slice(CurName,1,(LENGTH(Curname)-2))) ;
     CloseWindow(Whandle);
  END;

   (* This point is only reached if a new dir was NOT selected  *)

   Cursor(TRUE);
   IF Key=27 THEN      (* Did the user press ESCAPE ?  *)
   NewName:=''; ELSE
   IF Slice(CurrentDir,Length(CurrentDir)-1,1)<>'\' THEN
   CurName:='\' ELSE CurName:=''; END;
   NewName:=CurrentDir+CurName+GetName(Current,Wildcard);

   END;
BackGnd(Black); ForeGnd(White); GotoXY(0,WhereY);
ChDir(OrigDir);   (* Change back to the original directory *)
Return(NewName);  (* And restore all colours to normal  *)
END AskFilename;

BEGIN              (*    Main Program body starts here
                         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^      *)

ClrScr;
Write('Please enter a filespec [*.*]: ');
Read(UserSpec);
Selected:=AskFilename(UserSpec);
  IF Selected='' THEN
  Write('You did not select any file !\n\r');
    ELSE
    Write('You selected the file :');
    WrStr(Selected);
  END;
WrLn; WrLn;
Cursor(TRUE);
END FilePick.