(* -------------------------------------------------------------------------
  :Program.       FileRequest
  :Contents.      exportiert Prozedur zum erzeugen eines FileRequesters
  :Author.        Kai Bolay
  :Address.       Hoffmannstraße 168, 7250 Leonberg 1
  :Phone.         07152/22135
  :History.       v1.01 Kai Bolay 28-Jul-89 Added ownFont-Flag
  :History.       v1.02 Kai Bolay 29-Jul-89 Bug fixed in MatchSuffx/CutSuffix
  :History.       v1.10 Carsten Mehring 08-Aug-89 faster SortList (QSort-Algoritm)
  :History.       v1.11 Kai Bolay 17-Sep-89 Bug fixed (File-Gadget & UpdateGad)
  :History.       v1.12 Kai Bolay 08-Oct-89 Dir-Display now fine
  :History.       v1.13 Kai Bolay 22-Oct-89 tried to correct SortList
  :History.       v1.20 Kai Bolay 01-Nov-89 SortList removed / sort in AddEntry
  :History.       v1.30 Kai Bolay 24-Nov-89 dirExt, DoubleKlick, respect select
  :Copyright.     PD
  :Language.      Modula-2
  :Translator.    M2Amiga 3.2d
  :Imports.       IntuiStruct1.3 [bne]
------------------------------------------------------------------------- *)

IMPLEMENTATION MODULE FileRequest;

(* FOLD: IMPORT *)
FROM SYSTEM      IMPORT ADR, LONGSET;
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, BSTR;
FROM Exec        IMPORT WaitPort, GetMsg, ReplyMsg, Forbid, Permit, UByte;
FROM Graphics    IMPORT SetFont, OpenFont, CloseFont, RastPortPtr, jam1,
                        jam2, TextFontPtr, FontFlags, FontFlagSet, RectFill,
                        SetAPen;
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;
FROM IntuiStruct IMPORT StructBorder, FreeBorder, StructText, StructWindow,
                        StructGadget, StructProp, StructString, BorderEnd,
                        AddLine, AllocProc, DeallocProc;
FROM Heap        IMPORT Allocate, Deallocate, AllocMem;
IMPORT Strings, Dos;
(* ENDFD *)
(* FOLD: CONST *)
CONST MaxFL = 30;  (* max. Länge der Strings *)
      MaxPL = 150;
      MaxSL = 8;
      MaxDL = 8;

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

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

      RootID   = 12; (* Gadget IDs (speziell) *)
      ParentID = 13;
      DirID    = 23;
      FileID   = 24;
      SuffixID = 25;
      OKID     = 26;
      CancelID = 27;
(* ENDFD *)
(* FOLD: TYPE *)
TYPE FileGadStatus  = (file, dir, empty);
     ProgStatus     = (begin, read, ready);
     String         = ARRAY [0..999] OF CHAR;
     StringPtr      = POINTER TO String;
     StringEntryPtr = POINTER TO StringEntry;
     StringEntry    = RECORD
                         nextEntry : StringEntryPtr;
                         string    : StringPtr;
                      END; (* RECORD *)
     StringListPtr  = POINTER TO StringList;
     StringList     = RECORD
                         numEntries : CARDINAL;
                         maxLength  : CARDINAL;
                         firstEntry : 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..9] OF IntuiText;
                         DevTxt      : ARRAY [1..9] 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..9];
                         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;
                         StrBorder   : ARRAY [1..2] OF Border;
                         SufBorder   : ARRAY [1..2] OF Border;
                         HyperBorder : Border;
                      END; (* RECORD *)
     GadStuffPtr    = POINTER TO GadStuff;
(* ENDFD *)
(* FOLD: Disky *)
PROCEDURE Disky (VAR DI : DiskyInfo) : DiskyResult;

VAR MyFIBPtr       : FileInfoBlockPtr;
    DiskyWindowPtr : WindowPtr;
    DiskyRPortPtr  : RastPortPtr;
    GadgetsPtr     : GadStuffPtr;
    ID             : CARDINAL;
    CurrentLockPtr : FileLockPtr;
    BackupLockPtr  : FileLockPtr;
    DirList        : StringList;
    FileList       : StringList;
    OldTop         : CARDINAL;
    FMode          : ARRAY [1..10] OF FileGadStatus;
    Files          : ARRAY [1..10] OF ARRAY [0..MaxFL] OF CHAR;
    Mode           : ProgStatus;
    FileNum        : [1..10];
    FontPtr        : TextFontPtr;
    lastSec, Sec   : LONGCARD;
    lastMic, Mic   : LONGCARD;
    len            : CARDINAL;

   (* FOLD: BSTRCopy *)
   PROCEDURE BSTRCopy (VAR dest : ARRAY OF CHAR; source : BSTR);

   BEGIN
      Strings.Copy (dest, source^, 1, INTEGER (source^[0]));
   END BSTRCopy;
   (* ENDFD *)
   (* FOLD: BuildRequester *)
   PROCEDURE BuildRequester() : BOOLEAN;

   CONST Parent  = " / ";
         Root    = " : ";
         GOK     = "OK!";
         GCancel = "Abbruch";
         EOK     = "OK!";
         ECancel = "Cancel";
         GDir    = "Ordner";
         GFile   = "Datei";
         GSuf    = "Suffix";
         EDir    = "Directory";
         EFile   = "File";
         ESuf    = "Suffix";


   VAR Pen, Back      : UByte;
       num            : CARDINAL;
       NextPtr        : GadgetPtr;
       DevLeft        : CARDINAL;
       NewDiskyWindow : NewWindow;
       TheScreenPtr   : ScreenPtr;

      (* 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 < 9 THEN
                        INC (NumDevs);
                        BSTRCopy (DevTxt[NumDevs], MyDevListPtr^.name);
                        Concat (DevTxt[NumDevs], ":");
                     END; (* IF *)
                  END; (* WITH *)
               END; (* IF *)
            END; (* IF *)
            MyDevListPtr := MyDevListPtr^.next;
         END; (* WHILE *)
         Permit;
      END BuildDriveList;
      (* ENDFD *)
      (* FOLD: CorrectFont *)
      PROCEDURE CorrectFont; (* Does not work !!! *)

      VAR num  : [1..3];
          rast : RastPortPtr;

      BEGIN
         SetFont (DiskyWindowPtr^.rPort, FontPtr);
         FOR num := 1 TO 3 DO
            WITH GadgetsPtr^.StrInfo[num] DO
               IF layerPtr # NIL THEN
                  WITH layerPtr^ DO
                     IF rp # NIL THEN
                        rast := rp;
                     END; (* IF *)
                  END; (* WITH *)
               END; (* IF *)
            END; (* WITH *)
            IF rast # NIL THEN
               SetFont (rast, FontPtr);
            END; (* IF *)
         END; (* FOR *)
      END CorrectFont;
      (* ENDFD *)

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

      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 *)
         StructBorder (BoolBorder, -2, -1, Pen, jam1, 9, NIL);
         AddLine (87, 00); AddLine (87, 10); AddLine (88, 10);
         AddLine (88, 00); AddLine (88, 10); AddLine (01, 10);
         AddLine (01, 00); AddLine (00, 00); AddLine (00, 10);
         BorderEnd;
         StructBorder (StrBorder[1], -4, -2, Pen, jam1, 9,
                       ADR (StrBorder[2]));
         AddLine (180, 000); AddLine (180, 010); AddLine (181, 010);
         AddLine (181, 000); AddLine (181, 010); AddLine (001, 010);
         AddLine (001, 000); AddLine (000, 000); AddLine (000, 010);
         BorderEnd;
         StructBorder (StrBorder[2], -97, -2, Pen, jam1, 9, NIL);
         AddLine (87, 00); AddLine (87, 10); AddLine (88, 10);
         AddLine (88, 00); AddLine (88, 10); AddLine (01, 10);
         AddLine (01, 00); AddLine (00, 00); AddLine (00, 10);
         BorderEnd;
         StructBorder (SufBorder[1], -4, -2, Pen, jam1, 9,
                       ADR (SufBorder[2]));
         AddLine (87, 00); AddLine (87, 10); AddLine (88, 10);
         AddLine (88, 00); AddLine (88, 10); AddLine (01, 10);
         AddLine (01, 00); AddLine (00, 00); AddLine (00, 10);
         BorderEnd;
         StructBorder (SufBorder[2], -97, -2, Pen, jam1, 9, NIL);
         AddLine (87, 00); AddLine (87, 10); AddLine (88, 10);
         AddLine (88, 00); AddLine (88, 10); AddLine (01, 10);
         AddLine (01, 00); AddLine (00, 00); AddLine (00, 10);
         BorderEnd;
         StructBorder (HyperBorder, -2, -1, Pen, jam1, 9, NIL);
         AddLine (249, 000); AddLine (249, 091); AddLine (250, 091);
         AddLine (250, 000); AddLine (250, 091); AddLine (001, 091);
         AddLine (001, 000); AddLine (000, 000); AddLine (000, 091);
         BorderEnd;
         (* ENDFD *)
         (* FOLD: File-Gadgets *)
         FOR num := 1 TO 10 DO
            StructText (FileITxt[num], Pen, Back, jam2, 2, 1, NIL, NIL);
            IF (ownFont IN DI.flags) THEN
               FileITxt[num].iTextFont := DI.font;
            END; (* IF *)
            IF num # 10 THEN
               NextPtr := ADR (File[num+1]);
            ELSE
               NextPtr := ADR (Prop);
            END; (* IF *)
            StructGadget (File[num], 8, 4+num*9, 247, 9, GadgetFlagSet {},
                          ActivationFlagSet {relVerify}, boolGadget, NIL,
                          ADR (FileITxt[num]), LONGSET {}, num, NextPtr);
            File[1].gadgetRender := ADR (HyperBorder);
         END; (* IF *)
         (* ENDFD *)
         (* FOLD: Prop-Gadget *)
         StructGadget (Prop, 261, 12, 20, 92, GadgetFlagSet {},
                       ActivationFlagSet {followMouse}, propGadget,
                       ADR (KnobImage), NIL, LONGSET {}, 11, ADR (Path[1]));
         StructProp (MyPropInfo, PropInfoFlagSet {freeVert, autoKnob},
                     0, 0, 0, maxBody);
         Prop.specialInfo := ADR (MyPropInfo);
         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
            StructText (PathITxt[1], Pen, 0, jam1, 32, 1, ADR (Root), NIL);
            IF (ownFont IN DI.flags) THEN
               PathITxt[1].iTextFont := DI.font;
            END; (* IF *)
            StructGadget (Path[1], 8, NewDiskyWindow.height, 85, 9,
                          GadgetFlagSet {}, ActivationFlagSet {relVerify},
                          boolGadget, ADR (BoolBorder), ADR (PathITxt[1]),
                          LONGSET {}, 12, ADR (Path[2]));
            StructText (PathITxt[2], Pen, 0, jam1, 32, 1, ADR (Parent), NIL);
            IF (ownFont IN DI.flags) THEN
               PathITxt[2].iTextFont := DI.font;
            END; (* IF *)
            StructGadget (Path[2], 194, NewDiskyWindow.height, 85, 9,
                          GadgetFlagSet {}, ActivationFlagSet {relVerify},
                          boolGadget, ADR (BoolBorder), ADR (PathITxt[2]),
                          LONGSET {}, 13, 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
               StructText (DevITxt[num], Pen, 0, jam1, 23, 1, ADR (DevTxt[num]),
                           NIL);
               IF (ownFont IN DI.flags) THEN
                  DevITxt[num].iTextFont := DI.font;
               END; (* IF *)
               IF num # NumDevs THEN
                  NextPtr := ADR (Dev[num+1]);
               ELSE
                  NextPtr := ADR (Str[1]);
               END; (* IF *)
               IF (((num - 1) MOD 3) = 0) AND (num # 1) THEN
                  INC (NewDiskyWindow.height, 13);
               END; (* IF *)
               StructGadget (Dev[num], DevLeft, NewDiskyWindow.height, 85, 9,
                             GadgetFlagSet {}, ActivationFlagSet {relVerify},
                             boolGadget, ADR (BoolBorder), ADR (DevITxt[num]),
                             LONGSET {}, num + 13, NextPtr);
               INC (DevLeft, 93);
               IF DevLeft > 194 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
               StructText (StrITxt[1], Pen, 0, jam1, -88, 0, ADR (GDir), NIL);
            ELSE
               StructText (StrITxt[1], Pen, 0, jam1, -92, 0, ADR (EDir), NIL);
            END; (* IF *)
            IF (ownFont IN DI.flags) THEN
               StrITxt[1].iTextFont := DI.font;
            END; (* IF *)
            StructGadget (Str[1], 103, NewDiskyWindow.height + 1, 180, 9,
                          GadgetFlagSet {}, ActivationFlagSet {relVerify},
                          strGadget, ADR (StrBorder), ADR (StrITxt[1]),
                          LONGSET {}, 23, ADR (Str[2]));
            StructString (StrInfo[1], DI.dir, UndoBuffer);
            StrInfo[1].dispCount := 22; (* Klaedtke *)
            Str[1].specialInfo := ADR (StrInfo[1]);
            INC (NewDiskyWindow.height, 13);
         END; (* IF *)

         IF (german IN DI.flags) THEN
            StructText (StrITxt[2], Pen, 0, jam1, -88, 0, ADR (GFile), NIL);
         ELSE
            StructText (StrITxt[2], Pen, 0, jam1, -92, 0, ADR (EFile), NIL);
         END; (* IF *)
         IF (ownFont IN DI.flags) THEN
            StrITxt[2].iTextFont := DI.font;
         END; (* IF *)
         IF NOT (suffixGad IN DI.flags) THEN
            NextPtr := ADR (End[1]);
         ELSE
            NextPtr := ADR (Str[3]);
         END; (* IF *)
         StructGadget (Str[2], 103, NewDiskyWindow.height + 1, 180, 9,
                       GadgetFlagSet {}, ActivationFlagSet {relVerify},
                       strGadget, ADR (StrBorder), ADR (StrITxt[2]),
                       LONGSET {}, 24, NextPtr);
         StructString (StrInfo[2], DI.file, UndoBuffer);
         Str[2].specialInfo := ADR (StrInfo[2]);
         INC (NewDiskyWindow.height, 13);

         IF (suffixGad IN DI.flags) THEN
            IF (german IN DI.flags) THEN
               StructText (StrITxt[3], Pen, 0, jam1, -88, 0, ADR (GSuf), NIL);
            ELSE
               StructText (StrITxt[3], Pen, 0, jam1, -92, 0, ADR (ESuf), NIL);
            END; (* IF *)
            IF (ownFont IN DI.flags) THEN
               StrITxt[3].iTextFont := DI.font;
            END; (* IF *)
            StructGadget (Str[3], 103, NewDiskyWindow.height + 1, 85, 9,
                          GadgetFlagSet {}, ActivationFlagSet {relVerify},
                          strGadget, ADR (SufBorder), ADR (StrITxt[3]),
                          LONGSET {}, 25, ADR (End[1]));
            StructString (StrInfo[3], DI.suffix, UndoBuffer);
            Str[3].specialInfo := ADR (StrInfo[3]);
            INC (NewDiskyWindow.height, 13);
         END; (* IF *)
         (* ENDFD *)
         (* FOLD: End-Gadgets (OK / CANCEL) *)
         IF (german IN DI.flags) THEN
            StructText (EndITxt[1], Pen, 0, jam1, 33, 1, ADR (GOK), NIL);
         ELSE
            StructText (EndITxt[1], Pen, 0, jam1, 33, 1, ADR (EOK), NIL);
         END; (* IF *)
         IF (ownFont IN DI.flags) THEN
            EndITxt[1].iTextFont := DI.font;
         END; (* IF *)
         StructGadget (End[1], 8, NewDiskyWindow.height, 85, 9,
                       GadgetFlagSet {}, ActivationFlagSet {relVerify},
                       boolGadget, ADR (BoolBorder), ADR (EndITxt[1]),
                       LONGSET {}, 26, ADR (End[2]));

         IF (german IN DI.flags) THEN
            StructText (EndITxt[2], Pen, 0, jam1, 17, 1, ADR (GCancel), NIL);
         ELSE
            StructText (EndITxt[2], Pen, 0, jam1, 21, 1, ADR (ECancel), NIL);
         END; (* IF *)
         IF (ownFont IN DI.flags) THEN
            EndITxt[2].iTextFont := DI.font;
         END; (* IF *)
         StructGadget (End[2], 194, NewDiskyWindow.height, 85, 9,
                       GadgetFlagSet {}, ActivationFlagSet {relVerify},
                       boolGadget, ADR (BoolBorder), ADR (EndITxt[2]),
                       LONGSET {}, 27, NIL);
         INC (NewDiskyWindow.height, 13);
         (* ENDFD *)
      END; (* WITH *)

      (* Window öffnen ! *)

      WITH NewDiskyWindow DO
         width       := 287;
         detailPen   := Back;
         blockPen    := Pen;
         idcmpFlags  := IDCMPFlagSet {gadgetUp, mouseMove};
         flags       := WindowFlagSet {activate, rmbTrap, windowDrag,
                                       windowDepth};
         title       := DI.title;
         firstGadget := ADR (GadgetsPtr^.File[1]);
         IF (ownScreen IN DI.flags) AND (DI.screen # NIL) THEN
            TheScreenPtr := DI.screen;
            screen := DI.screen;
            type   := customScreen; (* I guess *)
         ELSE
            TheScreenPtr := OpenWorkBench();
            screen := NIL;
            type   := ScreenFlagSet {wbenchScreen};
         END; (* IF *)
         IF NOT (ownPosition IN DI.flags) OR
            (DI.x < 0) OR (DI.x + width > TheScreenPtr^.width) THEN
            leftEdge := (TheScreenPtr^.width - width) / 2;
         ELSE
            leftEdge := DI.x;
         END; (* IF *)
         IF NOT (ownPosition IN DI.flags) OR (DI.y < 0) OR
            (DI.y + height > TheScreenPtr^.height) THEN
            topEdge := (TheScreenPtr^.height - height) / 2;
         ELSE
            topEdge := DI.y;
         END; (* IF *)
      END; (* WITH *)
      DiskyWindowPtr := OpenWindow (NewDiskyWindow);
   (* WITH DiskyWindowPtr^ DO
         SetAPen (rPort, Back);
         RectFill (rPort, 2, 10, width-4, height-2);
         RefreshGadgets (firstGadget, DiskyWindowPtr, NIL);
      END; (* WITH *) *) (* This should be the BackFill-Pen *)
      IF DiskyWindowPtr # NIL THEN
         IF (ownFont IN DI.flags) THEN
            FontPtr := OpenFont (DI.font);
            IF FontPtr = NIL THEN
               RETURN FALSE;
            ELSE
               CorrectFont;
            END; (* IF *)
         END; (* IF *)
         RETURN TRUE;
      ELSE
         RETURN FALSE;
      END; (* IF *)
   END BuildRequester;
   (* ENDFD *)
   (* FOLD: FileExists *)
   PROCEDURE FileExists (File: ARRAY OF CHAR) : BOOLEAN;

   VAR TestLockPtr : FileLockPtr;

   BEGIN
      TestLockPtr := Lock (ADR (File), accessRead);
      IF TestLockPtr # NIL THEN
         UnLock (TestLockPtr);
         RETURN TRUE;
      ELSE
         RETURN FALSE;
      END; (* IF *)
   END FileExists;
   (* ENDFD *)
   (* FOLD: InitList *)
   PROCEDURE InitList (VAR List : StringList; MaxLength : CARDINAL);

   BEGIN
      WITH List DO
         numEntries := 0;
         maxLength  := MaxLength;
         firstEntry := NIL;
      END; (* WITH *)
   END InitList;
   (* ENDFD *)
   (* FOLD: FreeList *)
   PROCEDURE FreeList (VAR List : StringList);

   VAR CurrentPtr, NextPtr : StringEntryPtr;

   BEGIN
      WITH List DO
         IF NOT ((numEntries = 0) OR (firstEntry = NIL)) THEN
            CurrentPtr := firstEntry;
            WHILE (CurrentPtr # NIL) DO
               NextPtr := CurrentPtr^.nextEntry;
               Deallocate (CurrentPtr^.string);
               Deallocate (CurrentPtr);
               CurrentPtr := NextPtr;
            END; (* WHILE *)
         END; (* IF *)
         InitList (List, maxLength);
      END; (* WITH *)
   END FreeList;
   (* ENDFD *)
   (* FOLD: AddEntry *)
   PROCEDURE AddEntry (VAR List : StringList; String : ARRAY OF CHAR) : BOOLEAN;

   VAR CurrentPtr, NewPtr, LastPtr : StringEntryPtr;

   BEGIN
      Allocate (NewPtr, SIZE (NewPtr^));
      IF NewPtr = NIL THEN
         RETURN FALSE;
      END; (* IF *)
      Allocate (NewPtr^.string, List.maxLength + 1);
      IF NewPtr^.string = NIL THEN
         Deallocate (NewPtr);
         RETURN FALSE;
      END; (* IF *)
      Copy (NewPtr^.string^, String);
      IF (noSort IN DI.flags) OR (List.firstEntry = NIL) THEN
         NewPtr^.nextEntry := List.firstEntry;
         List.firstEntry   := NewPtr;
      ELSE
         LastPtr    := NIL;
         CurrentPtr := List.firstEntry;
         WHILE (Compare (CurrentPtr^.string^, String) < 0) AND
               (CurrentPtr # NIL) DO
            LastPtr    := CurrentPtr;
            CurrentPtr := LastPtr^.nextEntry;
         END; (* WHILE *)
         NewPtr^.nextEntry := CurrentPtr;
         IF LastPtr = NIL THEN
            List.firstEntry := NewPtr;
         ELSE
            LastPtr^.nextEntry := NewPtr;
         END; (* IF *)
      END; (* IF *)
      INC (List.numEntries);
      RETURN TRUE;
   END AddEntry;
   (* 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;
      IF Strings.Compare (File, DotPos+1, Length (Suffix)+1, Suffix, FALSE) = 0 THEN
         RETURN TRUE;
      ELSE
         RETURN FALSE;
      END; (* IF *)
   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: GetPathFromLock *)
   PROCEDURE GetPathFromLock (VAR Path : ARRAY OF CHAR; ThisLockPtr : FileLockPtr);

   (* von irgendeiner PD-Disk aus 'C' in Modula-II üersetzt (Autor ???) *)

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

   BEGIN
      Copy (Path, "");
      CurDirPtr := DupLock (ThisLockPtr);
      IF CurDirPtr = NIL THEN RETURN; END;
      Allocate (FIBPtr, SIZE (FIBPtr^));
      IF FIBPtr # NIL THEN
         Forbid;
         BSTRCopy (Path, CurDirPtr^.volume^.name);
         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 *)
         Deallocate (FIBPtr);
      END; (* IF *)
   END GetPathFromLock;
   (* ENDFD *)
   (* FOLD: UpdateGadgets *)
   PROCEDURE UpdateGadgets;

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

      BEGIN
         RefreshGList (ADR (WhichGadget), DiskyWindowPtr, NIL, 0);
      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 := 0;
               dispPos   := 0;
            END; (* WITH *)
            OnlyRefresh (Str[2]);
         END; (* IF *)

         IF (DirList.numEntries + FileList.numEntries > 10) THEN
            Body := (maxBody DIV (DirList.numEntries + FileList.numEntries))*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;

   VAR border : [1..2];

   BEGIN
      IF (ownFont IN DI.flags) THEN
         IF FontPtr # NIL THEN
            CloseFont (FontPtr);
            FontPtr := NIL;
         END; (* IF *)
      END; (* IF *)
      IF CurrentLockPtr # NIL THEN
         UnLock (CurrentLockPtr);
         CurrentLockPtr := NIL;
      END; (* IF *)
      FreeList (DirList);
      FreeList (FileList);
      FreeBorder (GadgetsPtr^.BoolBorder);
      FOR border := 1 TO 2 DO
         FreeBorder (GadgetsPtr^.StrBorder[border]);
         FreeBorder (GadgetsPtr^.SufBorder[border]);
      END; (* FOR *)
      FreeBorder (GadgetsPtr^.HyperBorder);
      IF DiskyWindowPtr # NIL THEN
         CloseWindow (DiskyWindowPtr);
      END; (* IF *)
      IF MyFIBPtr # NIL THEN
         Deallocate (MyFIBPtr);
      END; (* IF *)
      IF GadgetsPtr # NIL THEN
         Deallocate (GadgetsPtr);
      END; (* IF *)
   END CloseDown;
   (* ENDFD *)
   (* FOLD: GetGadID *)
   PROCEDURE GetGadID (VAR ID : CARDINAL) : BOOLEAN;

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

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

   VAR TopOfDisplay : CARDINAL;
       HelpTop      : LONGCARD;
       DirsShown    : CARDINAL;

      (* FOLD: GetEntry *)
      PROCEDURE GetEntry (List : StringList; VAR String : ARRAY OF CHAR;
                          Number : CARDINAL);

      VAR CurrentPtr : StringEntryPtr;
          count      : CARDINAL;

      BEGIN
         count := 1;
         IF List.numEntries < Number THEN
            Copy (String, "");
            RETURN;
         END; (* IF *)
         CurrentPtr := List.firstEntry;
         WHILE (count < Number) DO
            CurrentPtr := CurrentPtr^.nextEntry;
            INC (count);
         END; (* WHILE *)
         Copy (String, CurrentPtr^.string^);
      END GetEntry;
      (* ENDFD *)
      (* FOLD: MakeGadITxt *)
      PROCEDURE MakeGadITxt;

      VAR Len  : CARDINAL;
          Fill : CARDINAL;

      BEGIN
         WITH GadgetsPtr^ DO
            Copy (FileTxt[FileNum], Files[FileNum]);
            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 FMode[FileNum] = dir THEN
               IF NOT (ownColors IN DI.flags) THEN
                  FileITxt[FileNum].frontPen := StdDPen;
               ELSE
                  FileITxt[FileNum].frontPen := DI.dirPen;
               END; (* IF *)
            ELSIF FMode[FileNum] = file THEN
               IF NOT (ownColors IN DI.flags) THEN
                  FileITxt[FileNum].frontPen := StdFPen;
               ELSE
                  FileITxt[FileNum].frontPen := DI.filePen;
               END; (* IF *)
            END; (* IF *)
         END; (* WITH *)
      END MakeGadITxt;
      (* ENDFD *)

   BEGIN
      IF (DirList.numEntries + FileList.numEntries > 10) THEN
         HelpTop := GadgetsPtr^.MyPropInfo.vertPot;
         HelpTop := (HelpTop * (DirList.numEntries + FileList.numEntries - 10)) /
                    maxPot;
         TopOfDisplay := HelpTop;
      ELSE
         TopOfDisplay := 0;
      END; (* IF *)
      IF (OldTop # TopOfDisplay) OR (sure = TRUE) THEN
         OldTop := TopOfDisplay;
         IF TopOfDisplay < DirList.numEntries THEN
            DirsShown := TopOfDisplay;
         ELSE
            DirsShown := DirList.numEntries;
         END; (* IF *)
         FOR FileNum := 1 TO 10 DO
            IF FileNum + TopOfDisplay <= DirList.numEntries THEN
               GetEntry (DirList, Files[FileNum], FileNum + TopOfDisplay);
               FMode[FileNum] := dir;
               INC (DirsShown);
            ELSIF FileNum+TopOfDisplay-DirsShown <= FileList.numEntries THEN
               GetEntry (FileList, Files[FileNum], FileNum + TopOfDisplay -
                                                   DirsShown);
               FMode[FileNum] := file;
            ELSE
               Copy (Files[FileNum], "");
               FMode[FileNum] := empty;
            END; (* IF *)
            MakeGadITxt;
         END; (* FOR *)
         RefreshGList (ADR (GadgetsPtr^.File[1]), DiskyWindowPtr, NIL, 10);
      END; (* IF *)
   END RefreshFiles;
   (* ENDFD *)
   (* FOLD: PrepareRead *)
   PROCEDURE PrepareRead;

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

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

   BEGIN
      IF (IoErr() = noMoreEntries) THEN
         Mode := ready;
         UpdateGadgets;
         RefreshFiles (TRUE);
      ELSE
         GetFile := TRUE;
         Copy (FileStore, MyFIBPtr^.fileName);
         IF (MyFIBPtr^.dirEntryType > 0) AND NOT (onlyFiles IN DI.flags) THEN
            IF (dirExt IN DI.flags) THEN
               Concat (FileStore, " (dir)");
            END; (* IF *)
            IF (AddEntry (DirList, FileStore) = FALSE) THEN
               DisplayBeep (NIL);
            END; (* IF *)
         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 = TRUE THEN
               IF (DI.suffix[0] # 0C) AND (watchSuffix IN DI.flags) THEN
                  CutSuffix (FileStore);
               END; (* IF *)
               IF (AddEntry (FileList, FileStore) = FALSE) THEN
                  DisplayBeep (NIL);
               END; (* IF *)
            END; (* IF *)
         END; (* IF *)
      END; (* IF *)
      IF ExNext (CurrentLockPtr, MyFIBPtr) THEN END;
   END ReadDir;
   (* ENDFD *)
   (* FOLD: ScanPath *)
   PROCEDURE ScanPath;

   VAR HelpLockPtr : FileLockPtr;
       PathStore   : ARRAY [0..200] OF CHAR;
       FIBPtr      : FileInfoBlockPtr;

      (* FOLD: GetSuffix *)
      PROCEDURE GetSuffix;

      VAR DotPos : INTEGER;
          SufPtr : StringPtr;

      BEGIN
         DotPos := LastPos (PathStore, Length (PathStore), '.');
         IF DotPos # noOccur THEN
            SufPtr := ADR (PathStore[DotPos+1]);
            Copy (DI.suffix, SufPtr^);
            PathStore[DotPos] := 0C;
         END; (* IF *)
      END GetSuffix;
      (* ENDFD *)
      (* FOLD: GetFile *)
      PROCEDURE GetFile;

      VAR DivPos  : INTEGER;
          FilePtr : StringPtr;

      BEGIN
         DivPos := LastPos (PathStore, Length (PathStore), '/');
         IF DivPos = noOccur THEN
            DivPos := LastPos (PathStore, Length (PathStore), ':');
            IF DivPos = noOccur THEN
               Copy (DI.file, PathStore);
               RETURN;
            END; (* IF *)
         END; (* IF *)
         FilePtr := ADR (PathStore[DivPos+1]);
         Copy (DI.file, FilePtr^);
         PathStore[DivPos] := 0C;
      END GetFile;
      (* ENDFD *)

   BEGIN
      Allocate (FIBPtr, SIZE (FIBPtr^));
      IF FIBPtr # NIL THEN
         HelpLockPtr := Lock (ADR (DI.path), accessRead);
         IF HelpLockPtr # NIL THEN
            GetPathFromLock (PathStore, HelpLockPtr);
            Copy (DI.path, PathStore);
            IF Examine (HelpLockPtr, FIBPtr) THEN
               IF FIBPtr^.dirEntryType < 0 THEN
                  IF (watchSuffix IN DI.flags) THEN
                     GetSuffix;
                  END; (* IF *)
                  GetFile;
               END; (* IF *)
               Copy (DI.dir, PathStore);
               UnLock (HelpLockPtr);
            END; (* IF *)
         END; (* IF *)
      END; (* IF *)
      Deallocate (FIBPtr);
   END ScanPath;
   (* ENDFD *)

BEGIN
   IF (startPath IN DI.flags) THEN
      ScanPath;
   END; (* IF *)
   FontPtr := NIL;
   Allocate (MyFIBPtr, SIZE (MyFIBPtr^));
   IF MyFIBPtr = NIL THEN CloseDown; RETURN ErrNoMem; END;
   Allocate (GadgetsPtr, SIZE (GadgetsPtr^));
   IF GadgetsPtr = NIL THEN CloseDown; RETURN ErrNoMem; END;
   IF BuildRequester() = FALSE THEN CloseDown; RETURN ErrNoReq; END;
   InitList (DirList, MaxFL);
   InitList (FileList, MaxFL);
   Mode := begin;
   CurrentLockPtr := Lock (ADR (DI.dir), accessRead);
   IF CurrentLockPtr = NIL THEN
      DisplayBeep (NIL);
      CurrentLockPtr := Lock (NIL, accessRead);
      IF CurrentLockPtr = NIL THEN
         DisplayBeep (NIL);
         Mode := ready;
      END; (* IF *)
   END; (* IF *)
   LOOP
      IF GetGadID (ID) = TRUE THEN
         CASE ID OF
         |  MinFileID..MaxFileID :
            IF FMode[ID] = dir THEN
               IF (CurrentLockPtr # NIL) THEN
                  UnLock (CurrentLockPtr);
               END; (* IF *)
               IF (dirExt IN DI.flags) THEN
                  len := Length (Files[ID]);
                  Files[ID][len-6] := 0C;
               END; (* IF *)
               ConnectToDir (DI.dir, Files[ID]);
               CurrentLockPtr := Lock (ADR (DI.dir), accessRead);
               Mode := begin;
            ELSIF FMode[ID] = file THEN
               IF (Compare (DI.file, Files[ID]) = 0) THEN
                  (* Doppelklick *)
                  IF DoubleClick (lastSec, lastMic, Sec, Mic) THEN
                     IF (fileExists IN DI.flags) THEN
                        IF FileExists (DI.path) = TRUE THEN
                           CloseDown;
                           RETURN DiskyOK;
                        ELSE
                           DisplayBeep (NIL);
                        END; (* IF *)
                     ELSE
                        CloseDown;
                        RETURN DiskyOK;
                     END; (* IF *)
                  END; (* IF *)
               ELSE
                  Copy (DI.file, Files[ID]);
                  ConnectAll;
                  UpdateGadgets;
               END; (* IF *)
            END; (* IF *)
            lastSec := Sec; lastMic := Mic;
         |  PropID :
            RefreshFiles (FALSE);
         |  MinPathID..MaxPathID :
            LOOP
               BackupLockPtr := CurrentLockPtr;
               CurrentLockPtr := ParentDir (CurrentLockPtr);
               IF CurrentLockPtr = NIL THEN
                  IF ID = ParentID THEN
                     DisplayBeep (NIL);
                  END; (* IF *)
                  CurrentLockPtr := BackupLockPtr;
                  EXIT;
               ELSE
                  UnLock (BackupLockPtr);
                  Mode := begin;
               END; (* IF *)
               IF ID = ParentID THEN
                  EXIT;
               END; (* IF *)
            END; (* LOOP *)
         |  MinDevID..MaxDevID :
            IF CurrentLockPtr # NIL THEN
               UnLock (CurrentLockPtr);
            END; (* IF *)
            CurrentLockPtr := Lock (ADR (GadgetsPtr^.DevTxt[ID - MinDevID + 1]),
                                    accessRead);
            Mode := begin;
         |  MinStrID..MaxStrID :
            IF ID = DirID THEN
               IF CurrentLockPtr # NIL THEN
                  UnLock (CurrentLockPtr);
               END; (* IF *)
               CurrentLockPtr := Lock (GadgetsPtr^.StrInfo[1].buffer, accessRead);
               Mode := begin;
            ELSIF ID = SuffixID THEN
               Mode := begin;
            END; (* IF *)
            ConnectAll;
         |  MinEndID..MaxEndID :
            ConnectAll;
            IF ID = OKID THEN
               IF (fileExists IN DI.flags) THEN
                  IF FileExists (DI.path) = TRUE THEN
                     CloseDown;
                     RETURN DiskyOK;
                  ELSE
                     DisplayBeep (NIL);
                  END; (* IF *)
               ELSE
                  CloseDown;
                  RETURN DiskyOK;
               END; (* IF *)
            ELSIF ID = CancelID THEN
               CloseDown;
               RETURN DiskyCancel;
            END; (* IF *)
         END; (* CASE *)
      END; (* IF *)
      IF Mode = begin THEN
         PrepareRead;
      ELSIF Mode = read THEN
         ReadDir;
      END; (* IF *)
   END; (* LOOP *)
END Disky;
(* ENDFD *)

BEGIN
   AllocProc   := AllocMem;
   DeallocProc := Deallocate;
END FileRequest.