(* -------------------------------------------------------------------------
  :Program.       FileRequest
  :Author.        Kai Bolay
  :Address.       Hoffmannstraße 168, 7250 Leonberg
  :Phone.         07152/22135
  :History.       v1.30 Kai 24-Nov-89 Released on Amok #29
  :History.       v2.00 Kai 21-Jan-90 Rewritten large parts (read .dok-File)
  :History.       v2.01 Kai 16-Feb-90 Recompiled with v3.3
  :Copyright.     Shareware
  :Language.      Modula-2
  :Translator.    M2Amiga 3.3d
  :Contents.      Introducing: Easy & reentrant File-requesting...
------------------------------------------------------------------------- *)

IMPLEMENTATION MODULE FileRequest;

(* I hope that there are no more Errors... $F- $R- $S- $V- *)

(* FOLD: IMPORT *)
FROM SYSTEM      IMPORT ADR, LONGSET, ADDRESS;
FROM Str         IMPORT Compare, Copy, Length, Concat, LastPos, noOccur;
FROM Dos         IMPORT FileInfoBlockPtr, Lock, UnLock, ParentDir,
                        FileLockPtr, accessRead, IoErr, noMoreEntries,
                        Examine, ExNext, DeviceListPtr, DeviceListType,
                        DosLibraryPtr, DupLock;
FROM Exec        IMPORT WaitPort, GetMsg, ReplyMsg, Forbid, Permit, UByte,
                        AllocMem, FreeMem, MemReqs, MemReqSet;
FROM Graphics    IMPORT RastPortPtr, jam1, jam2, RectFill, SetAPen,
                        TextAttr, FontStyles, FontStyleSet, FontFlags,
                        FontFlagSet;
FROM Intuition   IMPORT DisplayBeep, Gadget, GadgetPtr, PropInfo,
                        customScreen, StringInfo, IntuiMessagePtr,
                        IntuiText, Border, WindowPtr, IDCMPFlagSet,
                        IDCMPFlags, ScreenPtr, Image, RefreshGList,
                        RefreshGadgets, NewModifyProp, maxBody, maxPot,
                        PropInfoFlags, PropInfoFlagSet, NewWindow,
                        GadgetFlags, GadgetFlagSet, boolGadget, strGadget,
                        propGadget, ActivationFlags, OpenWorkBench,
                        ActivationFlagSet, WindowFlags, WindowFlagSet,
                        OpenWindow, CloseWindow, ScreenFlags, ScreenFlagSet,
                        DoubleClick, AddGList, IntuiTextPtr, BorderPtr;
IMPORT Strings, Dos;
(* ENDFD *)

(* FOLD: Disky *)
PROCEDURE Disky (VAR DI: DiskyInfo) : BOOLEAN;

(* FOLD: CONST *)
CONST MaxFL = 30;  (* File, Dir (max. Länge der Strings) *)
      MaxPL = 150; (* Pfad *)
      MaxSL = 8;   (* Suffix *)
      MaxDL = 8;   (* Device *)

      StdGPen  = 2; (* Gadget (Farbe der Elemente) *)
      StdFPen  = 0; (* File *)
      StdDPen  = 3; (* Dir *)
      StdBFPen = 1; (* Hintergrund *)

      MinFileID = 1;  MaxFileID = 10; (* Gadget IDs (allgemein) *)
      MinPathID = 12; MaxPathID = 13;
      MinDevID  = 14; MaxDevID  = 22;
      MinEndID  = 26; MaxEndID  = 27;

      PropID   = 11; (* Gadget IDs (speziell) *)
      RootID   = 12;
      ParentID = 13;
      DirID    = 23;
      FileID   = 24;
      SuffixID = 25;
      OKID     = 26;
(* ENDFD *)
(* FOLD: TYPE *)
TYPE StringType     = (file, dir);
     ProgStatus     = (begin, read, waiting);
     StringPtr      = POINTER TO ARRAY [0..999] OF CHAR;
     Pairs          = ARRAY [1..10] OF ARRAY [0..1] OF INTEGER;
     StringEntryPtr = POINTER TO StringEntry;
     StringEntry    = RECORD
                         succ : StringEntryPtr;
                         type : StringType;
                         text : ARRAY [0..MaxFL] OF CHAR;
                      END; (* RECORD *)
     StringListPtr  = POINTER TO StringList;
     StringList     = RECORD
                         num  : CARDINAL;
                         head : StringEntryPtr;
                      END; (* RECORD *)
     GadStuff       = RECORD
                         FileITxt    : ARRAY [1..10] OF IntuiText;
                         FileTxt     : ARRAY [1..10] OF ARRAY [0..MaxFL] OF CHAR;
                         StrITxt     : ARRAY [1..3] OF IntuiText;
                         (* StrTxt is CONST *)
                         DevITxt     : ARRAY [1..12] OF IntuiText;
                         DevTxt      : ARRAY [1..12] OF ARRAY [0..MaxDL] OF CHAR;
                         PathITxt    : ARRAY [1..2] OF IntuiText;
                         (* PathTxt is CONST *)
                         EndITxt     : ARRAY [1..2] OF IntuiText;
                         (* EndTxt is CONST *)
                         NumDevs     : [0..12];
                         File        : ARRAY [1..10] OF Gadget;
                         Prop        : Gadget;
                         Path        : ARRAY [1..2] OF Gadget;
                         Str         : ARRAY [1..3] OF Gadget;
                         Dev         : ARRAY [1..9] OF Gadget;
                         End         : ARRAY [1..2] OF Gadget;
                         StrInfo     : ARRAY [1..3] OF StringInfo;
                         MyPropInfo  : PropInfo;
                         UndoBuffer  : ARRAY [0..300] OF CHAR;
                         KnobImage   : Image;
                         BoolBorder  : Border;
                         BoolPairs   : Pairs;
                         StrBorder   : Border;
                         StrPairs    : Pairs;
                         SufBorder   : Border;
                         SufPairs    : Pairs;
                         HyperBorder : Border;
                         HyperPairs  : Pairs;
                      END; (* RECORD *)
     GadStuffPtr    = POINTER TO GadStuff;
(* ENDFD *)
(* FOLD: VAR *)
VAR MyFIBPtr       : FileInfoBlockPtr;
    DiskyWindowPtr : WindowPtr;
    DiskyRPortPtr  : RastPortPtr;
    Topaz8         : TextAttr;
    GadgetsPtr     : GadStuffPtr;
    ID             : CARDINAL;
    CurrentLockPtr : FileLockPtr;
    BackupLockPtr  : FileLockPtr;
    Directory      : StringList;
    OldTop         : CARDINAL;
    Files          : ARRAY [1..10] OF StringEntryPtr;
    Status         : ProgStatus;
    lastSec, Sec   : LONGCARD;
    lastMic, Mic   : LONGCARD;
    len            : CARDINAL;
(* ENDFD *)

   (* FOLD: BuildRequester *)
   PROCEDURE BuildRequester() : BOOLEAN;

   CONST Parent  = " / ";
         Root    = " : ";
         GOK     = "OK!";
         GCancel = "Abbruch";
         EOK     = "OK!";
         ECancel = "Cancel";
         GDir    = "Ordner";
         GFile   = "Datei";
         GSuf    = "Suffix";
         EDir    = "Drawer";
         EFile   = "File";
         ESuf    = "Suffix";
         BoolWidth = 62;
         FileWidth = 245;
         StrWidth  = 216;
         SufWidth  = 62;
         WinWidth  = 285;

   VAR Pen, Back      : UByte;
       num            : CARDINAL;
       NextPtr        : GadgetPtr;
       DevLeft        : CARDINAL;
       NewDiskyWindow : NewWindow;
       Pos            : INTEGER;

   (* FOLD: MakeText *)
   PROCEDURE MakeText (VAR IText : IntuiText; Left, Top : INTEGER;
                       Text : ADDRESS);
   BEGIN
      WITH IText DO
         frontPen  := Pen;
         backPen   := Back;
         drawMode  := jam2;
         leftEdge  := Left;
         topEdge   := Top;
         iTextFont := ADR (Topaz8);
         iText     := Text;
         nextText  := NIL;
      END; (* WITH *)
   END MakeText;
   (* ENDFD *)
   (* FOLD: MakeGadget *)
   PROCEDURE MakeGadget (VAR NewGadg : Gadget;
                         Left, Top, Width, Height : INTEGER;
                         Activ : ActivationFlagSet; Type : CARDINAL;
                         Render : ADDRESS; Text : IntuiTextPtr;
                         ID : INTEGER; special : ADDRESS; Next : GadgetPtr);
   BEGIN
      WITH NewGadg DO
         nextGadget    := Next;
         leftEdge      := Left;
         topEdge       := Top;
         width         := Width;
         height        := Height;
         flags         := GadgetFlagSet {};
         activation    := Activ;
         gadgetType    := Type;
         gadgetRender  := Render;
         selectRender  := NIL;
         gadgetText    := Text;
         mutualExclude := LONGSET {};
         specialInfo   := special;
         gadgetID      := ID;
         userData      := NIL;
      END; (* WITH *)
   END MakeGadget;
   (* ENDFD *)
   (* FOLD: MakeString *)
   PROCEDURE MakeString (VAR Info : StringInfo; VAR Buffer : ARRAY OF CHAR);

   BEGIN
      WITH Info DO
         buffer     := ADR (Buffer);
         undoBuffer := ADR (GadgetsPtr^.UndoBuffer);
         bufferPos  := 0;
         maxChars   := HIGH (Buffer);
         dispPos    := 0;
      END; (* WITH *)
   END MakeString;
   (* ENDFD *)
   (* FOLD: MakeBorder *)
   PROCEDURE MakeBorder (VAR Bord : Border; VAR Coords : Pairs;
                         Left, Top, Width, Height : INTEGER;
                         Next : BorderPtr);
   BEGIN
      Coords[01, 0] := 0;       Coords[01, 1] := 0;
      Coords[02, 0] := Width-1; Coords[02, 1] := 0;
      Coords[03, 0] := Width-1; Coords[03, 1] := Height;
      Coords[04, 0] := Width;   Coords[04, 1] := Height;
      Coords[05, 0] := Width;   Coords[05, 1] := 0;
      Coords[06, 0] := Width;   Coords[06, 1] := Height;
      Coords[07, 0] := 1;       Coords[07, 1] := Height;
      Coords[08, 0] := 1;       Coords[08, 1] := 0;
      Coords[09, 0] := 0;       Coords[09, 1] := 0;
      Coords[10, 0] := 0;       Coords[10, 1] := Height;
      WITH Bord DO
         leftEdge   := Left;
         topEdge    := Top;
         frontPen   := Pen;
         backPen    := 0;
         drawMode   := jam2;
         nextBorder := Next;
         xy         := ADR (Coords);
         count      := 10;
      END; (* WITH *)
   END MakeBorder;
   (* ENDFD *)
   (* FOLD: GadgetRect *)
   PROCEDURE GadgetRect (Gad : Gadget);

   BEGIN
      WITH Gad DO
         RectFill (DiskyWindowPtr^.rPort,
                   leftEdge-2,         topEdge-1,
                   leftEdge-2 + width, topEdge-1 + height);
      END; (* WITH *)
   END GadgetRect;
   (* ENDFD *)
   (* FOLD: BuildDriveList *)
      PROCEDURE BuildDriveList;

      VAR MyDOSBasePtr : DosLibraryPtr;
          MyDevListPtr : DeviceListPtr;

      BEGIN
         MyDOSBasePtr := ADR (Dos);
         MyDevListPtr := MyDOSBasePtr^.root^.info^.devInfo;
         Forbid;
         GadgetsPtr^.NumDevs := 0;
         WHILE MyDevListPtr # NIL DO
            IF MyDevListPtr^.type = device THEN
               IF (MyDevListPtr^.task # NIL) THEN
                  WITH GadgetsPtr^ DO
                     IF NumDevs < 12 THEN
                        INC (NumDevs);
                        WITH MyDevListPtr^ DO
                           Strings.Copy (DevTxt[NumDevs], name^, 1,
                                         INTEGER (name^[0]));
                        END; (* WITH *)
                        Concat (DevTxt[NumDevs], ":");
                     END; (* IF *)
                  END; (* WITH *)
               END; (* IF *)
            END; (* IF *)
            MyDevListPtr := MyDevListPtr^.next;
         END; (* WHILE *)
         Permit;
      END BuildDriveList;
      (* ENDFD *)

   BEGIN
      IF NOT (onlyFiles IN DI.flags) THEN
         BuildDriveList;
      END; (* IF *)

      WITH Topaz8 DO
         name  := ADR ("topaz.font");
         ySize := 8;
         style := FontStyleSet {};
         flags := FontFlagSet {romFont};
      END; (* WITH *)
      WITH GadgetsPtr^ DO
         IF NOT (ownColors IN DI.flags) THEN
            Pen := StdGPen;
            Back := StdBFPen;
         ELSE
            Pen := DI.gadgetPen;
            Back := DI.backFillPen;
         END; (* IF *)

         (* FOLD: Borders *)
         MakeBorder (BoolBorder, BoolPairs, -2, -1, BoolWidth+3, 10, NIL);
         MakeBorder (StrBorder, StrPairs, -4, -2, StrWidth+1, 10, NIL);
         MakeBorder (SufBorder, SufPairs, -4, -2, SufWidth+3, 10, NIL);
         MakeBorder (HyperBorder, HyperPairs, -2, -1, FileWidth+3, 91, NIL);
         (* ENDFD *)
         (* FOLD: File-Gadgets *)
         FOR num := 1 TO 10 DO
            MakeText (FileITxt[num], 2, 1, NIL);
            IF num # 10 THEN
               NextPtr := ADR (File[num+1]);
            ELSE
               NextPtr := ADR (Prop);
            END; (* IF *)
            MakeGadget (File[num], 8, 4 + num * 9, FileWidth, 9,
                        ActivationFlagSet {relVerify}, boolGadget, NIL,
                        ADR (FileITxt[num]), num, NIL, NextPtr);
            File[1].gadgetRender := ADR (HyperBorder);
         END; (* IF *)
         (* ENDFD *)
         (* FOLD: Prop-Gadget *)
         MakeGadget (Prop, 259, 12, 20, 92, ActivationFlagSet {followMouse},
                     propGadget, ADR (KnobImage), NIL, 11, ADR (MyPropInfo),
                     ADR (Path[1]));
         WITH MyPropInfo DO
            flags     := PropInfoFlagSet {freeVert, autoKnob};
            horizPot  := 0;
            vertPot   := 0;
            horizBody := 0;
            vertBody  := maxBody;
         END; (* WITH *)
         IF (onlyFiles IN DI.flags) THEN
            Prop.nextGadget := ADR (Str[2]);
         END; (* IF *)
         NewDiskyWindow.height := 107;
         (* ENDFD *)
         (* FOLD: Control-Gadgets ( ':' / '/') *)
         IF NOT (onlyFiles IN DI.flags) THEN
            MakeText (PathITxt[1], 20, 1, ADR (Root));
            MakeGadget (Path[1], 8, NewDiskyWindow.height, BoolWidth, 9,
                        ActivationFlagSet {relVerify}, boolGadget,
                        ADR (BoolBorder), ADR (PathITxt[1]), 12, NIL,
                        ADR (Path[2]));
            MakeText (PathITxt[2], 20, 1, ADR (Parent));
            MakeGadget (Path[2], WinWidth - BoolWidth - 8,
                        NewDiskyWindow.height, BoolWidth, 9,
                        ActivationFlagSet {relVerify}, boolGadget,
                        ADR (BoolBorder), ADR (PathITxt[2]), 13, NIL,
                        ADR (Dev[1]));
            INC (NewDiskyWindow.height, 13);
         END; (* IF *)
         (* ENDFD *)
         (* FOLD: Device-Gadgets *)
         IF NOT (onlyFiles IN DI.flags) THEN
            DevLeft := 8;
            FOR num := 1 TO NumDevs DO
               MakeText (DevITxt[num], 13, 1, ADR (DevTxt[num]));
               IF num # NumDevs THEN
                  NextPtr := ADR (Dev[num+1]);
               ELSE
                  NextPtr := ADR (Str[1]);
               END; (* IF *)
               IF (((num - 1) MOD 4) = 0) AND (num # 1) THEN
                  INC (NewDiskyWindow.height, 13);
               END; (* IF *)
               MakeGadget (Dev[num], DevLeft, NewDiskyWindow.height,
                           BoolWidth, 9, ActivationFlagSet {relVerify},
                           boolGadget, ADR (BoolBorder),
                           ADR (DevITxt[num]), num + 13, NIL, NextPtr);
               INC (DevLeft, 69);
               IF DevLeft > 215 THEN DevLeft := 8; END;
            END; (* FOR *)
            IF (NumDevs # 0) THEN
               INC (NewDiskyWindow.height, 13);
            ELSE
               Path[2].nextGadget := ADR (Str[1]);
            END; (* IF *)
         END; (* IF *)
         (* ENDFD *)
         (* FOLD: String-Gadgets *)
         IF NOT (onlyFiles IN DI.flags) THEN
            IF (german IN DI.flags) THEN
               MakeText (StrITxt[1], -57, 0, ADR (GDir));
            ELSE
               MakeText (StrITxt[1], -57, 0, ADR (EDir));
            END; (* IF *)
            MakeGadget (Str[1], 65, NewDiskyWindow.height+1, StrWidth-3, 9,
                        ActivationFlagSet {relVerify}, strGadget,
                        ADR (StrBorder), ADR (StrITxt[1]), 23,
                        ADR (StrInfo[1]), ADR (Str[2]));
            MakeString (StrInfo[1], DI.dir);
            INC (NewDiskyWindow.height, 13);
         END; (* IF *)

         IF (german IN DI.flags) THEN
            MakeText (StrITxt[2], -57, 0, ADR (GFile));
         ELSE
            MakeText (StrITxt[2], -57, 0, ADR (EFile));
         END; (* IF *)
         IF NOT (suffixGad IN DI.flags) THEN
            NextPtr := ADR (End[1]);
         ELSE
            NextPtr := ADR (Str[3]);
         END; (* IF *)
         MakeGadget (Str[2], 65, NewDiskyWindow.height+1, StrWidth-3, 9,
                     ActivationFlagSet {relVerify}, strGadget,
                     ADR (StrBorder), ADR (StrITxt[2]), 24,
                     ADR (StrInfo[2]), NextPtr);
         MakeString (StrInfo[2], DI.file);
         INC (NewDiskyWindow.height, 13);

         IF (suffixGad IN DI.flags) THEN
            IF (german IN DI.flags) THEN
               MakeText (StrITxt[3], -68, 0, ADR (GSuf));
            ELSE
               MakeText (StrITxt[3], -68, 0, ADR (ESuf));
            END; (* IF *)
            MakeGadget (Str[3], 148, NewDiskyWindow.height+1, SufWidth-1, 9,
                        ActivationFlagSet {relVerify}, strGadget,
                        ADR (SufBorder), ADR (StrITxt[3]), 25,
                        ADR (StrInfo[3]), ADR (End[1]));
            MakeString (StrInfo[3], DI.suffix);
         END; (* IF *)
         (* ENDFD *)
         (* FOLD: End-Gadgets (OK / CANCEL) *)
         IF (german IN DI.flags) THEN
            MakeText (EndITxt[1], 21, 1, ADR (GOK));
         ELSE
            MakeText (EndITxt[1], 21, 1, ADR (EOK));
         END; (* IF *)
         MakeGadget (End[1], 8, NewDiskyWindow.height, BoolWidth, 9,
                     ActivationFlagSet {relVerify}, boolGadget,
                     ADR (BoolBorder), ADR (EndITxt[1]), 26, NIL,
                     ADR (End[2]));
         IF (german IN DI.flags) THEN
            MakeText (EndITxt[2], 3, 1, ADR (GCancel));
         ELSE
            MakeText (EndITxt[2], 7, 1, ADR (ECancel));
         END; (* IF *)
         MakeGadget (End[2], WinWidth - BoolWidth - 8,
                     NewDiskyWindow.height, BoolWidth, 9,
                     ActivationFlagSet {relVerify}, boolGadget,
                     ADR (BoolBorder), ADR (EndITxt[2]), 27, NIL, NIL);
         INC (NewDiskyWindow.height, 13);
         (* ENDFD *)
      END; (* WITH *)

      (* Window öffnen ! *)

      WITH NewDiskyWindow DO
         width       := WinWidth;
         detailPen   := Back;
         blockPen    := Pen;
         idcmpFlags  := IDCMPFlagSet {gadgetUp, mouseMove};
         flags       := WindowFlagSet {activate, rmbTrap, windowDrag,
                                       windowDepth};
         title       := DI.title;
         firstGadget := NIL; (* ADR (GadgetsPtr^.File[1]); *)
         IF (ownScreen IN DI.flags) AND (DI.screen # NIL) THEN
            screen := DI.screen;
            type   := customScreen; (* I guess *)
         ELSE
            DI.screen := OpenWorkBench();
            screen := DI.screen;
            type   := ScreenFlagSet {wbenchScreen};
         END; (* IF *)
         IF NOT (ownPosition IN DI.flags) OR
            (DI.x < 0) OR (DI.x + width > DI.screen^.width) THEN
            leftEdge := (DI.screen^.width - width) / 2;
         ELSE
            leftEdge := DI.x;
         END; (* IF *)
         IF NOT (ownPosition IN DI.flags) OR (DI.y < 0) OR
            (DI.y + height > DI.screen^.height) THEN
            topEdge := (DI.screen^.height - height) / 2;
         ELSE
            topEdge := DI.y;
         END; (* IF *)
      END; (* WITH *)
      DiskyWindowPtr := OpenWindow (NewDiskyWindow);
      IF DiskyWindowPtr # NIL THEN
         WITH DiskyWindowPtr^ DO
            SetAPen (rPort, Back);
            RectFill (rPort, 2, 10, width-3, height-2);
            SetAPen (rPort, 0);
            IF NOT (onlyFiles IN DI.flags) THEN
               GadgetRect (GadgetsPtr^.Str[1]);
            END; (* IF *)
            GadgetRect (GadgetsPtr^.Str[2]);
            IF (suffixGad IN DI.flags) THEN
               GadgetRect (GadgetsPtr^.Str[3]);
            END; (* IF *)
         END; (* WITH *)
         IF AddGList (DiskyWindowPtr, ADR (GadgetsPtr^.File[1]), 0, -1, NIL) = 0 THEN END;
         RefreshGadgets (DiskyWindowPtr^.firstGadget, DiskyWindowPtr, NIL);
         RETURN TRUE;
      ELSE
         RETURN FALSE;
      END; (* IF *)
   END BuildRequester;
   (* ENDFD *)
   (* FOLD: FreeList *)
   PROCEDURE FreeList;

      (* FOLD: FreeEntry *)
      PROCEDURE FreeEntries (Entry : StringEntryPtr);

      BEGIN
         IF Entry # NIL THEN
            FreeEntries (Entry^.succ);
            FreeMem (Entry, SIZE (Entry^));
         END; (* IF *)
      END FreeEntries;
      (* ENDFD *)

   BEGIN
      FreeEntries (Directory.head);
      WITH Directory DO head := NIL; num := 0; END;
   END FreeList;
   (* ENDFD *)
   (* FOLD: ConnectToDir *)
   PROCEDURE ConnectToDir (VAR Dir : ARRAY OF CHAR; Sub : ARRAY OF CHAR);

   VAR Last : CARDINAL;

   BEGIN
      Last := Length (Dir)-1;
      IF (Dir[Last] # ':') AND (Dir[Last] # '/') THEN
         Concat (Dir, "/");
      END; (* IF *)
      Concat (Dir, Sub);
   END ConnectToDir;
   (* ENDFD *)
   (* FOLD: ConnectAll *)
   PROCEDURE ConnectAll;

   BEGIN
      IF DI.file[0] = 0C THEN
         DI.path[0] := 0C;
         RETURN;
      END; (* IF *)
      IF DI.dir[0] # 0C THEN
         Copy (DI.path, DI.dir);
         ConnectToDir (DI.path, DI.file);
      ELSE
         Copy (DI.path, DI.file);
      END; (* IF *)
      IF (watchSuffix IN DI.flags) AND (DI.suffix[0] # 0C) THEN
         Concat (DI.path, ".");
         Concat (DI.path, DI.suffix);
      END; (* IF *)
   END ConnectAll;
   (* ENDFD *)
   (* FOLD: MatchSuffix *)
   PROCEDURE MatchSuffix (File : ARRAY OF CHAR;
                          Suffix : ARRAY OF CHAR) : BOOLEAN;

   VAR DotPos : INTEGER;

   BEGIN
      IF Suffix[0] = 0C THEN RETURN TRUE; END;
      DotPos := LastPos (File, Length (File), '.');
      IF DotPos = noOccur THEN RETURN FALSE; END;
      RETURN Strings.Compare (File, DotPos + 1, Length (Suffix) + 1,
                              Suffix, FALSE) = 0;
   END MatchSuffix;
   (* ENDFD *)
   (* FOLD: CutSuffix *)
   PROCEDURE CutSuffix (VAR File : ARRAY OF CHAR);

   VAR DotPos : INTEGER;

   BEGIN
      DotPos := LastPos (File, Length (File), '.');
      IF DotPos # noOccur THEN
         File[DotPos] := 0C;
      END; (* IF *)
   END CutSuffix;
   (* ENDFD *)
   (* FOLD: UpdateGadgets *)
   PROCEDURE UpdateGadgets;

      (* FOLD: OnlyRefresh *)
      PROCEDURE OnlyRefresh (WhichGadget : Gadget);

      BEGIN
         RefreshGList (ADR (WhichGadget), DiskyWindowPtr, NIL, 1);
      END OnlyRefresh;
      (* ENDFD *)

   VAR Body, Pot : CARDINAL;

   BEGIN
      WITH GadgetsPtr^ DO
         IF NOT (selected IN Str[1].flags) THEN
            WITH StrInfo[1] DO
               numChars  := Length (DI.dir);
               IF numChars >= dispCount THEN
                  dispPos   := numChars - dispCount + 1;
               ELSE
                  dispPos := 0;
               END; (* IF *)
               bufferPos := numChars;
            END; (* WITH *)
            OnlyRefresh (Str[1]);
         END; (* IF *)
         IF NOT (selected IN Str[2].flags) THEN
            WITH StrInfo[2] DO
               numChars  := Length (DI.file);
               bufferPos := numChars;
               dispPos   := 0;
            END; (* WITH *)
            OnlyRefresh (Str[2]);
         END; (* IF *)

         IF (Directory.num > 10) THEN
            Body := (maxBody DIV Directory.num) * 10;
            Pot  := MyPropInfo.vertPot;
         ELSE
            Body := maxBody;
            Pot  := 0;
         END; (* IF *)
         NewModifyProp (ADR (Prop), DiskyWindowPtr, NIL,
                        PropInfoFlagSet {freeVert, autoKnob}, 0, Pot,
                        0, Body, 1);
      END; (* WITH *)
   END UpdateGadgets;
   (* ENDFD *)
   (* FOLD: CloseDown *)
   PROCEDURE CloseDown;

   BEGIN
      IF CurrentLockPtr # NIL THEN
         UnLock (CurrentLockPtr);
         CurrentLockPtr := NIL;
      END; (* IF *)
      IF DiskyWindowPtr # NIL THEN
         CloseWindow (DiskyWindowPtr);
      END; (* IF *)
      IF MyFIBPtr # NIL THEN
         FreeMem (MyFIBPtr, SIZE (MyFIBPtr^));
      END; (* IF *)
      IF GadgetsPtr # NIL THEN
         FreeMem (GadgetsPtr, SIZE (GadgetsPtr^));
      END; (* IF *)
      FreeList;
   END CloseDown;
   (* ENDFD *)
   (* FOLD: GetGadID *)
   PROCEDURE GetGadID (VAR ID : CARDINAL) : BOOLEAN;

   VAR MyMessagePtr : IntuiMessagePtr;
       Gad          : GadgetPtr;
       Class        : IDCMPFlagSet;

   BEGIN
      MyMessagePtr := GetMsg (DiskyWindowPtr^.userPort);
      IF MyMessagePtr # NIL THEN
         WITH MyMessagePtr^ DO
            Class := class;
            Sec   := seconds;
            Mic   := micros;
            Gad   := iAddress;
         END; (* WITH *)
         ReplyMsg (MyMessagePtr);
         IF (gadgetUp IN Class) THEN
            ID := Gad^.gadgetID;
            RETURN TRUE;
         ELSIF (mouseMove IN Class) THEN
            ID := GadgetsPtr^.Prop.gadgetID;
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END; (* IF *)
      ELSE
         RETURN FALSE;
      END; (* IF *)
   END GetGadID;
   (* ENDFD *)
   (* FOLD: RefreshFiles *)
   PROCEDURE RefreshFiles (sure : BOOLEAN);

   VAR TopOfDisplay : CARDINAL;
       HelpTop      : LONGCARD;
       FileNum      : [1..10];
       Entry        : StringEntryPtr;

      (* FOLD: MakeGadITxt *)
      PROCEDURE MakeGadITxt;

      VAR Len  : CARDINAL;
          Fill : CARDINAL;

      BEGIN
         WITH GadgetsPtr^ DO
            IF Files[FileNum] = NIL THEN
               FileTxt[FileNum] := "";
            ELSE
               Copy (FileTxt[FileNum], Files[FileNum]^.text);
               IF Files[FileNum]^.type = dir THEN
                  Concat (FileTxt[FileNum], " (dir)");
               END; (* IF *)
            END; (* IF *)
            Len := Length (FileTxt[FileNum]);
            FOR Fill := Len TO MaxFL-1 DO
               FileTxt[FileNum][Fill] := ' ';
            END; (* FOR *)
            FileTxt[FileNum][MaxFL] := 0C;

            FileITxt[FileNum].iText := ADR (FileTxt[FileNum]);
            IF Files[FileNum] # NIL THEN
               IF Files[FileNum]^.type = dir THEN
                  IF NOT (ownColors IN DI.flags) THEN
                     FileITxt[FileNum].frontPen := StdDPen;
                  ELSE
                     FileITxt[FileNum].frontPen := DI.dirPen;
                  END; (* IF *)
               ELSIF Files[FileNum]^.type = file THEN
                  IF NOT (ownColors IN DI.flags) THEN
                     FileITxt[FileNum].frontPen := StdFPen;
                  ELSE
                     FileITxt[FileNum].frontPen := DI.filePen;
                  END; (* IF *)
               END; (* IF *)
            ELSE
               FileITxt[FileNum].frontPen := 0;
            END; (* IF *)
         END; (* WITH *)
      END MakeGadITxt;
      (* ENDFD *)

   BEGIN
      IF (Directory.num > 10) THEN
         HelpTop := GadgetsPtr^.MyPropInfo.vertPot;
         HelpTop := (HelpTop * (Directory.num - 10)) / maxPot;
         TopOfDisplay := HelpTop;
      ELSE
         TopOfDisplay := 0;
      END; (* IF *)
      IF (OldTop # TopOfDisplay) OR sure THEN
         OldTop := TopOfDisplay;
         Entry := Directory.head;
         WHILE TopOfDisplay > 0 DO
            Entry := Entry^.succ;
            DEC (TopOfDisplay);
         END; (* WHILE *)
         FOR FileNum := 1 TO 10 DO
            Files[FileNum] := Entry;
            MakeGadITxt;
            IF Entry # NIL THEN Entry := Entry^.succ; END;
         END; (* FOR *)
         RefreshGList (ADR (GadgetsPtr^.File[1]), DiskyWindowPtr, NIL, 10);
      END; (* IF *)
   END RefreshFiles;
   (* ENDFD *)
   (* FOLD: PrepareRead *)
   PROCEDURE PrepareRead;

   VAR FileNum : [1..10];

   BEGIN
      IF CurrentLockPtr = NIL THEN
         DisplayBeep (DI.screen);
         Status := waiting;
      ELSE
         FreeList;
         FOR FileNum := 1 TO 10 DO
            Files[FileNum] := NIL;
         END; (* FOR *)
         GetPathFromLock (DI.dir, CurrentLockPtr);
         ConnectAll;
         UpdateGadgets;
         RefreshFiles (TRUE);
         IF NOT Examine (CurrentLockPtr, MyFIBPtr) THEN
            DisplayBeep (DI.screen);
            Status := waiting;
         ELSE
            IF MyFIBPtr^.dirEntryType <= 0 THEN
               DisplayBeep (DI.screen);
               Status := waiting;
            ELSE
               IF ExNext (CurrentLockPtr, MyFIBPtr) THEN END;
               Status := read;
            END; (* IF *)
         END; (* IF *)
      END; (* IF *)
   END PrepareRead;
   (* ENDFD *)
   (* FOLD: ReadDir *)
   PROCEDURE ReadDir;

   VAR GetFile      : BOOLEAN;
       FileStore    : ARRAY [0..MaxFL] OF CHAR;

      (* FOLD: AddEntry *)
      PROCEDURE AddEntry (Type : StringType);

      VAR CurPtr, NewPtr, LastPtr : StringEntryPtr;

      BEGIN
         NewPtr := AllocMem (SIZE (NewPtr^), MemReqSet {});
         IF NewPtr = NIL THEN
            DisplayBeep (NIL);
            RETURN;
         END; (* IF *)
         Copy (NewPtr^.text, FileStore);
         NewPtr^.type := Type;
         CurPtr := Directory.head;
         LastPtr := NIL;
         WHILE (CurPtr # NIL) AND
               (((NewPtr^.type = file) AND (CurPtr^.type = dir)) OR
                (NOT ((NewPtr^.type = dir) AND (CurPtr^.type = file)) AND
                 (Compare (CurPtr^.text, NewPtr^.text) < 0))) DO
            LastPtr := CurPtr;
            CurPtr := LastPtr^.succ;
         END; (* WHILE *)
         IF LastPtr = NIL THEN
            NewPtr^.succ   := Directory.head;
            Directory.head := NewPtr;
         ELSE
            NewPtr^.succ := LastPtr^.succ;
            LastPtr^.succ := NewPtr;
         END; (* IF *)
         INC (Directory.num);
      END AddEntry;
      (* ENDFD *)

   BEGIN
      IF (IoErr() = noMoreEntries) THEN
         Status := waiting;
         UpdateGadgets;
         RefreshFiles (TRUE);
      ELSE
         GetFile := TRUE;
         Copy (FileStore, MyFIBPtr^.fileName);
         IF (MyFIBPtr^.dirEntryType > 0) AND NOT (onlyFiles IN DI.flags) THEN
            AddEntry (dir);
         ELSIF MyFIBPtr^.dirEntryType < 0 THEN
            IF NOT (displayInfo IN DI.flags) THEN
               IF (MatchSuffix (FileStore, "info") = TRUE) THEN
                  GetFile := FALSE;
               END; (* IF *)
            END; (* IF *)
            IF (watchSuffix IN DI.flags) THEN
               IF (MatchSuffix (FileStore, DI.suffix) = FALSE) THEN
                  GetFile := FALSE;
               END; (* IF *)
            END; (* IF *)
            IF (callFileTest IN DI.flags) THEN
               IF DI.fileTestProc # NIL THEN
                  GetFile := DI.fileTestProc (FileStore);
               END; (* IF *)
            END; (* IF *)
            IF GetFile THEN
               IF (DI.suffix[0] # 0C) AND (watchSuffix IN DI.flags) THEN
                  CutSuffix (FileStore);
               END; (* IF *)
               AddEntry (file);
            END; (* IF *)
         END; (* IF *)
      END; (* IF *)
      IF ExNext (CurrentLockPtr, MyFIBPtr) THEN END;
   END ReadDir;
   (* ENDFD *)

BEGIN
   lastSec := 0; lastMic := 0;
   MyFIBPtr := AllocMem (SIZE (MyFIBPtr^), MemReqSet {});
   IF MyFIBPtr = NIL THEN CloseDown; RETURN FALSE; END;
   GadgetsPtr := AllocMem (SIZE (GadgetsPtr^), MemReqSet {});
   IF GadgetsPtr = NIL THEN CloseDown; RETURN FALSE; END;
   IF BuildRequester() = FALSE THEN CloseDown; RETURN FALSE; END;
   WITH Directory DO
      num := 0;
      head := NIL;
   END; (* WITH *)
   Status := begin;
   CurrentLockPtr := Lock (ADR (DI.dir), accessRead);
   IF CurrentLockPtr = NIL THEN
      DisplayBeep (DI.screen);
      CurrentLockPtr := Lock (NIL, accessRead);
      IF CurrentLockPtr = NIL THEN
         DisplayBeep (DI.screen);
         Status := waiting; (* Never happens! *)
      END; (* IF *)
   END; (* IF *)
   LOOP
      IF GetGadID (ID) = TRUE THEN
         CASE ID OF
         |  MinFileID..MaxFileID :
            IF Files[ID] # NIL THEN
               WITH Files[ID]^ DO
                  IF type = dir THEN
                     IF (CurrentLockPtr # NIL) THEN
                        UnLock (CurrentLockPtr);
                     END; (* IF *)
                     ConnectToDir (DI.dir, text);
                     CurrentLockPtr := Lock (ADR (DI.dir), accessRead);
                     Status := begin;
                  ELSIF type = file THEN
                     IF (Compare (DI.file, text) = 0) AND
                        ((lastSec # 0) OR (lastMic # 0)) THEN
                        IF DoubleClick (lastSec, lastMic, Sec, Mic) THEN
                           CloseDown;
                           RETURN TRUE;
                        END; (* IF *)
                     ELSE
                        Copy (DI.file, text);
                        ConnectAll;
                        UpdateGadgets;
                     END; (* IF *)
                  END; (* IF *)
                  lastSec := Sec; lastMic := Mic;
               END; (* WITH *)
            END; (* IF *)
         |  PropID :
            IF Status = waiting THEN
               RefreshFiles (FALSE);
            END; (* IF *)
         |  MinPathID..MaxPathID :
            IF CurrentLockPtr # NIL THEN
               LOOP
                  BackupLockPtr := CurrentLockPtr;
                  CurrentLockPtr := ParentDir (CurrentLockPtr);
                  IF CurrentLockPtr = NIL THEN
                     IF ID = ParentID THEN
                        DisplayBeep (DI.screen);
                     END; (* IF *)
                     CurrentLockPtr := BackupLockPtr;
                     EXIT;
                  ELSE
                     UnLock (BackupLockPtr);
                     Status := begin;
                  END; (* IF *)
                  IF ID = ParentID THEN
                     EXIT;
                  END; (* IF *)
               END; (* LOOP *)
            END; (* IF *)
         |  MinDevID..MaxDevID :
            IF CurrentLockPtr # NIL THEN
               UnLock (CurrentLockPtr);
            END; (* IF *)
            CurrentLockPtr := Lock (ADR (GadgetsPtr^.DevTxt[ID-MinDevID+1]),
                                    accessRead);
            Status := begin;
         |  DirID :
            BackupLockPtr := CurrentLockPtr;
            CurrentLockPtr := Lock (GadgetsPtr^.StrInfo[1].buffer,
                                    accessRead);
            IF CurrentLockPtr = NIL THEN
               DisplayBeep (NIL);
               CurrentLockPtr := BackupLockPtr;
            ELSE
               IF BackupLockPtr # NIL THEN
                  UnLock (BackupLockPtr);
               END; (* IF *)
            END; (* IF *)
            Status := begin;
         |  FileID :
         |  SuffixID :
            Status := begin;
         |  MinEndID..MaxEndID :
            ConnectAll;
            CloseDown;
            RETURN (ID = OKID);
         END; (* CASE *)
      END; (* IF *)
      CASE Status OF
      | begin   : PrepareRead;
      | read    : ReadDir;
      | waiting : WaitPort (DiskyWindowPtr^.userPort);
      END; (* CASE *)
   END; (* LOOP *)
END Disky;
(* ENDFD *)
(* FOLD: RequestFile *)
PROCEDURE RequestFile (VAR Path : ARRAY OF CHAR) : BOOLEAN;

VAR DI  : DiskyInfo;
    res : BOOLEAN;

BEGIN
   WITH DI DO
      title := ADR ("FileRequester");
      SplitPath (Path, FALSE, dir, file, suffix);
      flags := DiskyFlagSet {};
   END; (* WITH *)
   res := Disky (DI);
   Copy (Path, DI.path);
   RETURN res;
END RequestFile;
(* ENDFD *)
(* FOLD: SplitPath *)
PROCEDURE SplitPath (Path : ARRAY OF CHAR; SepSuf : BOOLEAN;
                     VAR Dir, File, Suffix : ARRAY OF CHAR);

VAR Pos : INTEGER;
    Ptr : POINTER TO ARRAY [0..999] OF CHAR;

BEGIN
   IF SepSuf THEN
      Pos := LastPos (Path, Length (Path), '.');
      IF Pos # noOccur THEN
         Ptr := ADR (Path[Pos+1]);
         Copy (Suffix, Ptr^);
         Path[Pos] := 0C;
      END; (* IF *)
   ELSE
      Suffix[0] := 0C;
   END; (* IF *)
   Pos := LastPos (Path, Length (Path), '/');
   IF Pos = noOccur THEN
      Pos := LastPos (Path, Length (Path), ':');
      IF Pos = noOccur THEN
         Copy (File, Path);
         Dir[0] := 0C;
         RETURN;
      END; (* IF *)
   END; (* IF *)
   Ptr := ADR (Path[Pos+1]);
   Copy (File, Ptr^);
   Path[Pos+1] := 0C;
   Copy (Dir, Path);
END SplitPath;
(* ENDFD *)
(* FOLD: FileExists *)
PROCEDURE FileExists (Path : ARRAY OF CHAR) : BOOLEAN;

VAR TestLockPtr : FileLockPtr;
    TestFIB     : FileInfoBlockPtr;
    Result      : BOOLEAN;

BEGIN
   TestFIB := AllocMem (SIZE (TestFIB^), MemReqSet {});
   IF TestFIB # NIL THEN
      TestLockPtr := Lock (ADR (Path), accessRead);
      IF TestLockPtr # NIL THEN
         IF Examine (TestLockPtr, TestFIB) THEN
            Result := (TestFIB^.dirEntryType < 0);
         ELSE
            Result := FALSE;
         END; (* IF *)
         UnLock (TestLockPtr);
      ELSE
         Result := FALSE;
      END; (* IF *)
      FreeMem (TestFIB, SIZE (TestFIB^));
   ELSE
      RETURN FALSE;
   END; (* IF *)
   RETURN Result;
END FileExists;
(* ENDFD *)
(* FOLD: GetPathFromLock *)
PROCEDURE GetPathFromLock (VAR Path : ARRAY OF CHAR; TheLock : FileLockPtr);

VAR CurDirPtr : FileLockPtr;
    OldDirPtr : FileLockPtr;
    FIBPtr    : FileInfoBlockPtr;
    VolumeLen : CARDINAL;

BEGIN
   Copy (Path, "");
   CurDirPtr := DupLock (TheLock);
   IF CurDirPtr = NIL THEN RETURN; END;
   FIBPtr := AllocMem (SIZE (FIBPtr^), MemReqSet {});
   IF FIBPtr # NIL THEN
      Forbid;
      WITH CurDirPtr^.volume^ DO
         Strings.Copy (Path, name^, 1, INTEGER (name^[0]));
      END; (* WITH *)
      Permit;
      Concat (Path, ":");
      VolumeLen := Length (Path);
      WHILE CurDirPtr # NIL DO
         IF NOT (Examine (CurDirPtr, FIBPtr)) THEN
            Copy (Path, "");
            UnLock (CurDirPtr);
            CurDirPtr := NIL;
         ELSE
            OldDirPtr := CurDirPtr;
            CurDirPtr := ParentDir (OldDirPtr);
            UnLock (OldDirPtr);
            IF CurDirPtr # NIL THEN
               IF Length (Path) # VolumeLen THEN
                  Strings.Insert (Path, VolumeLen, "/");
               END; (* IF *)
               Strings.Insert (Path, VolumeLen, FIBPtr^.fileName);
            END; (* IF *)
         END; (* IF *)
      END; (* WHILE *)
      FreeMem (FIBPtr, SIZE (FIBPtr^));
   END; (* IF *)
END GetPathFromLock;
(* ENDFD *)

END FileRequest.