home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 037.lha / DU / Du21wb.mod < prev    next >
Text File  |  1987-05-16  |  23KB  |  910 lines
  1. MODULE DuM221wb;
  2.  
  3.  
  4. (*$S-*)(*$T-*)(*$A+*)
  5.  
  6.  
  7. (*
  8.  
  9. 221wb is for workbench implementation - all functions now SEEM to work
  10.  although 'cd' shows the directory outside the DirUtil to be DF0:
  11.  so all names passed have full paths now when passed so proper files will
  12.  be affected.
  13.  
  14. Modula 2 Development program & DirUtil combined
  15.  
  16. Compiled on (and used with) 2.20a
  17.  
  18. DirUtil/window aided modula development program gives easy function use
  19. from a DirUtil shell. It's NOT a tiny version + has  a few special commands
  20. to aid edit, compile and link of Modula-2 files.  I didn't include direct
  21. run of M2Error although DO R+f with M2Error in 'R' works.
  22.  
  23. Hey! This version uses lots of memory - don't try compiling with it on a
  24. 512k machine.
  25.  
  26. If someone makes it go with 3.00, substitute Editor for my favorite 'dme'
  27. editor and you will get the error handling that way.
  28.  
  29. *)
  30.  
  31. (* M2: normal library modules *)
  32.  
  33. FROM SYSTEM         IMPORT  ADR, NULL,TSIZE,BYTE,ADDRESS;
  34. FROM Conversions    IMPORT  ConvertToString;
  35. FROM DOSCodeLoader  IMPORT  Execute;
  36. FROM DOSFiles       IMPORT  CurrentDir,IoErr,InfoData,Info,CreateDir,
  37.                             FileHandle,Output,Lock,Unlock,AccessRead,
  38.                             FileLock,Open,Close,Read,Write,DeleteFile,
  39.                             Examine,Rename,FileInfoBlock,
  40.                             AccessWrite,ModeNewFile, ModeOldFile;
  41. FROM DOSLibrary     IMPORT  DOSBase;
  42. FROM Gadgets        IMPORT  RefreshGadgets;
  43. FROM Libraries      IMPORT  CloseLibrary;
  44. FROM Memory         IMPORT  AllocMem,FreeMem,MemReqSet,MemClear,
  45.                             MemPublic,MemChip,MemFast,AvailMem;
  46. FROM Ports          IMPORT  WaitPort;
  47. FROM Strings        IMPORT  Assign,Concat,Length,Insert;
  48.  
  49. (* My Specific library modules *)
  50.  
  51. FROM MyStart        IMPORT  EnteredFromWorkbench,InitialInput,CleanUpAndExit;
  52. FROM MyGlobals      IMPORT  GadgetNames,MyWindowPtr,IOString,NullReqPtr,
  53.                             MyMsg,CloseMe,RefreshMe,GotOne,MyClass,GadTxt,
  54.                             IOStringInfo,CharPtr,Curfirst,inf,v,MyGads,
  55.                             FileInfoBlockPtr,Curdir,Reqdir,Entrydirlock,
  56.                             Lastdirlock,Curdirlock,Reqdirlock,IntRead,
  57.                             Stop,GadGot,MyX,MyY,Gp,from,Boo,WBColors,
  58.                             FileText,DirEntries,DirTable,MaxScreenFiles;
  59. FROM MyType         IMPORT  DisplayASCII,DisplayHex;
  60. FROM MyWindow       IMPORT  CloseMyWindow,OpenMyWindow,SlidePot;
  61. FROM MyMisc         IMPORT  ReadDirectory,QSort,DisplayFiles,NewDir,ShowMem,
  62.                             Interrupt,CheckMessages,ReplaceRSDM,ClearTable;
  63. FROM MyVolName      IMPORT  VolumeName;
  64.  
  65.  
  66. CONST (* Misc last minute stuff *)
  67.  colon    = ":";
  68.  slash    = "/";
  69.  nul      = "";
  70.  blank    = " ";
  71.  
  72. VAR
  73.  Holder   : GadgetNames;
  74.  MoreToDo : BOOLEAN;
  75.  OutTo    : FileHandle;
  76.  UnlockNext: BOOLEAN;
  77.  
  78. (* =================================================================*)
  79.  
  80. (* MESSAGE TYPE STUFF *)
  81.  
  82. PROCEDURE Inform(VAR a:ARRAY OF CHAR);
  83. (* put something in the 'M' string *)
  84. BEGIN
  85.   ShowMem;
  86.   ReplaceRSDM(msg,a);
  87. END Inform;
  88.  
  89. (* Common messages all here to keep constants to a minimum *)
  90.  
  91. PROCEDURE SayOK;
  92. BEGIN
  93.    IF (NOT IntRead) THEN Inform("OK") END;
  94. END SayOK;
  95.  
  96. PROCEDURE SayAbort;
  97. BEGIN
  98.    Inform("INTERRUPT!");
  99. END SayAbort;
  100.  
  101. PROCEDURE EndIt(er:LONGINT);
  102. BEGIN
  103.   IF er = 0 THEN SayOK
  104.    ELSIF er = -1 THEN Inform("'D' string?")
  105.     ELSIF er = -2 THEN SayAbort
  106.      ELSE DisplayError("Couldn't finish",er);
  107.   END;
  108. END EndIt;
  109.  
  110. PROCEDURE DisplayError(VAR a:ARRAY OF CHAR; de:LONGINT);
  111. (* display error message with DOS error code *)
  112. BEGIN
  113.   AssignGp(a);
  114.   IF de > 0 THEN
  115.     AppGp(" - DOS err ");
  116.     StringIt(LONGCARD(de));
  117.     AppGp(v);
  118.   END;
  119.   Inform(Gp);
  120. END DisplayError;
  121.  
  122.  
  123. (* STRING STUFF
  124.  
  125. Mostly to save a parameter pass or two on frequent stuff. This program
  126. needs to run in 512k with a memory hogging compiler and still have some
  127. useful features in it, so save bytes!
  128. *)
  129.  
  130. PROCEDURE Append(VAR this,tothis:ARRAY OF CHAR);
  131. BEGIN
  132.   Concat(tothis,this,tothis);
  133. END Append;
  134.  
  135. PROCEDURE AppGp(VAR a:ARRAY OF CHAR);
  136. BEGIN
  137.   Append(a,Gp);
  138. END AppGp;
  139.  
  140. PROCEDURE Prepend(VAR this,beforethis:ARRAY OF CHAR);
  141. BEGIN
  142.   Insert(this,beforethis,0);
  143. END Prepend;
  144.  
  145. PROCEDURE PreGp(VAR a:ARRAY OF CHAR);
  146. BEGIN
  147.   Prepend(a,Gp);
  148. END PreGp;
  149.  
  150. PROCEDURE AssignGp(VAR a:ARRAY OF CHAR);
  151. BEGIN
  152.   Assign(Gp,a);
  153. END AssignGp;
  154.  
  155. PROCEDURE AssignReqdir(VAR a:ARRAY OF CHAR);
  156. BEGIN
  157.   Assign(Reqdir,a);
  158. END AssignReqdir;
  159.  
  160. PROCEDURE FillGpto(VAR a,b:ARRAY OF CHAR);
  161. BEGIN
  162.   PreGp(" to ");
  163.   PreGp(b);
  164.   PreGp(a);
  165.   Inform(Gp);
  166. END FillGpto;
  167.  
  168. PROCEDURE AddNameToPath(VAR name,path:ARRAY OF CHAR);
  169. VAR p : CARDINAL;
  170. BEGIN
  171.   AssignGp(path);
  172.   p := Length(Gp);
  173.   IF (p>0) AND (Gp[p-1] <> colon) THEN AppGp(slash) END;
  174.   AppGp(name);
  175. END AddNameToPath;
  176.  
  177. PROCEDURE MoveStr(p:ADDRESS;VAR des:ARRAY OF CHAR);
  178. (* Good ONLY if you know 'p' has a NULL end and fits in 'des' *)
  179. VAR i:CARDINAL;Cp:CharPtr;
  180. BEGIN
  181.   Cp := CharPtr(p);
  182.   i := 0;
  183.   REPEAT
  184.     des[i] := Cp^;
  185.     INC(i);
  186.     INC(Cp);
  187.   UNTIL (des[i-1]) = 0C;
  188. END MoveStr;
  189.  
  190. PROCEDURE StringIt(n:LONGCARD);
  191. BEGIN
  192.   ConvertToString(n,10,FALSE,v,Boo);
  193. END StringIt;
  194.  
  195.  
  196. (* SPACE SAVERS *)
  197.  
  198. PROCEDURE GetLock(VAR a:ARRAY OF CHAR):FileLock;
  199. (* Save one parameter/call in others [all AccessRead] *)
  200. BEGIN
  201.   RETURN Lock(a,AccessRead);
  202. END GetLock;
  203.  
  204. PROCEDURE LocksOK(VAR a:ARRAY OF CHAR):BOOLEAN;
  205. (* Checks for presence *)
  206. BEGIN
  207.   from := GetLock(a);
  208.   IF from <> 0 THEN
  209.     Unlock(from);
  210.     RETURN TRUE;
  211.   END;
  212.   RETURN FALSE
  213. END LocksOK;
  214.  
  215.  
  216. (* MORE INVOLVED PROCEDURES *)
  217.  
  218.  
  219.  
  220. PROCEDURE DoFileLook;
  221. VAR  i:CARDINAL;
  222. BEGIN
  223.   Holder := GadGot;
  224.   FOR i := 1 TO DirEntries DO
  225.     IF Interrupt() THEN SayAbort; RETURN END;
  226.     WITH DirTable[i]^ DO
  227.       AddNameToPath(FileName,IOString[source]);
  228.       IF (IsSelected) AND (NOT IsDir) THEN
  229.         Boo := FALSE;
  230.         IF (Holder = htype) OR (Holder = type) THEN Boo := TRUE END;
  231.         IF LocksOK(Gp) THEN
  232.           IF NOT Boo THEN
  233.             AssignReqdir("Printing ");
  234.             Append(Gp,Reqdir);
  235.             Inform(Reqdir);
  236.           END;
  237.           IF (Holder = type) OR (Holder = print) THEN
  238.             DisplayASCII(Gp,Boo)
  239.           ELSE
  240.             DisplayHex(Gp,Boo)
  241.           END;
  242.           WasSelected := TRUE;
  243.           IsSelected := FALSE;
  244.         END
  245.       END
  246.     END
  247.   END;
  248.   SayOK;
  249. END DoFileLook;
  250.  
  251.  
  252. PROCEDURE MyCopy(VAR from,into:ARRAY OF CHAR):LONGINT;
  253. VAR  fhand,tohand:FileHandle;siz:LONGCARD;er,ex:LONGINT;
  254.     ad:ADDRESS;
  255.  
  256.     PROCEDURE EndCopy;
  257.     BEGIN
  258.       Close(fhand);
  259.       Close(tohand);
  260.     END EndCopy;
  261.  
  262. BEGIN
  263.   ex := LONGINT(0);
  264.   siz := 8000H;    (* Only 32k byte buffer for now *)
  265.   fhand := Open(from,ModeOldFile);
  266.   IF fhand = 0 THEN RETURN IoErr() END;
  267.   tohand := Open(into,ModeNewFile);
  268.   IF tohand = 0 THEN
  269.     er := IoErr();
  270.     Close(fhand);
  271.     RETURN er;
  272.   END;
  273.   REPEAT
  274.     ad := AllocMem(siz,MemReqSet{MemPublic,MemClear});
  275.     IF ad = NULL THEN DEC(siz,512) END;
  276.   UNTIL (ad # NULL) OR (siz < 512);
  277.   IF ad = NULL THEN
  278.     EndCopy;
  279.     RETURN LONGINT(-3)
  280.   END;
  281.   FillGpto("Copying  ",from);
  282.   REPEAT
  283.     er := Read(fhand,ad,siz);
  284.     IF er > 0 THEN er := Write(tohand,ad,LONGCARD(er)) ELSE ex := IoErr() END;
  285.   UNTIL (er <> LONGINT(siz));
  286.   EndCopy;
  287.   FreeMem(ad,siz);
  288.   RETURN ex;
  289. END MyCopy;
  290.  
  291.  
  292. PROCEDURE AValidPath():BOOLEAN;
  293. (* checks to see that IOString[dest] is a valid path without name *)
  294. VAR  m:FileInfoBlockPtr;
  295. BEGIN
  296.  Boo := FALSE; (* Assume not ok *)
  297.  IF IOStringInfo[dest].NumChars = 0 THEN RETURN Boo END;
  298.  from := GetLock(IOString[dest]);
  299.  IF from = 0 THEN RETURN Boo END;
  300.  m := AllocMem(TSIZE(FileInfoBlock),MemReqSet{MemPublic,MemClear});
  301.  IF (m # NULL) AND Examine(from,m^) AND (m^.fibDirEntryType > 0) THEN
  302.    Boo := TRUE
  303.  END;
  304.  Unlock(from);
  305.  FreeMem(m,TSIZE(FileInfoBlock));
  306.  RETURN Boo;
  307. END AValidPath;
  308.  
  309.  
  310. PROCEDURE MyFileMovement():LONGINT;
  311. (* Returns IoErr *)
  312. VAR i:CARDINAL ;g:GadgetNames;er:LONGINT;
  313. BEGIN
  314.   g := GadGot;
  315.   IF ((g=copy) OR (g=copydel)) AND (NOT AValidPath()) THEN
  316.     RETURN LONGINT(-1)
  317.   END;
  318.   FOR i := 1 TO DirEntries DO
  319.     IF Interrupt() THEN RETURN LONGINT(-2) END;
  320.     WITH DirTable[i]^ DO
  321.       AddNameToPath(FileName,IOString[source]);
  322.       AssignReqdir(Gp);
  323.       AssignGp(IOString[dest]);
  324.        (* Reqdir = fully extended source name
  325.           Gp     = dest contents (may further extend if only path)
  326.        *)
  327.       IF (g=rename) AND (IsSelected) THEN
  328.         IF LocksOK(FileName) THEN
  329.           IF Rename(Reqdir,Gp) THEN
  330.             FillGpto("Renamed ",FileName);
  331.             FileName[0] := 177C;
  332.             RETURN LONGINT(0);
  333.           ELSE
  334.             RETURN IoErr();
  335.           END;
  336.         ELSE
  337.           RETURN IoErr();
  338.         END;
  339.       END;
  340.       IF (IsSelected) AND (NOT IsDir) THEN
  341.         IF LocksOK(FileName) THEN
  342.           IF (g=move) THEN
  343.             AddNameToPath(FileName,IOString[dest]);(*Substitute Gp*)
  344.             IF Rename(Reqdir,Gp) THEN
  345.               FillGpto("Moved ",FileName);
  346.               FileName[0] := 177C
  347.             ELSE
  348.               RETURN IoErr();
  349.             END;
  350.           END;
  351.           IF (g=copy) OR (g=copydel) THEN
  352.             AddNameToPath(FileName,IOString[dest]);(* Extend dest name*)
  353.             er := (MyCopy(Reqdir,Gp));
  354.             IF (er <> 0)  THEN RETURN er END;
  355.           END;
  356.           IF (g=delete) OR (g=copydel) THEN
  357.             AssignGp("Deleting ");
  358.             AppGp(Reqdir);
  359.             Inform(Gp);
  360.             IF DeleteFile(Reqdir) THEN
  361.               FileName[0] := 177C;
  362.             ELSE
  363.               RETURN IoErr();
  364.             END;
  365.           END;
  366.         END;
  367.         IsSelected := FALSE;
  368.         WasSelected := TRUE;
  369.       END; (* If selectedfile *)
  370.     END  (* WITH *)
  371.   END; (* FOR *)
  372.   RETURN LONGINT(0);
  373. END MyFileMovement;
  374.  
  375.  
  376. (*
  377. Here are names used to edit, compile, link or DO things.
  378. Room after 'dme' is for direct file patching
  379. *)
  380.  
  381. PROCEDURE CheckMore(m:CARDINAL);
  382. (*
  383. Checks if more files / sets whether to RUN or DO next pass
  384. *)
  385.  VAR i:CARDINAL; BEGIN
  386.   MoreToDo := FALSE;
  387.   IF m <= DirEntries THEN
  388.     FOR i := m TO DirEntries DO
  389.       IF DirTable[i]^.IsSelected THEN MoreToDo := TRUE END;
  390.     END;
  391.   END;
  392. END CheckMore;
  393.  
  394.  
  395. PROCEDURE TryIt(g:GadgetNames;VAR Name:ARRAY OF CHAR);
  396. BEGIN
  397.   AssignGp(Name);
  398.   IF Name[0] <> 0C THEN AddNameToPath(Name,IOString[source]) END;
  399.   CASE g OF
  400.      arc    : AssignReqdir("arc");
  401.   |  dofr   : AssignReqdir(Gp);
  402.   |  dorf   : AssignReqdir(IOString[run]);
  403.   |  edit   : AssignReqdir("dme       ");  (* allow a 10 char name patch *)
  404.   |  link   : AssignReqdir("link");
  405.   |  modula : AssignReqdir("modula");
  406.   |  show   : AssignReqdir("show      ");  (* allow a 10 char name patch *)
  407.   ELSE
  408.   END;
  409.     (* force separation of tail *)
  410.   Append(blank,Reqdir);
  411.     (* add in 'R' if 'dofr' or 'arc' *)
  412.   IF (g = dofr) OR (g=arc) THEN Append(IOString[run],Reqdir)
  413.    ELSE Append(Gp,Reqdir)
  414.   END;
  415.     (* if 'arc' then add 'D' and then Name *)
  416.   IF (g = arc) THEN
  417.     Append(blank,Reqdir);
  418.     Append(IOString[dest],Reqdir);
  419.     Append(blank,Reqdir);
  420.     Append(Gp,Reqdir);
  421.   END;
  422.     (* if 'link' then add "o" optimize switch *)
  423.   IF (g = link) THEN Append(" o",Reqdir) END;
  424.   IF NOT MoreToDo THEN Prepend("RUN >NIL: ",Reqdir) END;
  425.   Inform(Reqdir);
  426.   IF Execute(Reqdir,FileHandle(0),OutTo) THEN END;
  427. END TryIt;
  428.  
  429.  
  430. PROCEDURE MyExec():LONGINT;
  431. VAR  i:CARDINAL ;g:GadgetNames;
  432. BEGIN
  433.   g := GadGot;
  434.   Boo := (g > edit);
  435.   FOR i := 1 TO DirEntries DO
  436.     IF Interrupt() THEN RETURN LONGINT(-2) END;
  437.     WITH DirTable[i]^ DO
  438.       IF (IsSelected) THEN
  439.         IF (NOT IsDir) OR (g = dorf) THEN
  440.           CheckMore(i+1);
  441.           Boo := TRUE;
  442.           TryIt(g,FileName);
  443.         END;
  444.       IsSelected := FALSE;
  445.       WasSelected := TRUE;
  446.       END;
  447.     END;
  448.   END;
  449.   IF NOT Boo THEN TryIt(g,nul) END;
  450.   RETURN LONGINT(0);
  451. END MyExec;
  452.  
  453.  
  454. PROCEDURE GetReqDir():BOOLEAN;
  455. (* Get directory in Reqdir - or say couldn't *)
  456. BEGIN
  457.   Reqdirlock := GetLock(Reqdir);
  458.   IF (Reqdirlock = 0) THEN RETURN FALSE END;
  459.   IntRead := FALSE;
  460.   IF NOT ReadDirectory(Reqdirlock) THEN
  461.     Unlock(Reqdirlock);
  462.     RETURN FALSE
  463.   ELSE
  464.     IF DirEntries > 1 THEN QSort END;
  465.     NewDir;
  466.     Lastdirlock := CurrentDir(Reqdirlock);
  467.     IF UnlockNext THEN
  468.       IF Lastdirlock <> 0 THEN Unlock(Lastdirlock) END;
  469.     ELSE
  470.       UnlockNext := TRUE
  471.     END;
  472.     Curdirlock := Reqdirlock;
  473.     Assign(Curdir,Reqdir);
  474.     Curfirst := 1;
  475.     RETURN TRUE
  476.   END;
  477. END GetReqDir;
  478.  
  479.  
  480. PROCEDURE RedisplayFiles;
  481. (* only if more than a screenfull *)
  482. VAR Vpot : CARDINAL;temp:LONGCARD;
  483. BEGIN
  484.   IF (DirEntries > MaxScreenFiles) THEN
  485.     Vpot := SlidePot();
  486.     temp := LONGCARD(DirEntries - MaxScreenFiles);
  487.     temp := temp * LONGCARD(Vpot);
  488.     Curfirst := CARDINAL(temp DIV 0FFFFH)+1;
  489.     IF Vpot = 0FFFFH THEN Curfirst := 999 END;
  490.     ReShow;
  491.   END;
  492. END RedisplayFiles;
  493.  
  494.  
  495. PROCEDURE ReShow;
  496. BEGIN
  497.   IF DirEntries < MaxScreenFiles THEN Curfirst := 1
  498.    ELSIF Curfirst > DirEntries - MaxScreenFiles + 1 THEN
  499.      Curfirst := DirEntries - MaxScreenFiles + 1
  500.   END;
  501.   IF Curfirst < 1 THEN Curfirst := 1 END;
  502.   DisplayFiles(Curfirst);
  503. END ReShow;
  504.  
  505.  
  506. PROCEDURE GetDev;
  507. (* Get the device hit *)
  508. VAR i:CARDINAL;
  509. BEGIN
  510.   MoveStr(MyGads[GadGot].GadgetText^.IText,Reqdir);
  511.   IF GetReqDir() THEN SayOK; ReplaceRSDM(source,Reqdir) END;
  512. END GetDev;
  513.  
  514.  
  515. PROCEDURE GetSource;
  516. (* Get IOString[source] directory [if possible] w/bailout alternates *)
  517. VAR i : CARDINAL;
  518. BEGIN
  519.   AssignReqdir(IOString[source]);
  520.   IF (IOStringInfo[source].NumChars = 0) THEN AssignReqdir(colon) END;
  521.   (* If can't get then switch back to currently selected directory *)
  522.   IF NOT GetReqDir() THEN
  523.     DisplayError("Error - switching back!",IoErr());
  524.     AssignReqdir(Curdir);
  525.     IF NOT GetReqDir() THEN
  526.       DisplayError("Error - going to ram:",IoErr());
  527.       GadGot := ram;
  528.       GetDev;
  529.     END;
  530.   END;
  531.   ReplaceRSDM(source,Curdir);
  532.   SayOK;
  533. END GetSource;
  534.  
  535.  
  536. PROCEDURE GetParent;
  537. (* Get parent [or root]dir & name *)
  538. VAR i, l:CARDINAL;
  539. BEGIN
  540.   AssignReqdir(IOString[source]);
  541.   l := Length(Reqdir);
  542.   Stop := FALSE;
  543.   REPEAT
  544.     DEC(l);
  545.     IF (Reqdir[l] = slash) AND (GadGot = parent) THEN
  546.       Reqdir[l] := 0C; Stop := TRUE;
  547.     ELSIF (Reqdir[l] = colon) THEN
  548.       Reqdir[l+1] := 0C; Stop := TRUE;
  549.     END;
  550.   UNTIL (l=0) OR (Stop);
  551.   IF (Reqdir[0] = 0C) THEN AssignReqdir(colon) END;
  552.   ReplaceRSDM(source,Reqdir);
  553.   GetSource;
  554. END GetParent;
  555.  
  556.  
  557. PROCEDURE SelectDir(n:CARDINAL);
  558. (* Select a directory and possibly enter it *)
  559. VAR i,j:CARDINAL;
  560. BEGIN
  561.   FOR i := 1 TO DirEntries DO
  562.     WITH DirTable[i]^ DO
  563.       IF IsDir THEN
  564.         IF i=n THEN
  565.           IsSelected := NOT IsSelected;
  566.         ELSE
  567.           IsSelected := FALSE
  568.         END;
  569.       END;
  570.     END;
  571.   END;
  572.   ReShow;
  573.   IF (DirTable[n]^.IsSelected) THEN
  574.     AssignGp(DirTable[n]^.FileName);
  575.     PreGp('Click "');
  576.     AppGp('" again to GETDIR');
  577.     Inform(Gp);
  578.     REPEAT UNTIL CheckMessages();
  579.     j := CARDINAL((MyY - 24) DIV 8) + Curfirst;
  580.     IF (GadGot = filewindow) AND (j = n) THEN
  581.       SayOK;
  582.       AddNameToPath(DirTable[n]^.FileName,IOString[source]);
  583.       ReplaceRSDM(source,Gp);
  584.       GetSource;
  585.     ELSE
  586.       SayAbort
  587.     END;
  588.   END;
  589. END SelectDir;
  590.  
  591.  
  592. PROCEDURE SelectFile;
  593. (* toggle selection of file - goto SelectDir if hit over directory *)
  594. VAR pos : CARDINAL; BEGIN
  595.   pos := CARDINAL((MyY - 24) DIV 8) + Curfirst;
  596.   IF pos <= DirEntries THEN
  597.     WITH DirTable[pos]^ DO
  598.       IF IsDir THEN
  599.         SelectDir(pos)
  600.       ELSE
  601.         IsSelected := NOT IsSelected;
  602.         ReShow;
  603.       END
  604.     END;
  605.   END;
  606.   SayOK;
  607. END SelectFile;
  608.  
  609.  
  610. PROCEDURE SelectAll;
  611. (* Mass select/unselect/reselect all non-directory filenames *)
  612. VAR i:CARDINAL;
  613. BEGIN
  614.   FOR i := 1 TO DirEntries DO
  615.     IF NOT DirTable[i]^.IsDir THEN
  616.       IF (GadGot = retag) THEN
  617.          DirTable[i]^.IsSelected := DirTable[i]^.WasSelected;
  618.       ELSE
  619.         DirTable[i]^.IsSelected := (GadGot = tagall);
  620.       END;
  621.       DirTable[i]^.WasSelected := FALSE;
  622.     END;
  623.   END;
  624.   ReShow;
  625.   SayOK;
  626. END SelectAll;
  627.  
  628. PROCEDURE DeleteDirectory;
  629. (*
  630. Delete a directory if not in use or filled
  631. proposed option is delete even if filled - a mass directory kill
  632. *)
  633. VAR i,n:CARDINAL;er:LONGINT;l :FileLock;
  634. BEGIN
  635.   n := 0;i := 0;
  636.   WHILE (n = 0) AND (i < DirEntries) DO
  637.     INC(i);
  638.     IF (DirTable[i]^.IsSelected) AND (DirTable[i]^.IsDir) THEN n := i END;
  639.   END;
  640.   IF (n > 0) THEN
  641.     IF DeleteFile(DirTable[n]^.FileName) THEN
  642.       GetSource;
  643.       SayOK;
  644.     ELSE
  645.       er := IoErr();
  646.       Assign(Gp,DirTable[i]^.FileName);
  647.       IF (er = 216) THEN
  648.         AppGp(" not empty")
  649.       ELSE
  650.         PreGp("Couldn't delete ")
  651.       END;
  652.       DisplayError(Gp,er);
  653.     END;
  654.   END;
  655. END DeleteDirectory;
  656.  
  657.  
  658. PROCEDURE MakeNewDir;
  659. (*
  660. Make new directory if proposed name [dest] not already there
  661. or if [dest] is not null.  If no full path is given, it will
  662. make the directory relative to the [source] gadget
  663. *)
  664. BEGIN
  665.   IF AValidPath() THEN
  666.     Inform("EXISTS!")
  667.   ELSE
  668.     from := CreateDir(IOString[dest]);
  669.     IF (from = 0) THEN
  670.       DisplayError("Couldn't make it",IoErr());
  671.     ELSE
  672.       Unlock(from);
  673.       SayOK;
  674.       GetSource;
  675.     END;
  676.   END;
  677. END MakeNewDir;
  678.  
  679.  
  680. PROCEDURE FillInfo(l:FileLock);
  681. BEGIN
  682.   IF (l <> 0) THEN
  683.     IF Info(l,inf^) THEN
  684.       WITH inf^ DO
  685.         StringIt((idNumBlocks-idNumBlocksUsed)*idBytesPerBlock);
  686.         Prepend(blank,v);
  687.         Append(" free  ",v);
  688.       END;
  689.     END;
  690.   END;
  691. END FillInfo;
  692.  
  693.  
  694. PROCEDURE GiveInfo;
  695. (* Info on both source and dest - incl volume name *)
  696. BEGIN
  697.   Gp := nul;
  698.   Reqdir := nul;
  699.   inf := AllocMem(TSIZE(InfoData),MemReqSet{MemPublic,MemClear});
  700.   IF (inf # NULL) THEN
  701.     VolumeName(Gp,Curdirlock);
  702.     FillInfo(Curdirlock);
  703.     AppGp(v);
  704.     PreGp("(S) ");
  705.     IF IOStringInfo[dest].NumChars <> 0 THEN
  706.       Reqdirlock := GetLock(IOString[dest]);
  707.       IF (Reqdirlock<>0) THEN
  708.         VolumeName(Reqdir,Reqdirlock);
  709.         Prepend("(D) ",Reqdir);
  710.         FillInfo(Reqdirlock);
  711.         Append(v,Reqdir);
  712.         AppGp(Reqdir);
  713.         Unlock(Reqdirlock)
  714.       END;
  715.     END;
  716.     FreeMem(inf,TSIZE(InfoData));
  717.     Inform(Gp);
  718.   ELSE
  719.     DisplayError("Info Block Error!",IoErr());
  720.   END;
  721. END GiveInfo;
  722.  
  723.  
  724. PROCEDURE WhatBytes;
  725. (* Total bytes/files for selected filenames IGNORE FileInfoBlockSize *)
  726. VAR i,j:CARDINAL;b,f:LONGCARD;
  727. BEGIN
  728.   f := 0;b := 0;
  729.   FOR i := 1 TO DirEntries DO
  730.     WITH DirTable[i]^ DO
  731.       IF (IsDir = FALSE) AND (IsSelected) THEN
  732.         INC(f);
  733.         b := b + DirTable[i]^.FileSize
  734.       END;
  735.     END;
  736.   END;
  737.   StringIt(b);
  738.   Concat(v," bytes in ",Gp);
  739.   StringIt(f);
  740.   AppGp(v);
  741.   AppGp(" files.");
  742.   Inform(Gp);
  743. END WhatBytes;
  744.  
  745.  
  746. PROCEDURE DoCopy;
  747. (* handler for COPY, DELETE, MOVE, RENAME *)
  748. VAR er:LONGINT; g:GadgetNames;i,j:CARDINAL;
  749. BEGIN
  750.   g := GadGot;
  751.   er := MyFileMovement();
  752.   IF g = rename THEN
  753.     GetSource
  754.   ELSE
  755.     j := 0;
  756.     FOR i := 1 TO DirEntries DO
  757.       IF (DirTable[i]^.FileName[0] = 177C) THEN INC(j) END;
  758.     END;
  759.     IF (DirEntries > 15) AND (DirEntries - j < 15) THEN
  760.       GetSource
  761.     ELSIF (j > 0) THEN
  762.       QSort;
  763.       DEC(DirEntries,j)
  764.     END;
  765.     ReShow;
  766.   END;
  767.   EndIt(er);
  768. END DoCopy;
  769.  
  770. PROCEDURE DoDestruct;
  771. (* Confirm DELETE preprocessor *)
  772. BEGIN
  773.   MoveStr(MyGads[GadGot].GadgetText^.IText,Gp);
  774.   Holder := GadGot;
  775.   PreGp('Hit "');
  776.   AppGp('" again to REALLY DO IT!');
  777.   Inform(Gp);
  778.   GadGot := slider;         (* make it NOT delete *)
  779.   REPEAT UNTIL Interrupt();
  780.   IF GadGot = Holder THEN
  781.     IF (GadGot<>deldir) THEN DoCopy ELSE DeleteDirectory END;
  782.   ELSE SayAbort
  783.   END;
  784.   ReShow;
  785. END DoDestruct;
  786.  
  787. (*===== BRANCHING HANDLER =====*)
  788.  
  789. (*
  790. GadgetUp messages in  MAIN routine (LOOP)  sent here for processing -
  791. further branches for specifics
  792. *)
  793.  
  794. PROCEDURE ProcessGadgets;
  795. BEGIN
  796.  
  797. (* First check for device gadgets. Up to vd0, all are 'get-device' *)
  798.   IF GadGot <= vd0 THEN
  799.     GetDev;
  800.     RETURN   (* don't waste time looking 4 others *)
  801.   END;
  802.  
  803. (* now rest of gadgets in order except where multiple go to same routine *)
  804.  
  805.   CASE GadGot OF
  806.     up1         : INC(Curfirst); ReShow;
  807.   | down1       : DEC(Curfirst); ReShow;
  808.   | filewindow  : SelectFile;
  809.   | arc,
  810.     edit,
  811.     dofr,
  812.     dorf,
  813.     modula,
  814.     link,
  815.     show        : EndIt(MyExec()); GetSource;
  816.   | bytes       : WhatBytes;
  817.   | copy        : DoCopy;
  818.   | copydel,
  819.     deldir,
  820.     delete      : DoDestruct;
  821.   | info        : GiveInfo;
  822.   | makedir     : MakeNewDir;
  823.   | move,
  824.     rename      : DoCopy;
  825.   | parent,
  826.     root        : GetParent;
  827.   | hprint,
  828.     htype,
  829.     print,
  830.     type        : DoFileLook; ReShow;
  831.   | stod        : ReplaceRSDM(dest,IOString[source]);
  832.   | swap        : AssignGp(IOString[dest]);
  833.                   ReplaceRSDM(dest,IOString[source]);
  834.                   ReplaceRSDM(source,Gp);
  835.                   GetSource;
  836.   | slider      : RedisplayFiles;
  837.   | tagall,
  838.     retag,
  839.     untag       : SelectAll;
  840.   | bsource     : GetSource;
  841.   | brun,
  842.     bdest       : INC(GadGot,3); ReplaceRSDM(GadGot,nul);
  843.   | run,
  844.     dest        : ReShow; (* ignore *)
  845.   | source      : GetSource;
  846.   ELSE
  847.     Inform("NOPE!"); (* If here, was 'M' gadget *)
  848.   END;
  849. END ProcessGadgets;
  850.  
  851. (*-=-=-=-=-=-=-=-=-=-=-*)
  852.  
  853. (*
  854. Main operating routine.  Double loop used, though single WaitPort would
  855. work.  I had a separate CheckMessages routine which may have NULL results,
  856. and did it this way.  Probably more polite way (systemwise) would have been
  857. to set up a mask and Wait for a signal.  But, I'm too lazy to work it all
  858. out.
  859. *)
  860. PROCEDURE GetNextMessage;
  861. BEGIN
  862.   (* Outer loop waits for message from intuition *)
  863.   LOOP
  864.     MyMsg := WaitPort(MyWindowPtr^.UserPort);
  865.     (* Inner loop gets messages and processes them until no more *)
  866.     LOOP
  867.       IF  NOT CheckMessages()       THEN EXIT END;      (* To outer loop *)
  868.       IF      (MyClass = CloseMe)   THEN RETURN         (* To finish *)
  869.        ELSIF  (MyClass = GotOne)    THEN ProcessGadgets (* Do it *)
  870.         ELSIF (MyClass = RefreshMe) THEN ReShow;        (* Files/memory *)
  871.       END;
  872.     END;  (* Inner LOOP *)
  873.   END; (* Outer LOOP *)
  874. END GetNextMessage;
  875.  
  876. (********)
  877. (* MAIN *)
  878. (********)
  879.  
  880. BEGIN
  881.    UnlockNext := NOT EnteredFromWorkbench();
  882.    IF UnlockNext THEN
  883.      OutTo := FileHandle(0)
  884.    ELSE
  885.      OutTo := InitialInput
  886.    END;
  887.  
  888. (* Try to open the window - run if successful [log to ram first]
  889.    The literal below is the window title bar display             *)
  890.  
  891.   IF OpenMyWindow("Du 2.1wb [TDI Mod-2] - Greg Browne") THEN
  892.     GadGot := ram;
  893.     GetDev;
  894.     GetNextMessage
  895.   END;
  896.  
  897. (* GO HERE ON FAILURE OR FINISH (CloseWindowFlag)
  898.    Closes window, graphics library and intuition library if open *)
  899.  
  900.   CloseMyWindow;
  901.   ClearTable;
  902.  
  903. (* Unlock the directory lock you're holding (if any)   *)
  904.  
  905.   IF Curdirlock <> 0 THEN Unlock(Curdirlock) END;
  906.  
  907.   CleanUpAndExit;
  908.  
  909. END DuM221wb.
  910.