Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/037.lha/DU/Du21wb.mod

Text File | 1987-05-17 | 22.0 KB | 910 lines

MODULE DuM221wb;


(*$S-*)(*$T-*)(*$A+*)


(*

221wb is for workbench implementation - all functions now SEEM to work
 although 'cd' shows the directory outside the DirUtil to be DF0:
 so all names passed have full paths now when passed so proper files will
 be affected.

Modula 2 Development program & DirUtil combined

Compiled on (and used with) 2.20a

DirUtil/window aided modula development program gives easy function use
from a DirUtil shell. It's NOT a tiny version + has  a few special commands
to aid edit, compile and link of Modula-2 files.  I didn't include direct
run of M2Error although DO R+f with M2Error in 'R' works.

Hey! This version uses lots of memory - don't try compiling with it on a
512k machine.

If someone makes it go with 3.00, substitute Editor for my favorite 'dme'
editor and you will get the error handling that way.

*)

(* M2: normal library modules *)

FROM SYSTEM         IMPORT  ADR, NULL,TSIZE,BYTE,ADDRESS;
FROM Conversions    IMPORT  ConvertToString;
FROM DOSCodeLoader  IMPORT  Execute;
FROM DOSFiles       IMPORT  CurrentDir,IoErr,InfoData,Info,CreateDir,
                            FileHandle,Output,Lock,Unlock,AccessRead,
                            FileLock,Open,Close,Read,Write,DeleteFile,
                            Examine,Rename,FileInfoBlock,
                            AccessWrite,ModeNewFile, ModeOldFile;
FROM DOSLibrary     IMPORT  DOSBase;
FROM Gadgets        IMPORT  RefreshGadgets;
FROM Libraries      IMPORT  CloseLibrary;
FROM Memory         IMPORT  AllocMem,FreeMem,MemReqSet,MemClear,
                            MemPublic,MemChip,MemFast,AvailMem;
FROM Ports          IMPORT  WaitPort;
FROM Strings        IMPORT  Assign,Concat,Length,Insert;

(* My Specific library modules *)

FROM MyStart        IMPORT  EnteredFromWorkbench,InitialInput,CleanUpAndExit;
FROM MyGlobals      IMPORT  GadgetNames,MyWindowPtr,IOString,NullReqPtr,
                            MyMsg,CloseMe,RefreshMe,GotOne,MyClass,GadTxt,
                            IOStringInfo,CharPtr,Curfirst,inf,v,MyGads,
                            FileInfoBlockPtr,Curdir,Reqdir,Entrydirlock,
                            Lastdirlock,Curdirlock,Reqdirlock,IntRead,
                            Stop,GadGot,MyX,MyY,Gp,from,Boo,WBColors,
                            FileText,DirEntries,DirTable,MaxScreenFiles;
FROM MyType         IMPORT  DisplayASCII,DisplayHex;
FROM MyWindow       IMPORT  CloseMyWindow,OpenMyWindow,SlidePot;
FROM MyMisc         IMPORT  ReadDirectory,QSort,DisplayFiles,NewDir,ShowMem,
                            Interrupt,CheckMessages,ReplaceRSDM,ClearTable;
FROM MyVolName      IMPORT  VolumeName;


CONST (* Misc last minute stuff *)
 colon    = ":";
 slash    = "/";
 nul      = "";
 blank    = " ";

VAR
 Holder   : GadgetNames;
 MoreToDo : BOOLEAN;
 OutTo    : FileHandle;
 UnlockNext: BOOLEAN;

(* =================================================================*)

(* MESSAGE TYPE STUFF *)

PROCEDURE Inform(VAR a:ARRAY OF CHAR);
(* put something in the 'M' string *)
BEGIN
  ShowMem;
  ReplaceRSDM(msg,a);
END Inform;

(* Common messages all here to keep constants to a minimum *)

PROCEDURE SayOK;
BEGIN
   IF (NOT IntRead) THEN Inform("OK") END;
END SayOK;

PROCEDURE SayAbort;
BEGIN
   Inform("INTERRUPT!");
END SayAbort;

PROCEDURE EndIt(er:LONGINT);
BEGIN
  IF er = 0 THEN SayOK
   ELSIF er = -1 THEN Inform("'D' string?")
    ELSIF er = -2 THEN SayAbort
     ELSE DisplayError("Couldn't finish",er);
  END;
END EndIt;

PROCEDURE DisplayError(VAR a:ARRAY OF CHAR; de:LONGINT);
(* display error message with DOS error code *)
BEGIN
  AssignGp(a);
  IF de > 0 THEN
    AppGp(" - DOS err ");
    StringIt(LONGCARD(de));
    AppGp(v);
  END;
  Inform(Gp);
END DisplayError;


(* STRING STUFF

Mostly to save a parameter pass or two on frequent stuff. This program
needs to run in 512k with a memory hogging compiler and still have some
useful features in it, so save bytes!
*)

PROCEDURE Append(VAR this,tothis:ARRAY OF CHAR);
BEGIN
  Concat(tothis,this,tothis);
END Append;

PROCEDURE AppGp(VAR a:ARRAY OF CHAR);
BEGIN
  Append(a,Gp);
END AppGp;

PROCEDURE Prepend(VAR this,beforethis:ARRAY OF CHAR);
BEGIN
  Insert(this,beforethis,0);
END Prepend;

PROCEDURE PreGp(VAR a:ARRAY OF CHAR);
BEGIN
  Prepend(a,Gp);
END PreGp;

PROCEDURE AssignGp(VAR a:ARRAY OF CHAR);
BEGIN
  Assign(Gp,a);
END AssignGp;

PROCEDURE AssignReqdir(VAR a:ARRAY OF CHAR);
BEGIN
  Assign(Reqdir,a);
END AssignReqdir;

PROCEDURE FillGpto(VAR a,b:ARRAY OF CHAR);
BEGIN
  PreGp(" to ");
  PreGp(b);
  PreGp(a);
  Inform(Gp);
END FillGpto;

PROCEDURE AddNameToPath(VAR name,path:ARRAY OF CHAR);
VAR p : CARDINAL;
BEGIN
  AssignGp(path);
  p := Length(Gp);
  IF (p>0) AND (Gp[p-1] <> colon) THEN AppGp(slash) END;
  AppGp(name);
END AddNameToPath;

PROCEDURE MoveStr(p:ADDRESS;VAR des:ARRAY OF CHAR);
(* Good ONLY if you know 'p' has a NULL end and fits in 'des' *)
VAR i:CARDINAL;Cp:CharPtr;
BEGIN
  Cp := CharPtr(p);
  i := 0;
  REPEAT
    des[i] := Cp^;
    INC(i);
    INC(Cp);
  UNTIL (des[i-1]) = 0C;
END MoveStr;

PROCEDURE StringIt(n:LONGCARD);
BEGIN
  ConvertToString(n,10,FALSE,v,Boo);
END StringIt;


(* SPACE SAVERS *)

PROCEDURE GetLock(VAR a:ARRAY OF CHAR):FileLock;
(* Save one parameter/call in others [all AccessRead] *)
BEGIN
  RETURN Lock(a,AccessRead);
END GetLock;

PROCEDURE LocksOK(VAR a:ARRAY OF CHAR):BOOLEAN;
(* Checks for presence *)
BEGIN
  from := GetLock(a);
  IF from <> 0 THEN
    Unlock(from);
    RETURN TRUE;
  END;
  RETURN FALSE
END LocksOK;


(* MORE INVOLVED PROCEDURES *)



PROCEDURE DoFileLook;
VAR  i:CARDINAL;
BEGIN
  Holder := GadGot;
  FOR i := 1 TO DirEntries DO
    IF Interrupt() THEN SayAbort; RETURN END;
    WITH DirTable[i]^ DO
      AddNameToPath(FileName,IOString[source]);
      IF (IsSelected) AND (NOT IsDir) THEN
        Boo := FALSE;
        IF (Holder = htype) OR (Holder = type) THEN Boo := TRUE END;
        IF LocksOK(Gp) THEN
          IF NOT Boo THEN
            AssignReqdir("Printing ");
            Append(Gp,Reqdir);
            Inform(Reqdir);
          END;
          IF (Holder = type) OR (Holder = print) THEN
            DisplayASCII(Gp,Boo)
          ELSE
            DisplayHex(Gp,Boo)
          END;
          WasSelected := TRUE;
          IsSelected := FALSE;
        END
      END
    END
  END;
  SayOK;
END DoFileLook;


PROCEDURE MyCopy(VAR from,into:ARRAY OF CHAR):LONGINT;
VAR  fhand,tohand:FileHandle;siz:LONGCARD;er,ex:LONGINT;
    ad:ADDRESS;

    PROCEDURE EndCopy;
    BEGIN
      Close(fhand);
      Close(tohand);
    END EndCopy;

BEGIN
  ex := LONGINT(0);
  siz := 8000H;    (* Only 32k byte buffer for now *)
  fhand := Open(from,ModeOldFile);
  IF fhand = 0 THEN RETURN IoErr() END;
  tohand := Open(into,ModeNewFile);
  IF tohand = 0 THEN
    er := IoErr();
    Close(fhand);
    RETURN er;
  END;
  REPEAT
    ad := AllocMem(siz,MemReqSet{MemPublic,MemClear});
    IF ad = NULL THEN DEC(siz,512) END;
  UNTIL (ad # NULL) OR (siz < 512);
  IF ad = NULL THEN
    EndCopy;
    RETURN LONGINT(-3)
  END;
  FillGpto("Copying  ",from);
  REPEAT
    er := Read(fhand,ad,siz);
    IF er > 0 THEN er := Write(tohand,ad,LONGCARD(er)) ELSE ex := IoErr() END;
  UNTIL (er <> LONGINT(siz));
  EndCopy;
  FreeMem(ad,siz);
  RETURN ex;
END MyCopy;


PROCEDURE AValidPath():BOOLEAN;
(* checks to see that IOString[dest] is a valid path without name *)
VAR  m:FileInfoBlockPtr;
BEGIN
 Boo := FALSE; (* Assume not ok *)
 IF IOStringInfo[dest].NumChars = 0 THEN RETURN Boo END;
 from := GetLock(IOString[dest]);
 IF from = 0 THEN RETURN Boo END;
 m := AllocMem(TSIZE(FileInfoBlock),MemReqSet{MemPublic,MemClear});
 IF (m # NULL) AND Examine(from,m^) AND (m^.fibDirEntryType > 0) THEN
   Boo := TRUE
 END;
 Unlock(from);
 FreeMem(m,TSIZE(FileInfoBlock));
 RETURN Boo;
END AValidPath;


PROCEDURE MyFileMovement():LONGINT;
(* Returns IoErr *)
VAR i:CARDINAL ;g:GadgetNames;er:LONGINT;
BEGIN
  g := GadGot;
  IF ((g=copy) OR (g=copydel)) AND (NOT AValidPath()) THEN
    RETURN LONGINT(-1)
  END;
  FOR i := 1 TO DirEntries DO
    IF Interrupt() THEN RETURN LONGINT(-2) END;
    WITH DirTable[i]^ DO
      AddNameToPath(FileName,IOString[source]);
      AssignReqdir(Gp);
      AssignGp(IOString[dest]);
       (* Reqdir = fully extended source name
          Gp     = dest contents (may further extend if only path)
       *)
      IF (g=rename) AND (IsSelected) THEN
        IF LocksOK(FileName) THEN
          IF Rename(Reqdir,Gp) THEN
            FillGpto("Renamed ",FileName);
            FileName[0] := 177C;
            RETURN LONGINT(0);
          ELSE
            RETURN IoErr();
          END;
        ELSE
          RETURN IoErr();
        END;
      END;
      IF (IsSelected) AND (NOT IsDir) THEN
        IF LocksOK(FileName) THEN
          IF (g=move) THEN
            AddNameToPath(FileName,IOString[dest]);(*Substitute Gp*)
            IF Rename(Reqdir,Gp) THEN
              FillGpto("Moved ",FileName);
              FileName[0] := 177C
            ELSE
              RETURN IoErr();
            END;
          END;
          IF (g=copy) OR (g=copydel) THEN
            AddNameToPath(FileName,IOString[dest]);(* Extend dest name*)
            er := (MyCopy(Reqdir,Gp));
            IF (er <> 0)  THEN RETURN er END;
          END;
          IF (g=delete) OR (g=copydel) THEN
            AssignGp("Deleting ");
            AppGp(Reqdir);
            Inform(Gp);
            IF DeleteFile(Reqdir) THEN
              FileName[0] := 177C;
            ELSE
              RETURN IoErr();
            END;
          END;
        END;
        IsSelected := FALSE;
        WasSelected := TRUE;
      END; (* If selectedfile *)
    END  (* WITH *)
  END; (* FOR *)
  RETURN LONGINT(0);
END MyFileMovement;


(*
Here are names used to edit, compile, link or DO things.
Room after 'dme' is for direct file patching
*)

PROCEDURE CheckMore(m:CARDINAL);
(*
Checks if more files / sets whether to RUN or DO next pass
*)
 VAR i:CARDINAL; BEGIN
  MoreToDo := FALSE;
  IF m <= DirEntries THEN
    FOR i := m TO DirEntries DO
      IF DirTable[i]^.IsSelected THEN MoreToDo := TRUE END;
    END;
  END;
END CheckMore;


PROCEDURE TryIt(g:GadgetNames;VAR Name:ARRAY OF CHAR);
BEGIN
  AssignGp(Name);
  IF Name[0] <> 0C THEN AddNameToPath(Name,IOString[source]) END;
  CASE g OF
     arc    : AssignReqdir("arc");
  |  dofr   : AssignReqdir(Gp);
  |  dorf   : AssignReqdir(IOString[run]);
  |  edit   : AssignReqdir("dme       ");  (* allow a 10 char name patch *)
  |  link   : AssignReqdir("link");
  |  modula : AssignReqdir("modula");
  |  show   : AssignReqdir("show      ");  (* allow a 10 char name patch *)
  ELSE
  END;
    (* force separation of tail *)
  Append(blank,Reqdir);
    (* add in 'R' if 'dofr' or 'arc' *)
  IF (g = dofr) OR (g=arc) THEN Append(IOString[run],Reqdir)
   ELSE Append(Gp,Reqdir)
  END;
    (* if 'arc' then add 'D' and then Name *)
  IF (g = arc) THEN
    Append(blank,Reqdir);
    Append(IOString[dest],Reqdir);
    Append(blank,Reqdir);
    Append(Gp,Reqdir);
  END;
    (* if 'link' then add "o" optimize switch *)
  IF (g = link) THEN Append(" o",Reqdir) END;
  IF NOT MoreToDo THEN Prepend("RUN >NIL: ",Reqdir) END;
  Inform(Reqdir);
  IF Execute(Reqdir,FileHandle(0),OutTo) THEN END;
END TryIt;


PROCEDURE MyExec():LONGINT;
VAR  i:CARDINAL ;g:GadgetNames;
BEGIN
  g := GadGot;
  Boo := (g > edit);
  FOR i := 1 TO DirEntries DO
    IF Interrupt() THEN RETURN LONGINT(-2) END;
    WITH DirTable[i]^ DO
      IF (IsSelected) THEN
        IF (NOT IsDir) OR (g = dorf) THEN
          CheckMore(i+1);
          Boo := TRUE;
          TryIt(g,FileName);
        END;
      IsSelected := FALSE;
      WasSelected := TRUE;
      END;
    END;
  END;
  IF NOT Boo THEN TryIt(g,nul) END;
  RETURN LONGINT(0);
END MyExec;


PROCEDURE GetReqDir():BOOLEAN;
(* Get directory in Reqdir - or say couldn't *)
BEGIN
  Reqdirlock := GetLock(Reqdir);
  IF (Reqdirlock = 0) THEN RETURN FALSE END;
  IntRead := FALSE;
  IF NOT ReadDirectory(Reqdirlock) THEN
    Unlock(Reqdirlock);
    RETURN FALSE
  ELSE
    IF DirEntries > 1 THEN QSort END;
    NewDir;
    Lastdirlock := CurrentDir(Reqdirlock);
    IF UnlockNext THEN
      IF Lastdirlock <> 0 THEN Unlock(Lastdirlock) END;
    ELSE
      UnlockNext := TRUE
    END;
    Curdirlock := Reqdirlock;
    Assign(Curdir,Reqdir);
    Curfirst := 1;
    RETURN TRUE
  END;
END GetReqDir;


PROCEDURE RedisplayFiles;
(* only if more than a screenfull *)
VAR Vpot : CARDINAL;temp:LONGCARD;
BEGIN
  IF (DirEntries > MaxScreenFiles) THEN
    Vpot := SlidePot();
    temp := LONGCARD(DirEntries - MaxScreenFiles);
    temp := temp * LONGCARD(Vpot);
    Curfirst := CARDINAL(temp DIV 0FFFFH)+1;
    IF Vpot = 0FFFFH THEN Curfirst := 999 END;
    ReShow;
  END;
END RedisplayFiles;


PROCEDURE ReShow;
BEGIN
  IF DirEntries < MaxScreenFiles THEN Curfirst := 1
   ELSIF Curfirst > DirEntries - MaxScreenFiles + 1 THEN
     Curfirst := DirEntries - MaxScreenFiles + 1
  END;
  IF Curfirst < 1 THEN Curfirst := 1 END;
  DisplayFiles(Curfirst);
END ReShow;


PROCEDURE GetDev;
(* Get the device hit *)
VAR i:CARDINAL;
BEGIN
  MoveStr(MyGads[GadGot].GadgetText^.IText,Reqdir);
  IF GetReqDir() THEN SayOK; ReplaceRSDM(source,Reqdir) END;
END GetDev;


PROCEDURE GetSource;
(* Get IOString[source] directory [if possible] w/bailout alternates *)
VAR i : CARDINAL;
BEGIN
  AssignReqdir(IOString[source]);
  IF (IOStringInfo[source].NumChars = 0) THEN AssignReqdir(colon) END;
  (* If can't get then switch back to currently selected directory *)
  IF NOT GetReqDir() THEN
    DisplayError("Error - switching back!",IoErr());
    AssignReqdir(Curdir);
    IF NOT GetReqDir() THEN
      DisplayError("Error - going to ram:",IoErr());
      GadGot := ram;
      GetDev;
    END;
  END;
  ReplaceRSDM(source,Curdir);
  SayOK;
END GetSource;


PROCEDURE GetParent;
(* Get parent [or root]dir & name *)
VAR i, l:CARDINAL;
BEGIN
  AssignReqdir(IOString[source]);
  l := Length(Reqdir);
  Stop := FALSE;
  REPEAT
    DEC(l);
    IF (Reqdir[l] = slash) AND (GadGot = parent) THEN
      Reqdir[l] := 0C; Stop := TRUE;
    ELSIF (Reqdir[l] = colon) THEN
      Reqdir[l+1] := 0C; Stop := TRUE;
    END;
  UNTIL (l=0) OR (Stop);
  IF (Reqdir[0] = 0C) THEN AssignReqdir(colon) END;
  ReplaceRSDM(source,Reqdir);
  GetSource;
END GetParent;


PROCEDURE SelectDir(n:CARDINAL);
(* Select a directory and possibly enter it *)
VAR i,j:CARDINAL;
BEGIN
  FOR i := 1 TO DirEntries DO
    WITH DirTable[i]^ DO
      IF IsDir THEN
        IF i=n THEN
          IsSelected := NOT IsSelected;
        ELSE
          IsSelected := FALSE
        END;
      END;
    END;
  END;
  ReShow;
  IF (DirTable[n]^.IsSelected) THEN
    AssignGp(DirTable[n]^.FileName);
    PreGp('Click "');
    AppGp('" again to GETDIR');
    Inform(Gp);
    REPEAT UNTIL CheckMessages();
    j := CARDINAL((MyY - 24) DIV 8) + Curfirst;
    IF (GadGot = filewindow) AND (j = n) THEN
      SayOK;
      AddNameToPath(DirTable[n]^.FileName,IOString[source]);
      ReplaceRSDM(source,Gp);
      GetSource;
    ELSE
      SayAbort
    END;
  END;
END SelectDir;


PROCEDURE SelectFile;
(* toggle selection of file - goto SelectDir if hit over directory *)
VAR pos : CARDINAL; BEGIN
  pos := CARDINAL((MyY - 24) DIV 8) + Curfirst;
  IF pos <= DirEntries THEN
    WITH DirTable[pos]^ DO
      IF IsDir THEN
        SelectDir(pos)
      ELSE
        IsSelected := NOT IsSelected;
        ReShow;
      END
    END;
  END;
  SayOK;
END SelectFile;


PROCEDURE SelectAll;
(* Mass select/unselect/reselect all non-directory filenames *)
VAR i:CARDINAL;
BEGIN
  FOR i := 1 TO DirEntries DO
    IF NOT DirTable[i]^.IsDir THEN
      IF (GadGot = retag) THEN
         DirTable[i]^.IsSelected := DirTable[i]^.WasSelected;
      ELSE
        DirTable[i]^.IsSelected := (GadGot = tagall);
      END;
      DirTable[i]^.WasSelected := FALSE;
    END;
  END;
  ReShow;
  SayOK;
END SelectAll;

PROCEDURE DeleteDirectory;
(*
Delete a directory if not in use or filled
proposed option is delete even if filled - a mass directory kill
*)
VAR i,n:CARDINAL;er:LONGINT;l :FileLock;
BEGIN
  n := 0;i := 0;
  WHILE (n = 0) AND (i < DirEntries) DO
    INC(i);
    IF (DirTable[i]^.IsSelected) AND (DirTable[i]^.IsDir) THEN n := i END;
  END;
  IF (n > 0) THEN
    IF DeleteFile(DirTable[n]^.FileName) THEN
      GetSource;
      SayOK;
    ELSE
      er := IoErr();
      Assign(Gp,DirTable[i]^.FileName);
      IF (er = 216) THEN
        AppGp(" not empty")
      ELSE
        PreGp("Couldn't delete ")
      END;
      DisplayError(Gp,er);
    END;
  END;
END DeleteDirectory;


PROCEDURE MakeNewDir;
(*
Make new directory if proposed name [dest] not already there
or if [dest] is not null.  If no full path is given, it will
make the directory relative to the [source] gadget
*)
BEGIN
  IF AValidPath() THEN
    Inform("EXISTS!")
  ELSE
    from := CreateDir(IOString[dest]);
    IF (from = 0) THEN
      DisplayError("Couldn't make it",IoErr());
    ELSE
      Unlock(from);
      SayOK;
      GetSource;
    END;
  END;
END MakeNewDir;


PROCEDURE FillInfo(l:FileLock);
BEGIN
  IF (l <> 0) THEN
    IF Info(l,inf^) THEN
      WITH inf^ DO
        StringIt((idNumBlocks-idNumBlocksUsed)*idBytesPerBlock);
        Prepend(blank,v);
        Append(" free  ",v);
      END;
    END;
  END;
END FillInfo;


PROCEDURE GiveInfo;
(* Info on both source and dest - incl volume name *)
BEGIN
  Gp := nul;
  Reqdir := nul;
  inf := AllocMem(TSIZE(InfoData),MemReqSet{MemPublic,MemClear});
  IF (inf # NULL) THEN
    VolumeName(Gp,Curdirlock);
    FillInfo(Curdirlock);
    AppGp(v);
    PreGp("(S) ");
    IF IOStringInfo[dest].NumChars <> 0 THEN
      Reqdirlock := GetLock(IOString[dest]);
      IF (Reqdirlock<>0) THEN
        VolumeName(Reqdir,Reqdirlock);
        Prepend("(D) ",Reqdir);
        FillInfo(Reqdirlock);
        Append(v,Reqdir);
        AppGp(Reqdir);
        Unlock(Reqdirlock)
      END;
    END;
    FreeMem(inf,TSIZE(InfoData));
    Inform(Gp);
  ELSE
    DisplayError("Info Block Error!",IoErr());
  END;
END GiveInfo;


PROCEDURE WhatBytes;
(* Total bytes/files for selected filenames IGNORE FileInfoBlockSize *)
VAR i,j:CARDINAL;b,f:LONGCARD;
BEGIN
  f := 0;b := 0;
  FOR i := 1 TO DirEntries DO
    WITH DirTable[i]^ DO
      IF (IsDir = FALSE) AND (IsSelected) THEN
        INC(f);
        b := b + DirTable[i]^.FileSize
      END;
    END;
  END;
  StringIt(b);
  Concat(v," bytes in ",Gp);
  StringIt(f);
  AppGp(v);
  AppGp(" files.");
  Inform(Gp);
END WhatBytes;


PROCEDURE DoCopy;
(* handler for COPY, DELETE, MOVE, RENAME *)
VAR er:LONGINT; g:GadgetNames;i,j:CARDINAL;
BEGIN
  g := GadGot;
  er := MyFileMovement();
  IF g = rename THEN
    GetSource
  ELSE
    j := 0;
    FOR i := 1 TO DirEntries DO
      IF (DirTable[i]^.FileName[0] = 177C) THEN INC(j) END;
    END;
    IF (DirEntries > 15) AND (DirEntries - j < 15) THEN
      GetSource
    ELSIF (j > 0) THEN
      QSort;
      DEC(DirEntries,j)
    END;
    ReShow;
  END;
  EndIt(er);
END DoCopy;

PROCEDURE DoDestruct;
(* Confirm DELETE preprocessor *)
BEGIN
  MoveStr(MyGads[GadGot].GadgetText^.IText,Gp);
  Holder := GadGot;
  PreGp('Hit "');
  AppGp('" again to REALLY DO IT!');
  Inform(Gp);
  GadGot := slider;         (* make it NOT delete *)
  REPEAT UNTIL Interrupt();
  IF GadGot = Holder THEN
    IF (GadGot<>deldir) THEN DoCopy ELSE DeleteDirectory END;
  ELSE SayAbort
  END;
  ReShow;
END DoDestruct;

(*===== BRANCHING HANDLER =====*)

(*
GadgetUp messages in  MAIN routine (LOOP)  sent here for processing -
further branches for specifics
*)

PROCEDURE ProcessGadgets;
BEGIN

(* First check for device gadgets. Up to vd0, all are 'get-device' *)
  IF GadGot <= vd0 THEN
    GetDev;
    RETURN   (* don't waste time looking 4 others *)
  END;

(* now rest of gadgets in order except where multiple go to same routine *)

  CASE GadGot OF
    up1         : INC(Curfirst); ReShow;
  | down1       : DEC(Curfirst); ReShow;
  | filewindow  : SelectFile;
  | arc,
    edit,
    dofr,
    dorf,
    modula,
    link,
    show        : EndIt(MyExec()); GetSource;
  | bytes       : WhatBytes;
  | copy        : DoCopy;
  | copydel,
    deldir,
    delete      : DoDestruct;
  | info        : GiveInfo;
  | makedir     : MakeNewDir;
  | move,
    rename      : DoCopy;
  | parent,
    root        : GetParent;
  | hprint,
    htype,
    print,
    type        : DoFileLook; ReShow;
  | stod        : ReplaceRSDM(dest,IOString[source]);
  | swap        : AssignGp(IOString[dest]);
                  ReplaceRSDM(dest,IOString[source]);
                  ReplaceRSDM(source,Gp);
                  GetSource;
  | slider      : RedisplayFiles;
  | tagall,
    retag,
    untag       : SelectAll;
  | bsource     : GetSource;
  | brun,
    bdest       : INC(GadGot,3); ReplaceRSDM(GadGot,nul);
  | run,
    dest        : ReShow; (* ignore *)
  | source      : GetSource;
  ELSE
    Inform("NOPE!"); (* If here, was 'M' gadget *)
  END;
END ProcessGadgets;

(*-=-=-=-=-=-=-=-=-=-=-*)

(*
Main operating routine.  Double loop used, though single WaitPort would
work.  I had a separate CheckMessages routine which may have NULL results,
and did it this way.  Probably more polite way (systemwise) would have been
to set up a mask and Wait for a signal.  But, I'm too lazy to work it all
out.
*)
PROCEDURE GetNextMessage;
BEGIN
  (* Outer loop waits for message from intuition *)
  LOOP
    MyMsg := WaitPort(MyWindowPtr^.UserPort);
    (* Inner loop gets messages and processes them until no more *)
    LOOP
      IF  NOT CheckMessages()       THEN EXIT END;      (* To outer loop *)
      IF      (MyClass = CloseMe)   THEN RETURN         (* To finish *)
       ELSIF  (MyClass = GotOne)    THEN ProcessGadgets (* Do it *)
        ELSIF (MyClass = RefreshMe) THEN ReShow;        (* Files/memory *)
      END;
    END;  (* Inner LOOP *)
  END; (* Outer LOOP *)
END GetNextMessage;

(********)
(* MAIN *)
(********)

BEGIN
   UnlockNext := NOT EnteredFromWorkbench();
   IF UnlockNext THEN
     OutTo := FileHandle(0)
   ELSE
     OutTo := InitialInput
   END;

(* Try to open the window - run if successful [log to ram first]
   The literal below is the window title bar display             *)

  IF OpenMyWindow("Du 2.1wb [TDI Mod-2] - Greg Browne") THEN
    GadGot := ram;
    GetDev;
    GetNextMessage
  END;

(* GO HERE ON FAILURE OR FINISH (CloseWindowFlag)
   Closes window, graphics library and intuition library if open *)

  CloseMyWindow;
  ClearTable;

(* Unlock the directory lock you're holding (if any)   *)

  IF Curdirlock <> 0 THEN Unlock(Curdirlock) END;

  CleanUpAndExit;

END DuM221wb.