home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DIV / MM2SHELL.M < prev    next >
Encoding:
Text File  |  1994-06-03  |  188.8 KB  |  3 lines
  1. ⓪ MODULE MM2Shell; (*$Z+,P+,V+,R-*)
  2. ⓪ 
  3. ⓪ (*
  4. ⓪!*----------------------------------------------------------------------------
  5. ⓪!* Copyright Februar 1987 Thomas Tempelmann & Manuel Chakravarty
  6. ⓪!*----------------------------------------------------------------------------
  7. ⓪!* Modul-Beschreibung : GEM-Shell für MOS / Megamax Modula-2
  8. ⓪!*----------------------------------------------------------------------------
  9. ⓪!* Version            : 2.3g        /     Interne Version: V#1806
  10. ⓪!*----------------------------------------------------------------------------
  11. ⓪!* MCH: Manuel Chakravarty
  12. ⓪!* TT:  Thomas Tempelmann
  13. ⓪!* MS:  Michael Seyfried, Unterer Mauergarten 17, D-W6520 Worms 24
  14. ⓪!* DS:  Dirk Steins
  15. ⓪!*----------------------------------------------------------------------------
  16. ⓪!* Datum   Version  Autor  Bemerkung (Arbeitsbericht)
  17. ⓪!*----------------------------------------------------------------------------
  18. ⓪!* 22.02.87  0.0    TT/OJO Erstellung unter C aus MyShell v. Oliver Joppich
  19. ⓪!* 24.02.87  0.0    TT     Erste lauffähige Version
  20. ⓪!* 18.07.87  0.1    TT     Individuelle Pathlisten für Compiler/Linker
  21. ⓪!* 16.09.87  0.1    TT/MCH GEM-Moduln v. MCH; FileSelector nur bei GEM-Prgs.
  22. ⓪!* 18.09.87  0.1    TT     FileSelect rettet/restauriert Screen bei TOS-Prgs.
  23. ⓪!* 15.10.87  0.2    MCH    ShellShell
  24. ⓪!* 07.11.87  0.2    MCH    Anpassung an GEM V 0.10
  25. ⓪!* 23.12.87  0.3    MCH    'load' und 'unload' impl.
  26. ⓪!* 24.12.87  0.3    MCH    Nachfolgendes von TT übernommen:
  27. ⓪!* 05.10.87         TT     Scan mit Modul 'GEMScan'
  28. ⓪!* 07.10.87         TT     Überflüssige Importe raus, Terminal.Write->Bconout
  29. ⓪!* 16.10.87         TT     SplitPath/Name: set_names, call,
  30. ⓪!* 13.11.87         TT     SetLinkName, GEMError nicht mehr importiert
  31. ⓪!* 14.01.88  0.4    MCH    TT's UserBrk eingebunden.
  32. ⓪!* 06.02.88  1.0a   TT     Fertigstellung der ersten auslieferbaren Version:
  33. ⓪!*                           diverse Kommentierung; Akt.File bleibt bei Tool-
  34. ⓪!*                           Aufruf erhalten; Taste 'R' für Residente Module;
  35. ⓪!*                           Klick auf Mem-Fenster toggled 'allMem';
  36. ⓪!*                           viele kleine Optimierungen...
  37. ⓪!* 19.02.88  1.0b   TT     Bei Prg-Start kann mit ALT-Taste der aktuelle Pfad
  38. ⓪!*                           erhalten bleiben.
  39. ⓪!* 01.03.88  1.0c   TT     'ShellMsg.TextName' enthält "aktuelle Datei".
  40. ⓪!* 14.04.88  1.0d   TT     SHELL.INF: mehrere inaktive LINK-Namen bestimmbar;
  41. ⓪!*                           writeList nicht mehr rekursiv; readEntry: Compare
  42. ⓪!*                           mit '..' optimiert.
  43. ⓪!* 15.05.88  1.0e   TT     Prozedur 'fastCompare' neu. Desktop wird wiederher-
  44. ⓪!*                           gestellt nach CALL-Anweisung in SHELL.INF
  45. ⓪!* 28.05.88  1.0f   TT     Mit 'ESC' kann Laden von Modulen beim Starten unter-
  46. ⓪!*                           drückt werden; MouseInput(TRUE) und ShowMouse
  47. ⓪!*                           (TRUE) bei Rückkehr aus Programm in Shell; Bei
  48. ⓪!*                           Code-Filter werden DEF-Module nicht ausgegeben.
  49. ⓪!* 01.06.88  1.1    TT     Linker-Optionen erweitert für optimierenden Linker;
  50. ⓪!*                           LinkStackSize kann nun > 64KB sein.
  51. ⓪!* 09.06.88         TT     "Upper (LinkList[i].name)" aus "doLinkOptBox" ent-
  52. ⓪!*                           fernt.
  53. ⓪!* 25.06.88  1.1b   TT     "FastStrings" verwendet, einige Copy-Aufrufe durch
  54. ⓪!*                           Delete ersetzt.
  55. ⓪!* 19.07.88  1.2    MCH    Auslagerung von 'EasyGEM0'
  56. ⓪!* 20.07.88  1.2    MCH    Alle Module die nur in 'ShellShell' gebraucht
  57. ⓪!*                         werden, werden qualifiziert importiert.
  58. ⓪!*                         Auslagerung von 'forceDeskRedraw' und
  59. ⓪!*                         'redrawDeskObj0' in 'EasyGEM0'
  60. ⓪!* 27.07.88  1.3    MCH    Benutzung von 'WindowLists'
  61. ⓪!* 28.07.88  1.3    MCH         "     "         "
  62. ⓪!* 03.08.88  1.3b   MCH    'dragSensitive' + Anfang der Selektierung
  63. ⓪!* 04.08.88  1.3c   MCH    Selektierung mit Draggen funktioniert
  64. ⓪!* 07.08.88  1.4    MCH    Benutzung der Funktionen für komplexere Dialog-
  65. ⓪!*                         boxen aus 'EasyGem0'
  66. ⓪!* 17.08.88  1.5    MCH    Neue Resource
  67. ⓪!* 22.08.88  1.5    MCH    Neue Resource + "Formatieren" begonnen
  68. ⓪!* 24.08.88  1.5    MCH    "Formatieren" fertig + 'makeFolder' +  kopieren
  69. ⓪!*                         + löschen
  70. ⓪!* 25.08.88  1.5    MCH    Schönheitsoperationen beim Kopieren und Löschen
  71. ⓪!* 27.08.88  1.5    MCH    Fileinformation
  72. ⓪!* 28.08.88  1.5    MCH    Editor-Parameter-Box
  73. ⓪!* 29.08.88  1.6    MCH    Parameter sichern und laden
  74. ⓪!* 30.08.88  1.7    MCH    Shelling
  75. ⓪!* 31.08.88  2.0    MCH    Vorversion für die Atari-Messe ('88)
  76. ⓪!* 01.12.88  2.0    MCH    Neues 'WindowLists' V0.07
  77. ⓪!* 05.12.88  2.0    MCH    Rausschmiß der 'selected'-Liste (WL V0.08)
  78. ⓪!* 13.12.88  2.0    MCH    Erweiterung auf 10 Arbeitsdateien
  79. ⓪!* 26.12.88  2.0    MCH         "       "  "        "
  80. ⓪!* 27.12.88  2.0    MCH         "       "  "        "
  81. ⓪!* 19.01.89  2.0    MCH    Kleine Änderungen
  82. ⓪!* 26.01.89  2.0    MCH    Kleine Änderungen
  83. ⓪!* 01.02.89  2.0    MCH    Schnellerer Fenster-Redraw
  84. ⓪!* 11.02.89  2.0    MCH    Batch-Erweiterung
  85. ⓪!* 12.02.89  2.0    MCH    Aligning der Icons macht nun round und nicht trunc
  86. ⓪!* 14.02.89  2.0    MCH    Temporäre Editor-Parameter-Dateien
  87. ⓪!* 06.03.89  2.0    MCH    Kein doppelter Backslash im Parameterpfad
  88. ⓪!* 04.06.89  2.0    MCH    Parameter-file-name wird aus der Argumentzeile
  89. ⓪!*                         übernommen und beim Verlassen autom. Speicherung
  90. ⓪!*                         des Parm.-files.
  91. ⓪!* 07.06.89  2.0    MCH    Drive.Icons werden richtig deselektiert + Kopieren
  92. ⓪!*                         in einen Ordner im gleichen Fenster fkt. richtig.
  93. ⓪!* 13.06.89  2.0    MCH
  94. ⓪!* 19.06.89  2.0    MCH    Änderungen von TT übernommen: pathSize auf 64 ge-
  95. ⓪!*                         setzt.
  96. ⓪!* 05.07.89  2.0    MCH    Quick-Quit
  97. ⓪!* 03.08.89  2.0    MCH    Dir.-Einträge werden jetzt immer richtig sortiert
  98. ⓪!* 05.08.89  2.0    MCH    Der Default-Code-Pfad für neue Arbeitsdateien wird
  99. ⓪!*                         jetzt mit Hilfe von 'Paths' ermittelt. Und eine neu
  100. ⓪!*                         erzeugtes Arbeitsdatei-Objekt wird zum Aktuellen.
  101. ⓪!* 06.08.89  2.0    MCH    Arg.-Zeile wird gemerkt; Kein Copy auf selektierte
  102. ⓪!*                         Einträge; Default-Code-Pfad erst beim Starten er-
  103. ⓪!*                         mitteln; FileBox enthält bei Arbeitsdateien default-
  104. ⓪!*                         mäßig den aktuellen Source-Namen
  105. ⓪!* 07.08.89  2.0    MCH    'Loader.DefaultStackSize' in M2P sichern; LOAD
  106. ⓪!*                         in M2B's verändert Default-Pfad nicht mehr;
  107. ⓪!*                         Bei COMPILE in Batch-Dateien ist im Fehlerfall
  108. ⓪!*                         das Edieren des Files möglich
  109. ⓪!* 10.08.89  2.0    MCH    'HelpBox' und 'InfoBox' impl.; es kann wieder in
  110. ⓪!*                         Ordner kopiert werden; Zielfenster wird nach
  111. ⓪!*                         kopieren wieder neugezeichnet.
  112. ⓪!* 11.08.89  2.0    MCH    'HelpBox' debugging; Shift-F1..10 funktioniert;
  113. ⓪!*                         Es wird auch beim Ausführen von Source-Files nach
  114. ⓪!*                         einem evtl. existierende Code gesucht.
  115. ⓪!* 16.08.89  2.0e   MCH/TT Änderungen von TT übernommen; Editor comp. Datei
  116. ⓪!*                         bei exec. nur wenn nötig; Res.Mod. anklicken
  117. ⓪!*                         => akt.Code setzen; 'LastCodeName/Size' impl.
  118. ⓪!* 17.08.89  2.0f   MCH    Make eingebunden und ein paar bugs beseitigt;
  119. ⓪!*                         beim Dir. öffnen gilt rechter Mausknopf wie
  120. ⓪!*                         Shift; nur on line drives werden angezeigt;
  121. ⓪!*                         'WrapAlert' aus 'EasyGem0'
  122. ⓪!* 19.08.89  2.0g   MCH    Pfadlisten werden richtig gelöscht und besetzt;
  123. ⓪!*                         'MakeFileName' in Umgebungs-Box; 'SearchFile'
  124. ⓪!*                         wird auf 'LibFileName' angewendet.
  125. ⓪!* 22.08.89  2.1    TT     Änderungen von TT übernommen; alle Pfade validiert;
  126. ⓪!*                         Source-Suffices aus ShellMsg importiert; MBT->M2B;
  127. ⓪!*                         MSP->M2P; callEdit schaltet Ctrl-C temporär ab.
  128. ⓪!* 23.08.89         TT     args werden nur verwendet, wenn sie auch explizit
  129. ⓪!*                         eingegeben wurden
  130. ⓪!* 31.08.89         TT     'PrepareScan' setzt 'ScanOpts'
  131. ⓪!* 03.09.89         TT     Wenn Fehler beim Öffnen von Dir auf akt. Pfad
  132. ⓪!*                         wird Wurzel geöffnet.
  133. ⓪!* 06.09.89  2.1c   TT     KbdEvents wird während Shell-Dialog aktiviert
  134. ⓪!* 11.09.89  2.1d   TT     KbdEvents wird anders aktiviert; neue Batch-Cmds;
  135. ⓪!*                         call-Funktion verbessert -> nun wird immer der
  136. ⓪!*                         Code-Pfad als akt. Pfad gesetzt, wenn nicht
  137. ⓪!*                         'noDirChange'.
  138. ⓪!* 14.09.89  2.1e   TT     Editor-Parms: Toolbox-Flag raus, stattdessen
  139. ⓪!*                         Flag f. Box-Anzeige nach Comp-Fehler; Editor
  140. ⓪!*                         kann nun auch mit leerem Dateinamen gestartet
  141. ⓪!*                         werden;
  142. ⓪!* 20.09.89  2.1f   TT     Tool-Namen werden mit Endung angezeigt;
  143. ⓪!*                         Tools und Systemprgs erhalten akt. Pfad, wenn
  144. ⓪!*                         kein extra-Pfad angegeben ist;
  145. ⓪!*                         Eventuelles 'HomeSymbol' in shellParm.batchPath,
  146. ⓪!*                         editorParm.tempEditorName/tempShellName,
  147. ⓪!*                         TemporaryPath u. DefLibName wird beim Lesen der
  148. ⓪!*                         Parameter durch Shell-Homepath ersetzt;
  149. ⓪!*                         Code-Suche in hdrun.getCodeDateTime korrigiert
  150. ⓪!* 11.01.90  2.1g   TT     Inconsistent-Abfrage nach CallModule
  151. ⓪!* 15.01.90         TT     insertDirEntry: subDir-Aufruf durch Inline ersetzt;
  152. ⓪!*                         Reihenfolgen in RECORDs, die auf Disk gesichert
  153. ⓪!*                         werden verändert. ForceMediaChange-Aufruf
  154. ⓪!* 17.01.90         TT     CompilerParm nach ShellMsg übertragen
  155. ⓪!* 28.02.90         TT     Rsc um CompilerArgs erweitert, auch in M2P;
  156. ⓪!*                         initWorkfile nach LoadParameter aufgerufen;
  157. ⓪!*                         Real-Format in Env-Box angezeigt, Rsc: alle Über-
  158. ⓪!*                         schriften mit Schattenbreite 2, Buttons verkleinert.
  159. ⓪!* 14.03.90  2.1h   MCH    Verhalten beim Selektieren dem Desktop angeglichen;
  160. ⓪!*                         Compile-Execute auf Plus-Taste; ALT-e/c/l rufen
  161. ⓪!*                         Editor-, Compiler- bzw. Linker-Box auf; Beim Ende
  162. ⓪!*                         eines Help-Textes wir der Abbruch-Button zum Default;
  163. ⓪!*                         Keine Fehlermeldung mehr, falls in Parm.-Datei ein
  164. ⓪!*                         leerer Batchpfad gesetzt ist; Ausführen setzt
  165. ⓪!*                         aktuellen Code jetzt richtig
  166. ⓪!* 16.03.90         TT     Compiler, Editor, Make und Linker erhalten feste
  167. ⓪!*                         StackSize beim Start
  168. ⓪!* 01.05.90  2.1i   TT     'HomePath' wird nicht mehr dauerhaft ersetzt, sondern
  169. ⓪!*                         nur jeweils bei Benutzung, sodaß ein '*' im Pfad
  170. ⓪!*                         dort erhalten bleibt; (Siehe "!TT")
  171. ⓪!*                         Conditionals für KbdEvents-Aufrufe; HomePath wird
  172. ⓪!*                         durch ShellRead ermittelt; ELSE teilw. bei CASE;
  173. ⓪!*                         'getFname' gelöscht, weil totaler Mist; In den
  174. ⓪!*                         Umgebungsinfos kann bestimmt werden, ob nach Ende
  175. ⓪!*                         eines nicht-GEM-Prgs auf einen Tastendruck gewartet
  176. ⓪!*                         werden soll; Pfadname der M2P-Datei wird immer
  177. ⓪!*                         korrekt eingesetzt.
  178. ⓪!* 28.05.90  2.1j   TT     'call' berücksichtigt 'HomePath', wenn er im Prg-
  179. ⓪!*                         namen vorkommt.
  180. ⓪!* 30.05.90         TT     Batch-Dateien werden nun auf den Default-Pfaden
  181. ⓪!*                         gesucht
  182. ⓪!* 14.06.90         TT     Im Init-Teil vom lokalen Modul 'ShellShell' können
  183. ⓪!*                         nun zentral alle Dateiendungen definiert werden.
  184. ⓪!* 16.06.90  2.1k   TT     Batch-Befehle DEFOUT, IMPOUT, MODOUT
  185. ⓪!* 12.08.90         MCH    ShellRead wieder eingesetzt
  186. ⓪!* 05.10.90  2.1l   MCH    Änderungen übernommen
  187. ⓪!* 07.10.90  2.1m   MCH    Noch mehr Änderungen übernommen
  188. ⓪!* 24.10.90  2.1n   TT     $W- raus und 'alert' entspr. korrigiert; Anpassung
  189. ⓪!*                         an neuen FormatDrive-Typ.
  190. ⓪!* 20.11.90  2.1o   TT     Anpassung an neuen Loader ohne Stacksize-Parm;
  191. ⓪!*                         M2P wird auf HomePath gesucht und weitere Korrekturen
  192. ⓪!*                         in ShellShell-Body.
  193. ⓪!* 01.12.90  2.1p   MCH    Benutzt neue 'EasyGEM0'-Routinen; das Starten von
  194. ⓪!*                         Tools, die einen leeren Dateinamen besitzen wird
  195. ⓪!*                         ignoriert; EXEC-Batch-Befehl funktioniert auch auf
  196. ⓪!*                         Batch-Dateien; 'ShellGet'-Buffer ist jetzt auch für
  197. ⓪!*                         den TT ausreichend; Icons werden autom. in den
  198. ⓪!*                         sichtbaren Teil des Desktop-Koor.systems gebracht.
  199. ⓪!* 11.12.90  2.2    TT     FormError-Aufruf bei bestimmten Exitcodes ('call');
  200. ⓪!*                         TermProcess (fInsufficientMemory), wenn InitSS
  201. ⓪!*                         fehlschlägt; ShellName bei ShellWrite zurückgesetzt,
  202. ⓪!*                         Flag 'DoShellWrite'; TermProcess (0), wenn keine RSC
  203. ⓪!* 07.04.91  2.2b   TT     Höhe der Menüzeile korrigiert; ACCs werden vor/nach
  204. ⓪!*                         Start von Programmen geschlossen; FileInformation
  205. ⓪!*                         geht auch bei Ordnern; 'installDriveIcons' wird
  206. ⓪!*                         nun erst nach Ausführen der Shell-Batch-Datei
  207. ⓪!*                         durchgeführt, das hat den Vorteil, daß nun im
  208. ⓪!*                         Batch temporär eine RAMDisk installiert werden kann;
  209. ⓪!*                         Batch-Befehle "POSTAMBLE1/2" zum Starten von Prgs
  210. ⓪!*                         vor Verlassen der Shell; Codename von Workfiles wird
  211. ⓪!*                         nun immer korrekt behalten; beim Formatieren wird
  212. ⓪!*                         nun das richtige Laufwerk ausgewählt.
  213. ⓪!* 20.05.91  2.2d   TT     Bei manueller Arbeitsdateieingabe wird die Datei
  214. ⓪!*                         auf den Source-Pfaden gesucht.
  215. ⓪!* 20.10.91  2.3    TT     Linker-Option-Box ermöglicht Symboldatei-Erzeugung.
  216. ⓪!*                  MS     Shell nun MultiGEM-fähig, dazu 'call' überarbeitet.
  217. ⓪!* 22.05.93  2.3b   TT     Shell nun MultiTOS-fähig.
  218. ⓪!* 15.07.93  2.3c   DS     Shell nun wirklich MultiTOS-fähig. Die Shell mit den
  219. ⓪!*                         Änderungen von TT lief bei mir nicht unter MTOS.
  220. ⓪!*                         Wichtigste Änderung: Unter MTOS wird kein ShelWrite
  221. ⓪!*                         mehr vor einem Programmstart durchgeführt, da das
  222. ⓪!*                         Programme direkt startet. Weiterhin wird der
  223. ⓪!*                         GEMErrorHandler ausgeschaltet, da dieser anscheinend
  224. ⓪!*                         unter MTOS fehlerhaft ist.
  225. ⓪!*                         Alle Laufwerke werden angezeigt, auch die, die nicht
  226. ⓪!*                         im DESKTOP.INF (bzw. NEWDESK.INF) drin sind.
  227. ⓪!*                         Stacksize für Linker erhöht, da ich ein Programm
  228. ⓪!*                         nicht mehr linken konnte.
  229. ⓪!*                         Ganz sauber läuft die Shell übrigens noch immer nicht
  230. ⓪!*                         unter MTOS, nach dem Linken hängt das System und auch
  231. ⓪!*                         kann es ab und zu nach dem Compiler oder Make zu
  232. ⓪!*                         Hängern kommen.
  233. ⓪!* 12.12.93  2.3d   TT     Nochmalige Überarbeitung der V2.3c f. MultiTOS.
  234. ⓪!* 14.01.94  2.3e   TT     Font kann nun in Shellparms eingestellt werden.
  235. ⓪!* 29.03.94  2.3f   TT     Nun werden alle Laufwerke v. A bis Z berücksichtigt.
  236. ⓪!*----------------------------------------------------------------------------
  237. ⓪!*)
  238. ⓪ 
  239. ⓪ 
  240. ⓪ (*  Qualified imports for 'ShellShell'  *)
  241. ⓪ 
  242. ⓪ IMPORT Clock, ModCtrl, TimeConvert,
  243. ⓪'FileManagement,
  244. ⓪ 
  245. ⓪'GEMBase, AESMisc,
  246. ⓪'GrafBase, GEMGlobals, GEMEnv,
  247. ⓪'AESForms, AESObjects, AESWindows, AESResources, AESGraphics, AESMenus,
  248. ⓪'AESEvents,
  249. ⓪'VDIControls, VDIOutputs, VDIAttributes, VDIInquires,
  250. ⓪'ObjHandler, EventHandler, TextWindows, EasyGEM0, EasyGEM1, WindowLists;
  251. ⓪ 
  252. ⓪ 
  253. ⓪ FROM SYSTEM     IMPORT LONGWORD, WORD, ADDRESS, BYTE,
  254. ⓪7ASSEMBLER, ADR, LOAD, STORE;
  255. ⓪ 
  256. ⓪ IMPORT Mm2shellRsc;  (* RSC-Datei *)
  257. ⓪ 
  258. ⓪ FROM RealCtrl   IMPORT AnyRealFormat, UsedFormat;
  259. ⓪ 
  260. ⓪ FROM StrConv    IMPORT CardToStr, IntToStr, StrToLCard, StrToCard,
  261. ⓪7StrToInt, LHexToStr;
  262. ⓪ 
  263. ⓪ FROM Loader     IMPORT LoaderResults, DefaultStackSize,
  264. ⓪7LoadModule, CallModule, UnLoadModule;
  265. ⓪ 
  266. ⓪ FROM PathEnv    IMPORT HomeReplaced, HomeSymbol, ReplaceHome, HomePath;
  267. ⓪ FROM PathCtrl   IMPORT PathList;
  268. ⓪ FROM Paths      IMPORT SearchFile, ListPos;
  269. ⓪ 
  270. ⓪ FROM Storage    IMPORT ALLOCATE, DEALLOCATE, MemAvail, AllAvail, Inconsistent;
  271. ⓪ 
  272. ⓪ FROM Strings    IMPORT PosLen, String, Relation, Compare, Space, Upper, Empty,
  273. ⓪7EatSpaces, Append, StrEqual, Delete, Concat, Assign,
  274. ⓪7Split, Insert, Length, Copy, Pos;
  275. ⓪ 
  276. ⓪ IMPORT Lists;
  277. ⓪ 
  278. ⓪ IMPORT SysUtil0;
  279. ⓪ 
  280. ⓪ FROM MOSConfig IMPORT StdDateMask;
  281. ⓪ IMPORT MOSConfig;
  282. ⓪ 
  283. ⓪ IMPORT MOSCtrl, MOSGlobals;
  284. ⓪ 
  285. ⓪ FROM MOSGlobals IMPORT MemArea, BusFault, OddBusAddr, NoValidRETURN,
  286. ⓪7OutOfStack, FileStr, PathStr, NameStr,
  287. ⓪7fOK, fFileNotFound, fDriveNotReady, fWriteProtected,
  288. ⓪7fPathNotFound, fInvalidDrive, fAccessDenied,
  289. ⓪7fTooManyOpen, fInsufficientMemory, fEOF;
  290. ⓪ 
  291. ⓪ FROM ShellMsg   IMPORT ScanMode, ScanAddr, TextName, ErrorMsg, DefPaths,
  292. ⓪7ModPaths, ErrListFile, ImpPaths, SrcPaths, DefSfx,
  293. ⓪7ImpSfx, ModSfx, CodeName, Active, LinkDesc,
  294. ⓪7LLRange, ScanIndex, TextLine, TextCol,
  295. ⓪7MakeFileName, TemporaryPath, MainOutputPath,
  296. ⓪7DefLibName, DefOutPath, ImpOutPath, ModOutPath,
  297. ⓪7ShellPath, ImpSrcSfx, ModSrcSfx, DefSrcSfx, CodeSize,
  298. ⓪7StdPaths, CompilerArgs, CompilerParm, ScanOpts,
  299. ⓪7LinkMode, LinkerParm, EditorParm;
  300. ⓪ 
  301. ⓪ FROM Directory  IMPORT FileAttr, FileAttrSet, DirEntry, DirQueryProc,
  302. ⓪7SetCurrentDir, GetCurrentDir, DefaultDrive,
  303. ⓪7DirQuery, SetDefaultDrive, DrivesOnline,
  304. ⓪7CreateDir, GetDefaultPath, SetFileAttr,
  305. ⓪7ForceMediaChange, MakeFullPath, SetDefaultPath,
  306. ⓪7FreeSpace;
  307. ⓪ 
  308. ⓪ FROM FileNames  IMPORT StrToDrive, SplitPath, SplitName, DriveToStr,
  309. ⓪7NameConc, ValidatePath, ConcatPath, ConcatName,
  310. ⓪7FileName, FilePath;
  311. ⓪ 
  312. ⓪ FROM Files      IMPORT File, Access, ReplaceMode,
  313. ⓪7Create, Open, Close, State, ResetState, GetStateMsg,
  314. ⓪7Remove, EOF, SetDateTime, GetDateTime;
  315. ⓪ 
  316. ⓪ FROM Binary     IMPORT ReadBlock, ReadBytes, WriteBlock;
  317. ⓪ 
  318. ⓪ IMPORT Text;
  319. ⓪ 
  320. ⓪ FROM GEMScan    IMPORT InputScan, CallingChain, ChainDepth;
  321. ⓪ 
  322. ⓪ FROM PrgCtrl    IMPORT EnvlpCarrier,
  323. ⓪7SetEnvelope, TermProcess;
  324. ⓪4
  325. ⓪ FROM SysTypes   IMPORT ExcDesc, ExcSet, TRAP5;
  326. ⓪ 
  327. ⓪ FROM Excepts    IMPORT InstallPreExc;
  328. ⓪ 
  329. ⓪ FROM SysBuffers IMPORT ExceptsStack;
  330. ⓪ 
  331. ⓪ FROM UserBreak  IMPORT EnableBreak, DisableBreak;
  332. ⓪ 
  333. ⓪ FROM EasyGEM0   IMPORT WrapAlert;
  334. ⓪ 
  335. ⓪ FROM KbdEvents  IMPORT DeInstallKbdEvents, InstallKbdEvents;
  336. ⓪ 
  337. ⓪ FROM TextWindows IMPORT BusyRead;
  338. ⓪ 
  339. ⓪ FROM EasyGEM0   IMPORT SetGetMode, ShowArrow, HideMouse, ShowMouse;
  340. ⓪ 
  341. ⓪ FROM AESForms   IMPORT FormError, FormAlert;
  342. ⓪ 
  343. ⓪ 
  344. ⓪ CONST   DebugWdw = FALSE; (* Flag zur Fehlersuche (Debug-Fenster) *)
  345. ⓪ 
  346. ⓪((* Versionskennung der Shell.
  347. ⓪)*)
  348. ⓪(ShellRevision           = ' 2.3g ';
  349. ⓪ 
  350. ⓪((*
  351. ⓪)* Ist die folg. Konstante TRUE, wird das Modul "KbdEvents"
  352. ⓪)* verwendet, das dafür sorgt, daß Tastendrücke, bei denen
  353. ⓪)* Shift, Control oder Alternate gedrückt werden, immer richtig
  354. ⓪)* erkannt werden.
  355. ⓪)* Andernfalls kann es passieren, daß diese Umschalttasten
  356. ⓪)* ignoriert werden, wenn die gewünschte Aktion erst nach
  357. ⓪)* dem Tastendruck gestartet wird.
  358. ⓪)* Siehe auch Hinweise im Definitions-Text des Moduls
  359. ⓪)*)
  360. ⓪(UseExtKeys = TRUE;
  361. ⓪ 
  362. ⓪((*
  363. ⓪)* Ist die folg. Konstante TRUE, startet die Shell GEM-Programme
  364. ⓪)* korrekt mit der AES-Funktion "ShellWrite", sofern TOS 1.4
  365. ⓪)* oder höher verwendet wird. Dies kann aber zu Problemen führen,
  366. ⓪)* beispielsweise, wenn die Shell von NEODESK gestartet wird,
  367. ⓪)* weshalb sie dazu auf FALSE gesetzt werden kann.
  368. ⓪)*)
  369. ⓪(DoShellWrite = TRUE;
  370. ⓪ 
  371. ⓪((*
  372. ⓪)* Stack-Größen für die Systemprogramme. Sie sollten vergrößert
  373. ⓪)* werden, wenn bei einem der Programme ein "Stacküberlauf"
  374. ⓪)* auftritt.
  375. ⓪)*)
  376. ⓪(CompilerStackSize = 16000;
  377. ⓪(LinkerStackSize = 16000;
  378. ⓪(EditorStackSize = 16000;
  379. ⓪(MakeStackSize = 8000;
  380. ⓪ 
  381. ⓪((*
  382. ⓪)* Maximale Anzahl von Suchpfaden, die in einer Batch-Datei
  383. ⓪)* definiert werden können. Ist zu erhöhen, wenn beim Starten
  384. ⓪)* der Shell oder eines Batches eine diesbezügliche Fehler-
  385. ⓪)* meldung erscheint.
  386. ⓪)*)
  387. ⓪(MaxSearchPaths = 40;
  388. ⓪ 
  389. ⓪((*
  390. ⓪)*  Name der Datei in der alle zu compilierenden Module
  391. ⓪)*  vom Make abgelegt werden. Das Verzeichnis (Pfad), in dem
  392. ⓪)*  diese Datei erzeugt wird, ist der "temporäre Pfad", der
  393. ⓪)*  in der Shell-Parameter-Box anzugeben ist!
  394. ⓪)*)
  395. ⓪(MakeCompFileName        = 'MAKE.M2C';
  396. ⓪ 
  397. ⓪ 
  398. ⓪ TYPE    actionType      = (doEdit, doComp, doLink, doExec, doScan, doCpEx,
  399. ⓪;doLoad, doUnLd, doCont, doBtch, doParm, doMake,
  400. ⓪;doMkEx, doDftM);
  401. ⓪(MySuf           = (prg, app, tos, ttp, mos, mtp, mod, def, imp, m2p,
  402. ⓪;m2b, m2m, m2d);
  403. ⓪ 
  404. ⓪(Str128          = ARRAY [0..127] OF CHAR;
  405. ⓪ 
  406. ⓪(ptrString       = POINTER TO String;
  407. ⓪ 
  408. ⓪(PathEntry       = POINTER TO PathStr;
  409. ⓪ 
  410. ⓪(Drive = ( defaultDrv, drvA, drvB, drvC, drvD, drvE, drvF, drvG,
  411. ⓪2drvH, drvI, drvJ, drvK, drvL, drvM, drvN, drvO, drvP,
  412. ⓪2drvQ, drvR, drvS, drvT, drvU, drvV, drvW, drvX, drvY, drvZ);
  413. ⓪ 
  414. ⓪(DriveSet = SET OF [drvA..drvZ];
  415. ⓪ 
  416. ⓪ 
  417. ⓪ VAR     lastFn, currFn,
  418. ⓪(workFName, workCName       : FileStr;
  419. ⓪(args                       : ARRAY[0..127] OF CHAR;
  420. ⓪ 
  421. ⓪(suf: ARRAY MySuf OF ARRAY [0..2] OF CHAR;
  422. ⓪ 
  423. ⓪ 
  424. ⓪0(*  Konfigurationsvariablen  *)
  425. ⓪0(*  =======================  *)
  426. ⓪ 
  427. ⓪(shellParm       : RECORD
  428. ⓪<breakActive       : BOOLEAN;
  429. ⓪<confirmDelete     : BOOLEAN;
  430. ⓪<confirmCopy       : BOOLEAN;
  431. ⓪<defaultOpenCurrDir: BOOLEAN;
  432. ⓪<useAllMemForCopy  : BOOLEAN;
  433. ⓪<batchPath         : PathStr;
  434. ⓪<parameterPath     : PathStr;
  435. ⓪<sectors           : CARDINAL;
  436. ⓪<tracks            : CARDINAL;
  437. ⓪<sides             : CARDINAL;
  438. ⓪<makeName          : String;
  439. ⓪<waitOnReturn      : BOOLEAN;
  440. ⓪:END;
  441. ⓪ 
  442. ⓪(fontSetting: RECORD
  443. ⓪7name: ARRAY [0..31] OF CHAR;
  444. ⓪7size: CARDINAL
  445. ⓪5END;
  446. ⓪ 
  447. ⓪(noDirChange: BOOLEAN;
  448. ⓪ 
  449. ⓪ PROCEDURE conc ( REF s1,s2: ARRAY OF CHAR ): Str128;
  450. ⓪"VAR s: Str128;
  451. ⓪&voidO: BOOLEAN;
  452. ⓪"BEGIN
  453. ⓪$Concat (s1,s2,s, voidO);
  454. ⓪$RETURN s
  455. ⓪"END conc;
  456. ⓪ 
  457. ⓪ 
  458. ⓪ FORWARD action (what:actionType;wrkFile,tool:BOOLEAN);
  459. ⓪ 
  460. ⓪ FORWARD FileAlert (errNo: INTEGER);
  461. ⓪ FORWARD SaveParameter;
  462. ⓪ FORWARD LoadParameter (REF name: ARRAY OF CHAR);
  463. ⓪ FORWARD ExecuteBatch (name: ARRAY OF CHAR; load: BOOLEAN);
  464. ⓪ 
  465. ⓪ 
  466. ⓪ MODULE ShellShell;      (* Verwaltet alle GEM-Aktionen der Modula Shell *)
  467. ⓪ 
  468. ⓪ 
  469. ⓪ IMPORT Text, SysUtil0,
  470. ⓪ 
  471. ⓪'DebugWdw,   (*  debug flag  *)
  472. ⓪'
  473. ⓪0(*  resource indicies  *)
  474. ⓪*
  475. ⓪'Menu, Mibox, Mshell, Mdatei, Mparms, Minfo,
  476. ⓪'Mtools, Dinfo, Mdinfo, Mdfolder, Mdformat, Mdclose,
  477. ⓪'Mdclosew, Mdnwork, Mdkwork, Mdquit, Mpshell, Mpeditor,
  478. ⓪'Mpcomp, Mplink, Mpsave, Mienv, Mihelp, Midocu, Tibox,
  479. ⓪'Mtool1, Mtool2, Mtool3, Mtool4, Mtool5, Mtool6,
  480. ⓪'Mtool7, Mtool8, Mtool9, Mtool10, Desktop, Currfile,
  481. ⓪'Cfhead, Cfname, Cftext, Cfcode, Driveb, Drivec,
  482. ⓪'Drived, Drivee, Drivef, Driveg, Driveh, Drivei,
  483. ⓪'Drivej, Drivek, Drivel, Drivem, Driven, Driveo,
  484. ⓪'Drivep, Trash, Scan, Edit, Compile, Execute,
  485. ⓪'Link, Resident, Work0, Work1, Work2, Work6,
  486. ⓪'Work7, Work8, Work3, Drivea, Work9, Work4,
  487. ⓪'Work5, Finfobox, Finame, Fiok, Fiquit, Fisize,
  488. ⓪'Firw, Fiprot, Optbox, Oquit, Ook, Oquite,
  489. ⓪'Opmark, Opwidth, Oppath, Ooutput, Oargs, Oerror, Olibrary,
  490. ⓪'Oname, Shellbox, Version, Scanbox, Sok, Squit,
  491. ⓪'Saddr, Filebox, Cfok, Cfcurr, Cfedit, Cfbok, Stponrtn,
  492. ⓪'Cfwork, Snamebox, Snedit, Snok, Snwork, Snquit,
  493. ⓪'Argbox, Aedit, Aok, Loptbox, Locheck1, Locheck2,
  494. ⓪'Locheck3, Locheck4, Locheck5, Locheck6, Locheck7, Locheck8,
  495. ⓪'Lofname1, Lofname2, Lofname3, Lofname4, Lofname5, Lofname6,
  496. ⓪'Lofname7, Lofname8, Lochecks, Lostack, Lofull, Lomiddle,
  497. ⓪'Lonoopt, Lonamopt, Lomaxmod, Look, Loquit, Loname,
  498. ⓪'Lofastld, Lofastco, Lofastme, Losymfil, Loadbox,
  499. ⓪'Lfname, Fldrbox, Fdfolder, Fdname, Fdok, Fdconf,
  500. ⓪'Confibox, Codelete, Conumber, Cook, Coquit, Cocopy,
  501. ⓪'Cowork, Formabox, Fosingle, Fodouble, Fo80, Fo81,
  502. ⓪'Foremain, Fo9, Fo10, Foa, Fob, Foquit,
  503. ⓪'Foname, Sparmbox, Sproot, Spcurr, Spcopy, Spbreak,
  504. ⓪'Spdelete, Spallmem, Spbaname, Sppaname, Spok, Spquit,
  505. ⓪'Spscpath, Spfontn, Spfonts, Spmake, Msgbar, Mbmsg, Eparmbox,
  506. ⓪'Epname, Epsearch, Epstoper, Epshtemp, Epshname, Epedtemp,
  507. ⓪'Epedname, Eparg, Eparname, Eparpos, Eparerro, Epok,
  508. ⓪'Epquit, Helpbox, Hpnext, Hpprev, Hpquit, Hpmsgs,
  509. ⓪'Hpmsg1, Hpmsg2, Hpmsg3, Hpmsg4, Hpmsg5, Hpmsg6,
  510. ⓪'Hpmsg7, Hpmsg8, Hpmsg9, Hpmsg10, Hpmsg11, Hpmsg12,
  511. ⓪'Hpmsg13, Hpmsg14, Infobox, Incode, Ihome, Inlength, Inpath, Realform,
  512. ⓪'Instack, Inmkfile, Inblock, Inall, Inok, Inquit, Nowdwalt,
  513. ⓪'Pathalt, Windalt, Optalt, Memalt, Icon2alt, Spacemsg,
  514. ⓪'Editstr, Editbstr, Npathstr, Debugalt, Noldstr, Okstr,
  515. ⓪'Nouldstr, Noexestr, Retstr, Contmalt,
  516. ⓪'Edstr, Workstr, Compstr, Linkstr, Infstr, Contstr,
  517. ⓪'Formaalt, Parmsalt, Foerralt, Noparalt, Nowrkalt,
  518. ⓪'Exitalt, Loadalt, Alrtfont, Nohlpalt, Makestr,
  519. ⓪ 
  520. ⓪%
  521. ⓪0(*  from the library  *)
  522. ⓪ 
  523. ⓪'ADDRESS, BYTE, WORD,
  524. ⓪'ASSEMBLER, ADR, LOAD, STORE,
  525. ⓪'
  526. ⓪'(*  Storage  *)
  527. ⓪'ALLOCATE, DEALLOCATE, MemAvail, AllAvail,
  528. ⓪ 
  529. ⓪'(* RealCtrl *)
  530. ⓪'AnyRealFormat, UsedFormat,
  531. ⓪'
  532. ⓪'(*  Strings  *)
  533. ⓪'String, Relation,
  534. ⓪'Concat, Insert, Split, Assign, Length, Compare, Copy, Space,
  535. ⓪'Upper, Empty, EatSpaces, Append, StrEqual, PosLen, Delete, Pos,
  536. ⓪'
  537. ⓪'MOSConfig,
  538. ⓪'DefSrcSfx, ImpSrcSfx, ModSrcSfx, StdDateMask,
  539. ⓪'
  540. ⓪'(*  StrConv  *)
  541. ⓪'CardToStr, IntToStr, StrToCard, StrToLCard, LHexToStr,
  542. ⓪ 
  543. ⓪'(*  Directory  *)
  544. ⓪'FileAttr, FileAttrSet, DirEntry, DirQueryProc, Drive, DriveSet,
  545. ⓪'DirQuery, SplitPath, SplitName, SetFileAttr, StrToDrive, FreeSpace,
  546. ⓪'DriveToStr, DefaultDrive, CreateDir, GetCurrentDir, SetDefaultDrive,
  547. ⓪'SetCurrentDir, FileStr, PathStr, NameStr, DrivesOnline, ValidatePath,
  548. ⓪'ForceMediaChange, MakeFullPath, ConcatPath, ConcatName, SetDefaultPath,
  549. ⓪'FileName, GetDefaultPath, FilePath,
  550. ⓪'
  551. ⓪'(*  ShellMsg  *)
  552. ⓪'ScanMode, TextName, CodeName, DefSfx, ImpSfx, ModSfx, ScanAddr,
  553. ⓪'ErrListFile, LinkDesc, TemporaryPath, LLRange,
  554. ⓪'ShellPath, MakeFileName, DefLibName, MainOutputPath, ScanOpts,
  555. ⓪'SrcPaths, DefPaths, EditorParm, CompilerParm, LinkerParm, LinkMode,
  556. ⓪'
  557. ⓪'(*  Loader  *)
  558. ⓪'DefaultStackSize,
  559. ⓪'
  560. ⓪'(*  MOSGlobals  *)
  561. ⓪'MOSGlobals,
  562. ⓪'fOK, fEOF, fFileNotFound,
  563. ⓪'MemArea,
  564. ⓪'
  565. ⓪'(*  Files  *)
  566. ⓪'File, Access,
  567. ⓪'State, Open, Close, ResetState,
  568. ⓪'
  569. ⓪'(*  Binary  *)
  570. ⓪'ReadBlock, WriteBlock,
  571. ⓪'
  572. ⓪'(*  GEMScan  *)
  573. ⓪'ChainDepth,
  574. ⓪'
  575. ⓪'(*  Exceptions  *)
  576. ⓪'TRAP5, ExcSet, ExcDesc,
  577. ⓪'ExceptsStack, InstallPreExc,
  578. ⓪'
  579. ⓪'(*  Paths  *)
  580. ⓪'ListPos,
  581. ⓪'ReplaceHome, SearchFile,
  582. ⓪'HomePath, HomeSymbol,
  583. ⓪'
  584. ⓪'(*  PrgCtrl  *)
  585. ⓪'TermProcess,
  586. ⓪'
  587. ⓪'(*  from the outer module  *)
  588. ⓪'CompilerArgs,
  589. ⓪'actionType, Str128,
  590. ⓪'lastFn, currFn, MySuf, ShellRevision,
  591. ⓪'action, suf, args, noDirChange, fontSetting, shellParm, conc,
  592. ⓪'SaveParameter, LoadParameter, FileAlert, ExecuteBatch;
  593. ⓪ 
  594. ⓪ (*  MOS  *)
  595. ⓪ 
  596. ⓪ FROM MOSCtrl            IMPORT RealMode;
  597. ⓪ 
  598. ⓪ FROM Clock              IMPORT Date, Time;
  599. ⓪ 
  600. ⓪ FROM ModCtrl            IMPORT ModQuery;
  601. ⓪ 
  602. ⓪ FROM TimeConvert        IMPORT TimeToText, DateToText;
  603. ⓪ 
  604. ⓪ FROM Lists              IMPORT List, LDir, InitList,
  605. ⓪?CreateList, DeleteList, ResetList, AppendEntry,
  606. ⓪?InsertEntry, NextEntry, PrevEntry, RemoveEntry,
  607. ⓪?CurrentEntry, ListEmpty, ScanEntries,
  608. ⓪?NoOfEntries, EndOfList;
  609. ⓪ 
  610. ⓪ FROM FileManagement     IMPORT FormatDrive, FormatResult,
  611. ⓪?FormatDisk, CountFilesAndDirs, CopyFiles,
  612. ⓪?DeleteFiles, FileInformation;
  613. ⓪ 
  614. ⓪ (*  Graphics  *)
  615. ⓪ 
  616. ⓪ FROM GrafBase   IMPORT black, Pnt, Rect, PtrBitPattern, WritingMode,
  617. ⓪7Point, Rectangle, TransRect, MinPoint, ClipRect,
  618. ⓪7FrameRects;
  619. ⓪5
  620. ⓪ (*  General GEM  *)
  621. ⓪ 
  622. ⓪ FROM GEMGlobals IMPORT Root, MaxDepth, NoObject, MaxStr,
  623. ⓪7PtrObjTree, GemChar, MouseButton, MButtonSet,
  624. ⓪7SpecialKeySet, ObjState, OStateSet, ObjFlag,
  625. ⓪7OFlagSet, ObjType, FillType, SpecialKey, PtrMaxStr,
  626. ⓪7LineType;
  627. ⓪ 
  628. ⓪ FROM GEMEnv     IMPORT RC, GemHandle, DeviceHandle, DevParm, PtrDevParm,
  629. ⓪7InitGem, ExitGem, GemActive, CurrGemHandle,
  630. ⓪7SetCurrGemHandle, GemError, MouseInput, DeviceParameter;
  631. ⓪ 
  632. ⓪ (*  VDI  *)
  633. ⓪ 
  634. ⓪ FROM VDIControls        IMPORT SetClipping, DisableClipping;
  635. ⓪ 
  636. ⓪ FROM VDIOutputs         IMPORT PolyLine;
  637. ⓪ 
  638. ⓪ FROM VDIInquires        IMPORT GetFaceName, GetFaceInfo;
  639. ⓪ 
  640. ⓪ FROM VDIAttributes      IMPORT SetLineType, SetLineColor, SetWritingMode,
  641. ⓪?DefUserLine;
  642. ⓪ 
  643. ⓪ (*  AES  *)
  644. ⓪ 
  645. ⓪ FROM AESForms           IMPORT FormDialMode,
  646. ⓪?FormDial, FormDo, FormAlert;
  647. ⓪ 
  648. ⓪ FROM AESObjects         IMPORT FindObject, DrawObject;
  649. ⓪ 
  650. ⓪ FROM AESWindows         IMPORT DeskHandle,
  651. ⓪?MouseControl, SetNewDesk, UpdateWindow;
  652. ⓪ 
  653. ⓪ FROM AESResources       IMPORT ResourcePart,
  654. ⓪?LoadResource, FreeResource, ResourceAddr;
  655. ⓪ 
  656. ⓪ FROM AESGraphics        IMPORT MouseForm,
  657. ⓪?DragBox, MouseKeyState, GrafMouse, RubberBox;
  658. ⓪ 
  659. ⓪ FROM AESMenus           IMPORT MenuBar, NormalTitle, EnableItem, MenuText,
  660. ⓪?CheckItem;
  661. ⓪ 
  662. ⓪ FROM AESEvents          IMPORT menuSelected, Event, RectEnterMode;
  663. ⓪ 
  664. ⓪ FROM AESMisc            IMPORT ShellGet, ShellRead;
  665. ⓪ 
  666. ⓪ IMPORT GEMBase;
  667. ⓪ 
  668. ⓪ (*  Beyond GEM  *)
  669. ⓪ 
  670. ⓪ FROM ObjHandler         IMPORT SetPtrChoice,
  671. ⓪?SetCurrObjTree, CurrObjTree,
  672. ⓪?ObjectState, SetObjSpace, ObjectSpace,
  673. ⓪?ObjectFlags, BorderThickness, AssignTextStrings,
  674. ⓪?GetTextStrings, ObjTreeError, LinkTextString,
  675. ⓪?SetObjFlags, CreateSpecification, ObjectType,
  676. ⓪?SetObjType, SetIconForm, GetIconForm,
  677. ⓪?SetIconLook, GetIconLook, GetComplexColor,
  678. ⓪?SetComplexColor, GetIconColor, SetIconColor,
  679. ⓪?SetObjState, GetObjRelatives, RightSister;
  680. ⓪ 
  681. ⓪ FROM EventHandler       IMPORT EventProc, WatchDogCarrier,
  682. ⓪?HandleEvents, ShareTime, DeInstallWatchDog,
  683. ⓪?InstallWatchDog, FlushEvents;
  684. ⓪ 
  685. ⓪ IMPORT TextWindows;
  686. ⓪ (*
  687. ⓪ FROM TextWindows        IMPORT Window, ForceMode, WindowQuality, WQualitySet,
  688. ⓪?NoWind,
  689. ⓪?Write, WriteString, WriteLn, GotoXY,
  690. ⓪?Read, WritePg, BusyRead;
  691. ⓪!*)
  692. ⓪ 
  693. ⓪ FROM EasyGEM0           IMPORT SetGetMode, ObjEnumRef,
  694. ⓪?ShowArrow, HideMouse, ShowMouse,
  695. ⓪?ObjectSpaceWithAttrs, AbsObjectSpace,
  696. ⓪?GetTextString, SetTextString, SetObjStateElem,
  697. ⓪?ToggleObjState, ObjectStateElem, SetObjFlag,
  698. ⓪?PrepareBox, ReleaseBox, DoSimpleBox,
  699. ⓪?ForceDeskRedraw, DrawObjInWdw, DeskSize,
  700. ⓪?DeselectButton, ToggleCheckBox, ToggleCheckPlus,
  701. ⓪?SetGetBoxLCard, SetGetBoxStr, SetGetBoxEnum,
  702. ⓪?SetGetBoxState, SetGetBoxCard, CharSize,
  703. ⓪?ToggleSelectBox, ObjectFlag, TreeAddress,
  704. ⓪?TextStringAddress;
  705. ⓪ 
  706. ⓪ FROM WindowLists        IMPORT WindowList, NoWindowList, DetectModeWL,
  707. ⓪?EntryToStrProcWL, CloseProcWL,
  708. ⓪?SelectEntryProcWL, AttributeWL,
  709. ⓪?AttributesWL, CenterWindowWL, MaxWindowWL,
  710. ⓪?QueryDirectionWL, ErrorStateWL, CreateWL,
  711. ⓪?DeleteWL, SetListWL, GetListWL, ShowWindowWL,
  712. ⓪?HideWindowWL, DetectWindowWL, IsTopWindowWL,
  713. ⓪?SelectAreaWL, WindowSizeWL, EntryAttributesWL,
  714. ⓪?SetEntryAttributesWL, QueryListWL, GetEntryBoxWL,
  715. ⓪?StateWL, ResetStateWL, ViewLineWL,
  716. ⓪?PutWindowOnTopWL, SetWindowSizeWL;
  717. ⓪ 
  718. ⓪ 
  719. ⓪ EXPORT TellMode, MaxTool, ToolField, NoPathsStr, EditBatStr,
  720. ⓪'NoLoadStr, OkStr, NoUnloadStr, NoExecStr, RetStr, EdStr, MakeStr,
  721. ⓪'WorkStr, CompStr, LinkStr, InfStr, ContMakeAlt, noParmAlt, ContStr,
  722. ⓪'InitSS, ExitSS, ShowSS, HideSS, TalkWithUser, RequestArg, ScanBox,
  723. ⓪'TellLoading, ClearDeskAndShowMsg, ShowBee, SetGetWindows,
  724. ⓪'SetGetDeskPositions, WorkField, IsSourceName,
  725. ⓪'memErrorAlt, ShellName, LastCodeName, LastCodeSize, EditStr,
  726. ⓪'maxWorkFiles, appl_init, appl_exit, multiGEM, multiTOS,
  727. ⓪'(*$ ? DebugWdw: dWriteLn, dWrite, dWait, *)
  728. ⓪'SetWindowSizes, SetFonts, AESUpdateWindow, InitWorkfile, IsMBTFile;
  729. ⓪ 
  730. ⓪ CONST   minNecessaryMem = 50L * 1024L;  (*  min. 50k Speicher  *)
  731. ⓪ 
  732. ⓪(screenColumns   = 80;           (*  screen width in chars  *)
  733. ⓪ 
  734. ⓪(MaxTool         = 10;
  735. ⓪(maxWorkFiles    = 10;
  736. ⓪ 
  737. ⓪(resourceFile    = 'MM2SHELL.RSC';
  738. ⓪(batchFile       = 'MM2SHELL.M2B';
  739. ⓪(parameterFile   = 'MM2SHELL.M2P';
  740. ⓪(helpFile        = 'MM2SHELL.HLP';
  741. ⓪(noDrvIcons      = 16;           (*  Anzahl der Drive-Icons  *)
  742. ⓪(minDrv          = drvA;
  743. ⓪(maxDrv          = drvP;
  744. ⓪(fileBoxLength   = 41;           (*  Länge des file box edit strings  *)
  745. ⓪(maxDftPathInfo  = 43;           (*  'infoBox.Inpath' length *)
  746. ⓪(maxCodeFileInfo = 43;           (*  'infoBox.Incode' length  *)
  747. ⓪(maxDefLibName   = 33;           (*  'infoBox.Inmkfile' length *)
  748. ⓪ 
  749. ⓪(maxWfChars      = 24;  (*  Maximale Anzahl der Zeichen, die im Ar-
  750. ⓪@*  beitsdatei-Icon des Desks angezeigt werden
  751. ⓪@*)
  752. ⓪(msgStrLen       = 70;
  753. ⓪(
  754. ⓪(noRscAlt1       = '[3][Das Resource File kann|nicht geladen werden!]';
  755. ⓪(noRscAlt2       = '[ Bye Bye... ]';
  756. ⓪(
  757. ⓪(noGemAlt1       = '[3][Anmeldung beim GEM|ist nicht gelungen!]';
  758. ⓪(noGemAlt2       = '[ Pech ?! ]';
  759. ⓪(
  760. ⓪(memErrorAlt     = 'Fehler in Speicherverwaltung|Neustart empfohlen!';
  761. ⓪(
  762. ⓪(stdProtWidth    = 80;  (* Standardbreite des Compilerprotokolls *)
  763. ⓪(
  764. ⓪(undoKey         = BYTE (97);
  765. ⓪(
  766. ⓪(
  767. ⓪ TYPE    ptrRectangle    = POINTER TO Rectangle;
  768. ⓪(ptrList         = POINTER TO List;
  769. ⓪(ptrString       = POINTER TO String;
  770. ⓪(
  771. ⓪(driveDskr       = RECORD
  772. ⓪<available : BOOLEAN;
  773. ⓪<treeIndex : CARDINAL;
  774. ⓪:END;
  775. ⓪9
  776. ⓪:
  777. ⓪0(*  definitions for the shell windows  *)
  778. ⓪0(*  ---------------------------------  *)
  779. ⓪:
  780. ⓪ CONST   dirLeftBorder   = 3;    (*  Formatierungskonstanten für  *)
  781. ⓪(dirNameLen      = 9;    (*  die Dir.-Fensterausgabe      *)
  782. ⓪(dirExtLen       = 3;
  783. ⓪(dirGap          = 3;
  784. ⓪(dirSizeLen      = 7;
  785. ⓪(dirRightBorder  = 1;
  786. ⓪(dirTimeLen      = 5;
  787. ⓪(dirWidthNoDate  = dirLeftBorder + dirNameLen + dirExtLen + dirGap +
  788. ⓪:dirSizeLen + dirGap + dirTimeLen + dirGap +
  789. ⓪:dirRightBorder;
  790. ⓪(dirVisibleWidth = dirLeftBorder + dirNameLen + dirExtLen + dirGap;
  791. ⓪ VAR     dirDateLen,
  792. ⓪(dirWdwWidth     : CARDINAL;
  793. ⓪ 
  794. ⓪ CONST   modWdwTitle     = ' Geladene Module ';
  795. ⓪(modWdwTitleAll  = ' Residente Module ';
  796. ⓪(
  797. ⓪(maxModNameLen   = 20;      (*  Max. Zahl der Zeichen eines Modul-
  798. ⓪D*  namens die im Fenster sichtbar sind.
  799. ⓪D*)
  800. ⓪(lCardLog        = 10;      (*  Max. Dezimalstellen eines LONGCARD's  *)
  801. ⓪(modGap          = 1;
  802. ⓪(modModFlag      = ' Modul';
  803. ⓪(modModLen       = 6;       (*  Anzahl der Zeichen in 'modModFlag'  *)
  804. ⓪(modLoadFlag     = 'Geladen';
  805. ⓪(modLoadLen      = 7;       (*  = Length (modLoadFlag)  *)
  806. ⓪(modRsdFlag      = 'Resident';
  807. ⓪(modRsdLen       = 8;       (*  = Length (modRsdFlag)  *)
  808. ⓪(
  809. ⓪(modDataLen      = modGap + lCardLog +modGap + lCardLog + modGap +
  810. ⓪:modModLen + modGap + modRsdLen;
  811. ⓪(modDataLenAll   = modDataLen + modGap + modLoadLen;
  812. ⓪:
  813. ⓪(modWdwWidth     = maxModNameLen + modDataLen;
  814. ⓪(modWdwWidthAll  = maxModNameLen + modDataLenAll;
  815. ⓪:
  816. ⓪ CONST   maxWdw          = 5;   (* Max. Fensterzahl *)
  817. ⓪(firstWdwColumn  = 40;
  818. ⓪(
  819. ⓪ TYPE    modEntry        = RECORD          (*  entry of the module list  *)
  820. ⓪<name        : ARRAY[0..79] OF CHAR;
  821. ⓪<lenOfCode   : LONGCARD;
  822. ⓪<lenOfVar    : LONGCARD;
  823. ⓪<isModul     : BOOLEAN;
  824. ⓪<wasLoaded   : BOOLEAN;
  825. ⓪<isResident  : BOOLEAN;
  826. ⓪:END;
  827. ⓪(ptrModEntry     = POINTER TO modEntry;
  828. ⓪(
  829. ⓪(ptrDirEntry     = POINTER TO RECORD
  830. ⓪<entry: DirEntry;
  831. ⓪<str  : String;
  832. ⓪:END;
  833. ⓪:
  834. ⓪(wdwSlotIdx      = [1..maxWdw];
  835. ⓪(wdwKind         = (dirWdw, modWdw);
  836. ⓪(wdwSlot         = RECORD
  837. ⓪<wl        : WindowList;   (*  handle  *)
  838. ⓪<used,
  839. ⓪<isTop     : BOOLEAN;
  840. ⓪<noSelected: CARDINAL;
  841. ⓪<tmpSpace  : Rectangle;
  842. ⓪<CASE kind: wdwKind OF
  843. ⓪>dirWdw    : path  : Str128|
  844. ⓪>modWdw    : all   : BOOLEAN|   (*  all modules  *)
  845. ⓪<END;
  846. ⓪:END;
  847. ⓪(ptrWdwSlot      = POINTER TO wdwSlot;
  848. ⓪:
  849. ⓪ VAR     wdws            : ARRAY wdwSlotIdx OF ptrWdwSlot;
  850. ⓪ 
  851. ⓪ 
  852. ⓪ CONST   noCurrentWorkfile       = -1;   (*  more info at 'WorkField'  *)
  853. ⓪(
  854. ⓪ VAR
  855. ⓪0(*  globale handles  *)
  856. ⓪ 
  857. ⓪(dev                     : DeviceHandle;
  858. ⓪(gemHdl                  : GemHandle;
  859. ⓪(multiGEM                : BOOLEAN;
  860. ⓪(multiTOS                : BOOLEAN;
  861. ⓪(menu, desk, scanBox,
  862. ⓪(shellBox, optBox,
  863. ⓪(fileInfoBox, fileBox,
  864. ⓪(shellParmBox, editorParmBox,
  865. ⓪(sNameBox, argBox,
  866. ⓪(linkBox, loadBox,
  867. ⓪(fNameBox, formatBox,
  868. ⓪(msgBar, confirmBox,
  869. ⓪(helpBox, infoBox        : PtrObjTree;
  870. ⓪(
  871. ⓪(aesPB                   : GEMBase.AESPB;
  872. ⓪(vdiPB                   : GEMBase.VDIPB;
  873. ⓪(
  874. ⓪(noWindAlt, pathToLongAlt,
  875. ⓪(windErrAlt, formatAlt,
  876. ⓪(cOptToLongAlt, wrgIcon2Alt,
  877. ⓪(memFullAlt, drvSpaceMsg,
  878. ⓪(debugAlt, formatErrAlt,
  879. ⓪(NoLoadStr, OkStr, NoPathsStr,
  880. ⓪(NoUnloadStr, NoExecStr,
  881. ⓪(RetStr, EdStr, WorkStr,
  882. ⓪(CompStr, LinkStr, InfStr,
  883. ⓪(ContMakeAlt, ContStr, EditStr, EditBatStr,
  884. ⓪(parmSaveAlt, noParmAlt,
  885. ⓪(noNewWorkAlt, loadFailedAlt,
  886. ⓪(exitShellAlt, noHelpAlt,
  887. ⓪(fontErrAlt,
  888. ⓪(MakeStr                  : PtrMaxStr;
  889. ⓪(
  890. ⓪(linkBoxIdx  : ARRAY[1..8] OF RECORD
  891. ⓪8check,
  892. ⓪8path        : CARDINAL;
  893. ⓪6END;
  894. ⓪(
  895. ⓪(drives      : ARRAY[minDrv..maxDrv] OF driveDskr;
  896. ⓪(
  897. ⓪(ToolField   : ARRAY[1..MaxTool] OF RECORD
  898. ⓪8index       : CARDINAL; (*  Menu-Obj.  *)
  899. ⓪8
  900. ⓪8CASE used :BOOLEAN OF
  901. ⓪:TRUE : name : FileStr;
  902. ⓪8END;
  903. ⓪6END;
  904. ⓪ 
  905. ⓪((*  Contains all work files.
  906. ⓪)*)
  907. ⓪(WorkField   : RECORD
  908. ⓪8noUsed : CARDINAL;
  909. ⓪8current: INTEGER;
  910. ⓪8elems  : ARRAY[0..maxWorkFiles - 1] OF RECORD
  911. ⓪CnameIdx     : CARDINAL;
  912. ⓪CidentIdx    : CARDINAL;
  913. ⓪CcarrierIdx  : CARDINAL;
  914. ⓪Cused        : BOOLEAN;
  915. ⓪CcodeName    : FileStr;
  916. ⓪CsourceName  : FileStr;
  917. ⓪AEND;
  918. ⓪6END;
  919. ⓪(
  920. ⓪(msgStr                  : String;
  921. ⓪(
  922. ⓪(
  923. ⓪0(* Variablen, die die aktuellen Shellparameter speichern *)
  924. ⓪ 
  925. ⓪(selectedDrive           : Drive;   (*  '= defaultDrv' <=> none sel.  *)
  926. ⓪(quitStatus              : (noQuit, quit, quickQuit);
  927. ⓪(LastCodeName            : FileStr;
  928. ⓪(LastCodeSize            : LONGCARD;
  929. ⓪(
  930. ⓪0(* Globale Infovariablen *)
  931. ⓪(
  932. ⓪(deskSize,
  933. ⓪(alignedDeskSize         : Rectangle;
  934. ⓪(charWidth, charHeight   : CARDINAL;
  935. ⓪(
  936. ⓪(tellSpace               : Rectangle;    (*  Darf nur von 'TellLoading'
  937. ⓪Q*  benutzt werden.
  938. ⓪Q*)
  939. ⓪ 
  940. ⓪(lastArgs: ARRAY [0..127] OF CHAR;
  941. ⓪ 
  942. ⓪(ShellName: FileStr;
  943. ⓪ 
  944. ⓪0(* Globale Kurzzeitvariablen *)
  945. ⓪(
  946. ⓪(ok      : BOOLEAN;      (*  Siehe auch 'notOKAlert'  *)
  947. ⓪(but     : CARDINAL;
  948. ⓪(
  949. ⓪0(*  global dummies  *)
  950. ⓪(
  951. ⓪(voidC    : CARDINAL;
  952. ⓪(voidO    : BOOLEAN;
  953. ⓪(voidCh   : CHAR;
  954. ⓪(voidI    : INTEGER;
  955. ⓪(void128  : ARRAY [0..127] OF CHAR;
  956. ⓪(voidSlot : wdwSlotIdx;
  957. ⓪(voidADR  : ADDRESS;
  958. ⓪(voidFrame: Rectangle;
  959. ⓪ 
  960. ⓪ (*$ ? DebugWdw:
  961. ⓪(
  962. ⓪(dWdw    : Window;
  963. ⓪(
  964. ⓪ PROCEDURE dWriteLn (str: ARRAY OF CHAR);
  965. ⓪ 
  966. ⓪ BEGIN
  967. ⓪"WriteString (dWdw, str); WriteLn (dWdw);
  968. ⓪ END dWriteLn;
  969. ⓪ 
  970. ⓪ PROCEDURE dWrite (str: ARRAY OF CHAR);
  971. ⓪ 
  972. ⓪ BEGIN
  973. ⓪"WriteString (dWdw, str);
  974. ⓪ END dWrite;
  975. ⓪ 
  976. ⓪ PROCEDURE dWait;
  977. ⓪ VAR ch: CHAR;
  978. ⓪ BEGIN
  979. ⓪"Read (dWdw,ch)
  980. ⓪ END dWait;
  981. ⓪ 
  982. ⓪ PROCEDURE dWriteCard (c, spc: CARDINAL);
  983. ⓪ 
  984. ⓪ BEGIN
  985. ⓪"dWrite (CardToStr (c, spc));
  986. ⓪ END dWriteCard;
  987. ⓪ 
  988. ⓪ PROCEDURE dWriteInt (c: INTEGER; spc: CARDINAL);
  989. ⓪ 
  990. ⓪ BEGIN
  991. ⓪"dWrite (IntToStr (c, spc));
  992. ⓪ END dWriteInt;
  993. ⓪ 
  994. ⓪ 
  995. ⓪ *)
  996. ⓪ 
  997. ⓪ 
  998. ⓪8(*  Diverse Hilfsroutinen  *)
  999. ⓪8(*  =====================  *)
  1000. ⓪ 
  1001. ⓪((*  mouse  *)
  1002. ⓪(
  1003. ⓪ PROCEDURE mouseImage;
  1004. ⓪ 
  1005. ⓪"(*$L-*)
  1006. ⓪"BEGIN
  1007. ⓪$ASSEMBLER
  1008. ⓪*DC.W    $0, $0, $1, $0, $1
  1009. ⓪*DC.W    $07F0,$07F0,$07F0,$07F0,$0FF8,$1FFC,$3FFE,$3FFF
  1010. ⓪*DC.W    $3FFF,$3FFF,$1FFF,$0FFF,$0FFF,$07FF,$03FF,$03FE
  1011. ⓪*DC.W    $0000,$03E0,$03E0,$02A0,$07F0,$0E38,$1F7C,$1FFD
  1012. ⓪*DC.W    $1FFC,$1FFD,$0FF8,$07F2,$07FD,$03E0,$01CA,$01E8
  1013. ⓪$END;
  1014. ⓪"END mouseImage;
  1015. ⓪"(*$L=*)
  1016. ⓪ 
  1017. ⓪ PROCEDURE appl_init;
  1018. ⓪"BEGIN
  1019. ⓪$WITH aesPB DO
  1020. ⓪&WITH pcontrl^ DO
  1021. ⓪(opcode:= 10;
  1022. ⓪(sintin:=  0;
  1023. ⓪(sintout:= 1;
  1024. ⓪(sadrin:=  0;
  1025. ⓪(sadrout:= 0;
  1026. ⓪&END;
  1027. ⓪$END;
  1028. ⓪$GEMBase.CallAES( ADR( aesPB));
  1029. ⓪"END appl_init;
  1030. ⓪ 
  1031. ⓪ PROCEDURE appl_exit;
  1032. ⓪"BEGIN
  1033. ⓪$WITH aesPB DO
  1034. ⓪&WITH pcontrl^ DO
  1035. ⓪(opcode:= 19;
  1036. ⓪(sintin:=  0;
  1037. ⓪(sintout:= 1;
  1038. ⓪(sadrin:=  0;
  1039. ⓪(sadrout:= 0;
  1040. ⓪&END;
  1041. ⓪$END;
  1042. ⓪$GEMBase.CallAES( ADR( aesPB));
  1043. ⓪"END appl_exit;
  1044. ⓪ 
  1045. ⓪ PROCEDURE ShowBee;
  1046. ⓪"BEGIN
  1047. ⓪$IF multiTOS THEN
  1048. ⓪&GrafMouse (bee, NIL);
  1049. ⓪$ELSE
  1050. ⓪&GrafMouse (userCursor, ADDRESS (mouseImage))
  1051. ⓪$END;
  1052. ⓪"END ShowBee;
  1053. ⓪ 
  1054. ⓪ PROCEDURE AESUpdateWindow (b: BOOLEAN);
  1055. ⓪!BEGIN
  1056. ⓪#UpdateWindow (b)
  1057. ⓪!END AESUpdateWindow;
  1058. ⓪ 
  1059. ⓪ PROCEDURE SetFonts;
  1060. ⓪"(* aktualisiert Fonts bei TextWindows und WindowLists *)
  1061. ⓪"VAR c: CARDINAL; i: INTEGER; ok: BOOLEAN; dummyList: List; slot: wdwSlotIdx;
  1062. ⓪"BEGIN
  1063. ⓪$WITH fontSetting DO
  1064. ⓪&IF Empty (name) THEN GetFaceName (dev, 1, name); END;
  1065. ⓪&IF size = 0 THEN size:= 10; END;
  1066. ⓪&(* zuerst den Default-Font bei TextWindows setzen *)
  1067. ⓪&TextWindows.ReSpecify (TextWindows.Window(NIL), 0, size, name, ok);
  1068. ⓪&IF ~ok THEN
  1069. ⓪((* Font kann nicht eingestellt werden. Vermutlich ist Name falsch *)
  1070. ⓪(FormAlert (1, fontErrAlt^, c);
  1071. ⓪&ELSE
  1072. ⓪((* Default-Font nun bei WindowLists setzen *)
  1073. ⓪(SetListWL (NoWindowList, dummyList, EntryToStrProcWL (NIL),
  1074. ⓪,CloseProcWL (NIL), SelectEntryProcWL (NIL), NIL, size, name);
  1075. ⓪((* zuletzt Font bei offenen Fenstern setzen *)
  1076. ⓪(FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO
  1077. ⓪*WITH wdws[slot]^ DO
  1078. ⓪,SetListWL (wl, dummyList, EntryToStrProcWL (NIL), CloseProcWL (NIL),
  1079. ⓪0SelectEntryProcWL (NIL), NIL, size, name);
  1080. ⓪*END;
  1081. ⓪(END;
  1082. ⓪&END;
  1083. ⓪$END;
  1084. ⓪"END SetFonts;
  1085. ⓪ 
  1086. ⓪ PROCEDURE SetWindowSizes;
  1087. ⓪"VAR slot: wdwSlotIdx;
  1088. ⓪"BEGIN
  1089. ⓪$FOR slot:= MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO
  1090. ⓪&SetWindowSizeWL (wdws[slot]^.wl, wdws[slot]^.tmpSpace);
  1091. ⓪$END
  1092. ⓪"END SetWindowSizes;
  1093. ⓪ 
  1094. ⓪ 
  1095. ⓪ VAR     gemChar  : GemChar;
  1096. ⓪(charValid: BOOLEAN;
  1097. ⓪ 
  1098. ⓪ (*$Z-*)
  1099. ⓪ PROCEDURE readKey (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;
  1100. ⓪ (*$Z=*)
  1101. ⓪ 
  1102. ⓪"BEGIN
  1103. ⓪$gemChar := ch;
  1104. ⓪$charValid := TRUE;
  1105. ⓪$RETURN FALSE
  1106. ⓪"END readKey;
  1107. ⓪ 
  1108. ⓪ (*$Z-*)
  1109. ⓪ PROCEDURE timeDummy (): BOOLEAN;
  1110. ⓪ (*$Z=*)
  1111. ⓪ 
  1112. ⓪"BEGIN
  1113. ⓪$RETURN FALSE
  1114. ⓪"END timeDummy;
  1115. ⓪"
  1116. ⓪ PROCEDURE busyReadGemChar (VAR ch: GemChar; VAR valid: BOOLEAN);
  1117. ⓪ 
  1118. ⓪"VAR   worker: ARRAY [1..2] OF EventProc;
  1119. ⓪ 
  1120. ⓪"BEGIN
  1121. ⓪$charValid := FALSE;
  1122. ⓪$worker[1].event := keyboard;
  1123. ⓪$worker[1].keyHdler := readKey;
  1124. ⓪$worker[2].event := timer;
  1125. ⓪$worker[2].timeHdler := timeDummy;
  1126. ⓪$HandleEvents (1, MButtonSet{}, MButtonSet{},
  1127. ⓪2lookForEntry, Rect (0,0,0,0),
  1128. ⓪2lookForEntry, Rect (0,0,0,0),
  1129. ⓪20L,
  1130. ⓪2worker, 0);
  1131. ⓪$
  1132. ⓪$ch := gemChar; valid := charValid;
  1133. ⓪"END busyReadGemChar;
  1134. ⓪"
  1135. ⓪ 
  1136. ⓪((*  strings  *)
  1137. ⓪ 
  1138. ⓪ (*  appendSpcTo -- Fügt Spaces an 'str' an, bis 'Length (str) = i'
  1139. ⓪!*)
  1140. ⓪(
  1141. ⓪ PROCEDURE appendSpcTo (i: CARDINAL; VAR str: ARRAY OF CHAR);
  1142. ⓪ 
  1143. ⓪"VAR   l       : CARDINAL;
  1144. ⓪"
  1145. ⓪"BEGIN
  1146. ⓪$l := HIGH (str);
  1147. ⓪$IF i < l THEN l := i END;
  1148. ⓪$Append (Space (l - Length (str)), str, voidO);
  1149. ⓪"END appendSpcTo;
  1150. ⓪ 
  1151. ⓪ (*  truncCopyStr -- 'source' wird nach 'dest' kopiert. Es gibt 'maxDestLen'
  1152. ⓪!*                  die Größe von 'dest' an, ist 'source' größer, so wird
  1153. ⓪!*                  der vordere Teil abgeschnitten und ein '..' vorange-
  1154. ⓪!*                  stellt.
  1155. ⓪!*)
  1156. ⓪!
  1157. ⓪ PROCEDURE truncCopyString (    source    : ARRAY OF CHAR;
  1158. ⓪?maxDestLen: CARDINAL;
  1159. ⓪;VAR dest      : ARRAY OF CHAR);
  1160. ⓪ 
  1161. ⓪"VAR   sourceLen: CARDINAL;
  1162. ⓪ 
  1163. ⓪"BEGIN
  1164. ⓪$sourceLen := Length (source);
  1165. ⓪$IF sourceLen > maxDestLen THEN
  1166. ⓪&Copy (source, sourceLen - maxDestLen - 2, sourceLen, dest, voidO);
  1167. ⓪&Insert ('..', 0, dest, voidO);
  1168. ⓪$ELSE Assign (source, dest, voidO) END;
  1169. ⓪"END truncCopyString;
  1170. ⓪&
  1171. ⓪&
  1172. ⓪((*  lists  *)
  1173. ⓪ 
  1174. ⓪ TYPE    listApplyProc   = PROCEDURE ((*entry: *) ADDRESS,
  1175. ⓪E(*env  : *) ADDRESS): BOOLEAN;
  1176. ⓪ 
  1177. ⓪ PROCEDURE applyAtList (    l   : List;
  1178. ⓪;(*$Z-*)
  1179. ⓪;work: listApplyProc;
  1180. ⓪;(*$Z=*)
  1181. ⓪;env : ADDRESS;
  1182. ⓪7VAR cut : BOOLEAN);
  1183. ⓪ 
  1184. ⓪"VAR   entry   : ADDRESS;
  1185. ⓪"
  1186. ⓪"BEGIN
  1187. ⓪$cut := FALSE; ResetList (l);
  1188. ⓪$LOOP
  1189. ⓪&entry := NextEntry (l);
  1190. ⓪&IF entry = NIL THEN EXIT                                  (*  EXIT  *)
  1191. ⓪&ELSIF ~ work (entry, env) THEN cut := TRUE; EXIT END;     (*  EXIT  *)
  1192. ⓪$END;
  1193. ⓪"END applyAtList;
  1194. ⓪ 
  1195. ⓪ PROCEDURE deleteList (VAR l: List);
  1196. ⓪ 
  1197. ⓪"VAR   entry: ADDRESS;
  1198. ⓪"
  1199. ⓪"BEGIN
  1200. ⓪$ResetList (l);
  1201. ⓪$entry := PrevEntry (l);
  1202. ⓪$WHILE entry # NIL DO
  1203. ⓪&RemoveEntry (l, voidO);
  1204. ⓪&entry := CurrentEntry (l);
  1205. ⓪$END;
  1206. ⓪$DeleteList (l, voidO);
  1207. ⓪"END deleteList;
  1208. ⓪ 
  1209. ⓪ (*  deleteSimpleList -- Deletes the list 'l' completly. The elements of the
  1210. ⓪!*                      list must be dynamical allocated variables and would
  1211. ⓪!*                      all be disposed.
  1212. ⓪!*                      If 'killCarrier = TRUE' then list-carrier would be
  1213. ⓪!*                      deleted.
  1214. ⓪!*)
  1215. ⓪ 
  1216. ⓪ PROCEDURE deleteSimpleList (VAR l: List; killCarrier: BOOLEAN);
  1217. ⓪ 
  1218. ⓪"VAR   entry: ADDRESS;
  1219. ⓪ 
  1220. ⓪"BEGIN
  1221. ⓪$ResetList (l);
  1222. ⓪$entry := PrevEntry (l);
  1223. ⓪$WHILE entry # NIL DO
  1224. ⓪&RemoveEntry (l, voidO);
  1225. ⓪&DEALLOCATE (entry, 0L);
  1226. ⓪&entry := CurrentEntry (l);
  1227. ⓪$END;
  1228. ⓪$IF killCarrier THEN DeleteList (l, voidO) END;
  1229. ⓪"END deleteSimpleList;
  1230. ⓪ 
  1231. ⓪ 
  1232. ⓪((*  'WindowLists'  *)
  1233. ⓪ 
  1234. ⓪ PROCEDURE entrySelected (slotPtr : ptrWdwSlot;
  1235. ⓪9entry   : ADDRESS;
  1236. ⓪9selected: BOOLEAN);
  1237. ⓪ 
  1238. ⓪"VAR   oldAttrs: AttributesWL;
  1239. ⓪(count   : BOOLEAN;
  1240. ⓪"
  1241. ⓪"BEGIN
  1242. ⓪$(*  'count' := "This call causes a change in the number of selected
  1243. ⓪%*              entries".
  1244. ⓪%*)
  1245. ⓪$oldAttrs := EntryAttributesWL (slotPtr^.wl, entry);
  1246. ⓪$count := ((selectedWL IN oldAttrs) # selected);
  1247. ⓪$
  1248. ⓪$IF selected THEN
  1249. ⓪&SetEntryAttributesWL (slotPtr^.wl, entry,
  1250. ⓪;oldAttrs + AttributesWL{selectedWL});
  1251. ⓪&IF count THEN
  1252. ⓪(INC (slotPtr^.noSelected)
  1253. ⓪&END;
  1254. ⓪$ELSE
  1255. ⓪&SetEntryAttributesWL (slotPtr^.wl, entry,
  1256. ⓪;oldAttrs - AttributesWL{selectedWL});
  1257. ⓪&IF count THEN
  1258. ⓪(DEC (slotPtr^.noSelected)
  1259. ⓪&END;
  1260. ⓪$END;
  1261. ⓪"END entrySelected;
  1262. ⓪ 
  1263. ⓪ (*  firstSelectedEntry -- Returns the first entry of 'slot's window list,
  1264. ⓪!*                        that is selected. If none exists, NIL is returned.
  1265. ⓪!*)
  1266. ⓪ 
  1267. ⓪ (*$Z-*)
  1268. ⓪ PROCEDURE isNotSelected (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;
  1269. ⓪ (*$Z=*)
  1270. ⓪ 
  1271. ⓪"BEGIN
  1272. ⓪$RETURN ~ (selectedWL IN attrs)
  1273. ⓪"END isNotSelected;
  1274. ⓪"
  1275. ⓪ PROCEDURE firstSelectedEntry (slot: wdwSlotIdx): ADDRESS;
  1276. ⓪ 
  1277. ⓪"VAR   result: ADDRESS;
  1278. ⓪(found : BOOLEAN;
  1279. ⓪ 
  1280. ⓪"BEGIN
  1281. ⓪$QueryListWL (wdws[slot]^.wl, forwardWL, isNotSelected, NIL, found, result);
  1282. ⓪$IF ~ found THEN result := NIL END;
  1283. ⓪$
  1284. ⓪$RETURN result
  1285. ⓪"END firstSelectedEntry;
  1286. ⓪"
  1287. ⓪"
  1288. ⓪((*  tests  *)
  1289. ⓪ 
  1290. ⓪ PROCEDURE withShift (VAR s: SpecialKeySet): BOOLEAN;
  1291. ⓪ 
  1292. ⓪"BEGIN
  1293. ⓪$RETURN (leftShiftKey IN s) OR (rightShiftKey IN s)
  1294. ⓪"END withShift;
  1295. ⓪ 
  1296. ⓪ PROCEDURE withBothShifts (VAR s: SpecialKeySet): BOOLEAN;
  1297. ⓪ 
  1298. ⓪"BEGIN
  1299. ⓪$RETURN (leftShiftKey IN s) AND (rightShiftKey IN s)
  1300. ⓪"END withBothShifts;
  1301. ⓪ 
  1302. ⓪ PROCEDURE withCtrl (VAR s: SpecialKeySet): BOOLEAN;
  1303. ⓪ 
  1304. ⓪"BEGIN
  1305. ⓪$RETURN controlKey IN s
  1306. ⓪"END withCtrl;
  1307. ⓪ 
  1308. ⓪ PROCEDURE withAlt (VAR s: SpecialKeySet): BOOLEAN;
  1309. ⓪ 
  1310. ⓪"BEGIN
  1311. ⓪$RETURN alternateKey IN s
  1312. ⓪"END withAlt;
  1313. ⓪ 
  1314. ⓪ PROCEDURE isSubdir (VAR entry: DirEntry): BOOLEAN;
  1315. ⓪ 
  1316. ⓪"BEGIN
  1317. ⓪$RETURN subdirAttr IN entry.attr
  1318. ⓪"END isSubdir;
  1319. ⓪"
  1320. ⓪ 
  1321. ⓪ (*$Z-*)
  1322. ⓪ PROCEDURE fastCompare (VAR s1, s2: ARRAY OF CHAR): Relation;
  1323. ⓪ (*$Z=*)
  1324. ⓪"(*$L-*)
  1325. ⓪"BEGIN
  1326. ⓪$(*
  1327. ⓪&IF s1[0] > s2[0] THEN
  1328. ⓪(RETURN greater
  1329. ⓪&ELSIF s1[0] < s2[0] THEN
  1330. ⓪(RETURN less
  1331. ⓪&ELSE
  1332. ⓪(RETURN Compare (s1,s2)
  1333. ⓪&END
  1334. ⓪$*)
  1335. ⓪$ASSEMBLER
  1336. ⓪(MOVE.L  -12(A3),A1      ; ADR (s1)
  1337. ⓪(MOVE.L  -06(A3),A2      ; ADR (s2)
  1338. ⓪(MOVE.B  (A1),D1         ; s1[0]
  1339. ⓪(MOVE.B  (A2),D2         ; s2[0]
  1340. ⓪(CMP.B   D2,D1
  1341. ⓪(BHI     gr
  1342. ⓪(BCS     le
  1343. ⓪(JMP     Compare         ; s1[0] = s2[0]
  1344. ⓪$le: SUBA.W  #12,A3
  1345. ⓪(MOVE    #less,(A3)+
  1346. ⓪(RTS
  1347. ⓪$gr: SUBA.W  #12,A3
  1348. ⓪(MOVE    #greater,(A3)+
  1349. ⓪$END
  1350. ⓪"END fastCompare;
  1351. ⓪"(*$L=*)
  1352. ⓪"
  1353. ⓪"
  1354. ⓪((*  proc.s for AES objects  *)
  1355. ⓪ 
  1356. ⓪ (*  formDo -- Is same as 'FormDo', but clears the most significant bit
  1357. ⓪!*            of 'exit' (double click).
  1358. ⓪!*)
  1359. ⓪!
  1360. ⓪ PROCEDURE formDo (tree: PtrObjTree; start: CARDINAL; VAR exit: CARDINAL);
  1361. ⓪ 
  1362. ⓪"BEGIN
  1363. ⓪$FormDo (tree, start, exit);
  1364. ⓪$exit := exit MOD (MaxCard DIV 2);
  1365. ⓪"END formDo;
  1366. ⓪"
  1367. ⓪ PROCEDURE drawObject (tree: PtrObjTree; obj: CARDINAL);
  1368. ⓪ 
  1369. ⓪"VAR   space   : Rectangle;
  1370. ⓪ 
  1371. ⓪"BEGIN
  1372. ⓪$space := AbsObjectSpace (tree, obj);
  1373. ⓪$DrawObject (tree, Root, MaxDepth, space);
  1374. ⓪"END drawObject;
  1375. ⓪"
  1376. ⓪ PROCEDURE hideObj (obj: CARDINAL; hide: BOOLEAN);
  1377. ⓪ 
  1378. ⓪"BEGIN
  1379. ⓪$SetObjFlag (CurrObjTree (), obj, hideTreeFlg, hide);
  1380. ⓪"END hideObj;
  1381. ⓪ 
  1382. ⓪ PROCEDURE hideAndRedrawObj (obj: CARDINAL; hide: BOOLEAN);
  1383. ⓪ 
  1384. ⓪"BEGIN
  1385. ⓪$hideObj (obj, hide);
  1386. ⓪$drawObject (CurrObjTree (), obj);
  1387. ⓪"END hideAndRedrawObj;
  1388. ⓪"
  1389. ⓪0(*  Operations on path/file names  *)
  1390. ⓪ 
  1391. ⓪ (*  killPoint -- Wandelt einen Filenamen, der einen Punkt enthält in einen
  1392. ⓪!*               eine Zeichenkette, die aus max. 11 Zeichen besteht. Dabei
  1393. ⓪!*               sind die ersten 8 Zeichen Name und die letzten 3 Extension.
  1394. ⓪!*)
  1395. ⓪ 
  1396. ⓪ PROCEDURE killPoint (REF str: ARRAY OF CHAR): NameStr;
  1397. ⓪ 
  1398. ⓪"VAR     result: NameStr;
  1399. ⓪*i, j  : INTEGER;
  1400. ⓪*l     : CARDINAL;
  1401. ⓪*pref, suf: ARRAY [0..7] OF CHAR;
  1402. ⓪ 
  1403. ⓪"BEGIN
  1404. ⓪$SplitName (str, result, suf);
  1405. ⓪$IF suf[0] # 0C THEN
  1406. ⓪&Append (Space (8 - Length (result)), result, voidO);
  1407. ⓪&Append (suf, result, voidO);
  1408. ⓪$END;
  1409. ⓪$RETURN result
  1410. ⓪"END killPoint;
  1411. ⓪ 
  1412. ⓪ PROCEDURE addPoint (VAR str:ARRAY OF CHAR) :String;
  1413. ⓪ 
  1414. ⓪"VAR     result  : String;
  1415. ⓪*i       : INTEGER;
  1416. ⓪"
  1417. ⓪"BEGIN
  1418. ⓪$Assign (str,result, voidO);
  1419. ⓪$IF Length (result) > 8 THEN Insert ('.', 8, result, voidO) END;
  1420. ⓪$EatSpaces (result);
  1421. ⓪$RETURN result;
  1422. ⓪"END addPoint;
  1423. ⓪ 
  1424. ⓪ (*  IsSourceName -- Is TRUE, if 'path' descibes a source file else FALSE.
  1425. ⓪!*)
  1426. ⓪ 
  1427. ⓪ PROCEDURE IsSourceName (REF path: ARRAY OF CHAR): BOOLEAN;
  1428. ⓪ 
  1429. ⓪"VAR   name    : NameStr;
  1430. ⓪(prefix  : ARRAY[0..64] OF CHAR;
  1431. ⓪(suffix  : ARRAY[0..2] OF CHAR;
  1432. ⓪(sufcnt  : MySuf;
  1433. ⓪(isSource: BOOLEAN;
  1434. ⓪(
  1435. ⓪"BEGIN
  1436. ⓪$SplitPath (path, prefix, name);
  1437. ⓪$SplitName (name, name, suffix);
  1438. ⓪$isSource := suffix[0]#'';
  1439. ⓪$IF isSource THEN
  1440. ⓪&sufcnt:= MIN (MySuf);
  1441. ⓪&LOOP
  1442. ⓪(IF StrEqual (suffix, suf[sufcnt]) THEN isSource := FALSE; EXIT
  1443. ⓪(ELSIF sufcnt = MAX (MySuf) THEN EXIT
  1444. ⓪(ELSE INC (sufcnt) END
  1445. ⓪&END;
  1446. ⓪$END;
  1447. ⓪$RETURN isSource
  1448. ⓪"END IsSourceName;
  1449. ⓪ 
  1450. ⓪ PROCEDURE isMSPFile (REF name: ARRAY OF CHAR): BOOLEAN;
  1451. ⓪"VAR n: ARRAY [0..11] OF CHAR;
  1452. ⓪"BEGIN
  1453. ⓪$SplitPath (name, void128, n);
  1454. ⓪$SplitName (n, void128, n);
  1455. ⓪$RETURN StrEqual (n, suf[m2p])
  1456. ⓪"END isMSPFile;
  1457. ⓪"
  1458. ⓪ PROCEDURE IsMBTFile (REF name: ARRAY OF CHAR): BOOLEAN;
  1459. ⓪"VAR n: ARRAY [0..11] OF CHAR;
  1460. ⓪"BEGIN
  1461. ⓪$SplitPath (name, void128, n);
  1462. ⓪$SplitName (n, void128, n);
  1463. ⓪$RETURN StrEqual (n, suf[m2b])
  1464. ⓪"END IsMBTFile;
  1465. ⓪"
  1466. ⓪ PROCEDURE isMakeFile (REF name: ARRAY OF CHAR): BOOLEAN;
  1467. ⓪"VAR n: ARRAY [0..11] OF CHAR;
  1468. ⓪"BEGIN
  1469. ⓪$SplitPath (name, void128, n);
  1470. ⓪$SplitName (n, void128, n);
  1471. ⓪$RETURN StrEqual (n, suf[m2m])
  1472. ⓪"END isMakeFile;
  1473. ⓪"
  1474. ⓪"
  1475. ⓪0(*  Alerts  *)
  1476. ⓪0(*  ======  *)
  1477. ⓪ 
  1478. ⓪ PROCEDURE doAlert (alt: PtrMaxStr);
  1479. ⓪ 
  1480. ⓪"BEGIN
  1481. ⓪$FormAlert (1, alt^, voidC);
  1482. ⓪"END doAlert;
  1483. ⓪"
  1484. ⓪ 
  1485. ⓪ (*  multiStringAlert -- Setzt aus den zwei Zeichenketten eine Alarmmeldung
  1486. ⓪!*                      zusammen und gibt diese aus.
  1487. ⓪!*)
  1488. ⓪ 
  1489. ⓪ PROCEDURE multiStringAlert (REF str1, str2: ARRAY OF CHAR; VAR but: CARDINAL);
  1490. ⓪ 
  1491. ⓪"VAR     str     : ARRAY[0..255] OF CHAR;
  1492. ⓪"
  1493. ⓪"BEGIN
  1494. ⓪$Concat (str1, str2, str, voidO);
  1495. ⓪$FormAlert (1, str, but);
  1496. ⓪"END multiStringAlert;
  1497. ⓪ 
  1498. ⓪ (*  notOKAlert -- Falls die globale Variable 'ok = FALSE' ist, so wird der
  1499. ⓪!*                übergebene FileStr 'str' innerhalb einer Alert-Box ange-
  1500. ⓪!*                zeigt.
  1501. ⓪!*)
  1502. ⓪!
  1503. ⓪ PROCEDURE notOKAlert (str: PtrMaxStr);
  1504. ⓪ 
  1505. ⓪"BEGIN
  1506. ⓪$IF ~ ok THEN doAlert (str) END;
  1507. ⓪"END notOKAlert;
  1508. ⓪ 
  1509. ⓪ PROCEDURE flexAlert (default: CARDINAL; REF str1,str2:ARRAY OF CHAR; alt:PtrMaxStr;
  1510. ⓪5VAR but:CARDINAL);
  1511. ⓪5
  1512. ⓪ VAR     str, strx       : ARRAY[0..255] OF CHAR;
  1513. ⓪(i, j            : INTEGER;
  1514. ⓪5
  1515. ⓪ BEGIN
  1516. ⓪"i:=Pos ('&',alt^, 0);
  1517. ⓪"j:=Pos ('&',alt^, i + 1);
  1518. ⓪"Copy (alt^, 0,i, str, voidO);
  1519. ⓪"Append (str1, str, voidO);
  1520. ⓪"IF j >= 0 THEN
  1521. ⓪$Copy (alt^, i + 1,j - i - 1, strx, voidO);
  1522. ⓪$Append (strx, str, voidO);
  1523. ⓪$Append (str2, str, voidO);
  1524. ⓪$i:=j;
  1525. ⓪"END;
  1526. ⓪"Copy (alt^, i + 1,Length (alt^) - CARDINAL (i) - 1, strx, voidO);
  1527. ⓪"Append (strx, str, voidO);
  1528. ⓪"FormAlert (default,str, but);
  1529. ⓪ END flexAlert;
  1530. ⓪ 
  1531. ⓪ (*  concatPath -- Wie normales Concat', nur wird bei Überlauf des
  1532. ⓪!*                Zielstrings ein FormAlert ausgelößt.
  1533. ⓪!*                Das 's1, s2' VAR-Parm. sind hat nur Effizenzgründe.
  1534. ⓪!*)
  1535. ⓪!
  1536. ⓪ PROCEDURE concatPath (VAR s1, s2 : ARRAY OF CHAR;
  1537. ⓪6VAR dest   : ARRAY OF CHAR;
  1538. ⓪6VAR success: BOOLEAN);
  1539. ⓪"BEGIN
  1540. ⓪$Concat (s1,s2, dest, success);
  1541. ⓪$IF ~ success THEN doAlert (pathToLongAlt) END;
  1542. ⓪"END concatPath;
  1543. ⓪ 
  1544. ⓪ PROCEDURE appendPath (VAR s      : ARRAY OF CHAR;
  1545. ⓪6VAR dest   : ARRAY OF CHAR;
  1546. ⓪6VAR success: BOOLEAN);
  1547. ⓪6
  1548. ⓪"BEGIN
  1549. ⓪$Append (s, dest, success);
  1550. ⓪$IF ~ success THEN doAlert (pathToLongAlt) END;
  1551. ⓪"END appendPath;
  1552. ⓪ 
  1553. ⓪ PROCEDURE reportOutOfMemory;
  1554. ⓪ 
  1555. ⓪"BEGIN
  1556. ⓪$doAlert (memFullAlt);
  1557. ⓪"END reportOutOfMemory;
  1558. ⓪ 
  1559. ⓪(
  1560. ⓪8(*  Desk-Operationen  *)
  1561. ⓪8(*  ================  *)
  1562. ⓪(
  1563. ⓪ PROCEDURE deskObjSpace (obj: CARDINAL): Rectangle;
  1564. ⓪ 
  1565. ⓪"BEGIN
  1566. ⓪$RETURN AbsObjectSpace (desk, obj)
  1567. ⓪"END deskObjSpace;
  1568. ⓪ 
  1569. ⓪ PROCEDURE redrawDeskObj (obj:CARDINAL);
  1570. ⓪ 
  1571. ⓪"BEGIN
  1572. ⓪$DrawObjInWdw (desk, obj, TRUE, DeskHandle);
  1573. ⓪"END redrawDeskObj;
  1574. ⓪ 
  1575. ⓪ PROCEDURE toggleDeskObj (obj:CARDINAL; VAR newState:BOOLEAN);
  1576. ⓪ 
  1577. ⓪"BEGIN
  1578. ⓪$ToggleObjState (desk, obj, selectObj, FALSE);
  1579. ⓪$redrawDeskObj (obj);
  1580. ⓪$newState := ObjectStateElem (desk, obj, selectObj);
  1581. ⓪"END toggleDeskObj;
  1582. ⓪ 
  1583. ⓪ PROCEDURE selectDeskObj (obj:CARDINAL; state:BOOLEAN; VAR oldState: BOOLEAN);
  1584. ⓪ 
  1585. ⓪"BEGIN
  1586. ⓪$oldState := ObjectStateElem (desk, obj, selectObj);
  1587. ⓪$SetObjStateElem (desk, obj, selectObj, state);
  1588. ⓪$redrawDeskObj (obj);
  1589. ⓪"END selectDeskObj;
  1590. ⓪ 
  1591. ⓪ PROCEDURE careOfDeselectDrive;
  1592. ⓪ 
  1593. ⓪"BEGIN
  1594. ⓪$IF selectedDrive # defaultDrv THEN
  1595. ⓪&toggleDeskObj (drives[selectedDrive].treeIndex, voidO);
  1596. ⓪&selectedDrive := defaultDrv;
  1597. ⓪$END;
  1598. ⓪"END careOfDeselectDrive;
  1599. ⓪ 
  1600. ⓪ PROCEDURE selectDrive (drv: Drive);
  1601. ⓪ 
  1602. ⓪"BEGIN
  1603. ⓪$IF selectedDrive # drv THEN
  1604. ⓪&IF selectedDrive # defaultDrv THEN careOfDeselectDrive END;
  1605. ⓪&selectedDrive := drv;
  1606. ⓪&toggleDeskObj (drives[selectedDrive].treeIndex, voidO);
  1607. ⓪$END;
  1608. ⓪"END selectDrive;
  1609. ⓪ 
  1610. ⓪ (*  ensureVisibility  -- Ensures, that the given object lies within the
  1611. ⓪!*                       borders of the desk, e.g. is visible and that it
  1612. ⓪!*                       is aligned to char. coor.s.
  1613. ⓪!*)
  1614. ⓪!
  1615. ⓪ PROCEDURE ensureVisibility (obj: CARDINAL);
  1616. ⓪ 
  1617. ⓪"PROCEDURE ensure0 (VAR pos,
  1618. ⓪9width      : INTEGER;
  1619. ⓪9borderPos,
  1620. ⓪9borderWidth: INTEGER;
  1621. ⓪9alignWidth : CARDINAL);
  1622. ⓪"
  1623. ⓪$BEGIN
  1624. ⓪&pos := pos - pos MOD INTEGER (alignWidth);
  1625. ⓪&WHILE pos + width > borderPos + borderWidth DO
  1626. ⓪(pos := pos DIV 2;
  1627. ⓪&END;
  1628. ⓪&IF pos < borderPos THEN pos := borderPos END;
  1629. ⓪$END ensure0;
  1630. ⓪ 
  1631. ⓪"VAR   space: Rectangle;
  1632. ⓪"
  1633. ⓪"BEGIN
  1634. ⓪$space := ObjectSpace (obj);
  1635. ⓪$ensure0 (space.x, space.w, alignedDeskSize.x, alignedDeskSize.w, charWidth);
  1636. ⓪$ensure0 (space.y, space.h, alignedDeskSize.y, alignedDeskSize.h, charHeight);
  1637. ⓪$SetObjSpace (obj, space);
  1638. ⓪"END ensureVisibility;
  1639. ⓪"
  1640. ⓪"
  1641. ⓪ PROCEDURE moveDeskPart (obj:CARDINAL);
  1642. ⓪ 
  1643. ⓪"VAR     newPos  : Point;
  1644. ⓪"
  1645. ⓪"BEGIN
  1646. ⓪$AESUpdateWindow (TRUE);
  1647. ⓪$
  1648. ⓪$SetCurrObjTree (desk, FALSE);
  1649. ⓪$hideObj (obj, TRUE);
  1650. ⓪$redrawDeskObj (obj);
  1651. ⓪$
  1652. ⓪$DragBox (ObjectSpaceWithAttrs (desk, obj), deskSize, newPos);
  1653. ⓪$WITH newPos DO
  1654. ⓪&x := x + INTEGER (charWidth) DIV 2; x := x - x MOD INTEGER (charWidth);
  1655. ⓪&y := y + INTEGER (charHeight) DIV 2; y := y - y MOD INTEGER (charHeight);
  1656. ⓪$END;
  1657. ⓪$SetObjSpace (obj, TransRect (ObjectSpace (obj), newPos) );
  1658. ⓪$
  1659. ⓪$hideObj (obj, FALSE);
  1660. ⓪$redrawDeskObj (obj);
  1661. ⓪$
  1662. ⓪$AESUpdateWindow (FALSE);
  1663. ⓪"END moveDeskPart;
  1664. ⓪ 
  1665. ⓪ (*  setCurrTextAndCode -- Set the current file.
  1666. ⓪!*)
  1667. ⓪ 
  1668. ⓪ PROCEDURE setCurrTextAndCode (REF str: ARRAY OF CHAR);
  1669. ⓪ 
  1670. ⓪"VAR   name    : NameStr;
  1671. ⓪(isSrc,
  1672. ⓪(isMXX   : BOOLEAN;
  1673. ⓪"
  1674. ⓪"BEGIN
  1675. ⓪$SplitPath (str, void128, name);
  1676. ⓪$
  1677. ⓪$IF name[0]='' THEN
  1678. ⓪&lastFn := '';
  1679. ⓪&TextName := '';
  1680. ⓪&CodeName := '';
  1681. ⓪$ELSE
  1682. ⓪$
  1683. ⓪&isSrc := IsSourceName (str);
  1684. ⓪&isMXX := (IsMBTFile (name) OR isMSPFile (name) OR isMakeFile (name));
  1685. ⓪&IF isSrc OR isMXX THEN
  1686. ⓪(Assign (str, TextName, voidO);
  1687. ⓪(Assign (str, lastFn, voidO);
  1688. ⓪&END;
  1689. ⓪(
  1690. ⓪&IF ~ isSrc OR isMXX THEN Assign (str, CodeName, voidO) END;
  1691. ⓪&
  1692. ⓪¬OKAlert (pathToLongAlt);
  1693. ⓪$END;
  1694. ⓪"END setCurrTextAndCode;
  1695. ⓪ 
  1696. ⓪ (*  redrawWorkfile -- Sets the 'WorkField'-values to the objects and
  1697. ⓪!*                    draws the object.
  1698. ⓪!*)
  1699. ⓪ 
  1700. ⓪ PROCEDURE redrawWorkfile (i: CARDINAL);
  1701. ⓪ 
  1702. ⓪"VAR   name: NameStr;
  1703. ⓪ 
  1704. ⓪"BEGIN
  1705. ⓪$WITH WorkField.elems[i] DO
  1706. ⓪&SplitPath (sourceName, void128, name);
  1707. ⓪&SetTextString (desk, nameIdx, name);
  1708. ⓪&SetObjStateElem (desk, identIdx, selectObj,
  1709. ⓪7WorkField.current = INTEGER (i));
  1710. ⓪&hideObj (carrierIdx, ~ used);
  1711. ⓪&redrawDeskObj (carrierIdx);
  1712. ⓪$END;
  1713. ⓪"END redrawWorkfile;
  1714. ⓪"
  1715. ⓪ (*  searchDrive -- Ist das Objekt 'obj' ein Drive-Icon, so liefert 'drive'
  1716. ⓪!*                 die LW-Kennung und 'valid = TRUE'.
  1717. ⓪!*                 Sonst 'valid = FALSE'.
  1718. ⓪!*)
  1719. ⓪ 
  1720. ⓪ PROCEDURE searchDrive (obj: CARDINAL; VAR drive: Drive; VAR valid: BOOLEAN);
  1721. ⓪"
  1722. ⓪"BEGIN
  1723. ⓪$drive := minDrv;
  1724. ⓪$LOOP
  1725. ⓪&IF drives[drive].available AND (obj = drives[drive].treeIndex)
  1726. ⓪&THEN valid := TRUE; EXIT
  1727. ⓪&ELSIF drive = maxDrv THEN valid := FALSE; EXIT
  1728. ⓪&ELSE INC (drive) END;
  1729. ⓪$END;
  1730. ⓪"END searchDrive;
  1731. ⓪ 
  1732. ⓪ (*  searchWorkfile -- If 'obj' is an element of a workfile object, the
  1733. ⓪!*                    return the workfile index in 'workfileIdx' and
  1734. ⓪!*                    'valid = TRUE'.
  1735. ⓪!*)
  1736. ⓪ 
  1737. ⓪ PROCEDURE searchWorkfile (    obj        : CARDINAL;
  1738. ⓪:VAR workfileIdx: CARDINAL;
  1739. ⓪:VAR valid      : BOOLEAN);
  1740. ⓪ 
  1741. ⓪"BEGIN
  1742. ⓪$workfileIdx := 0; valid := FALSE;
  1743. ⓪$WHILE (workfileIdx < maxWorkFiles) AND ~ valid DO
  1744. ⓪$
  1745. ⓪&WITH WorkField.elems[workfileIdx] DO
  1746. ⓪(valid := ((obj = carrierIdx) OR (obj = identIdx) OR (obj = nameIdx))
  1747. ⓪&END;
  1748. ⓪&
  1749. ⓪&INC (workfileIdx);
  1750. ⓪&
  1751. ⓪$END;
  1752. ⓪$DEC (workfileIdx);
  1753. ⓪"END searchWorkfile;
  1754. ⓪"
  1755. ⓪ PROCEDURE SetGetDeskPositions (f: File; mode: SetGetMode);
  1756. ⓪ 
  1757. ⓪"VAR success: BOOLEAN;
  1758. ⓪ 
  1759. ⓪"PROCEDURE setGetOnePos (obj: CARDINAL);
  1760. ⓪"
  1761. ⓪$VAR loc     : Point;
  1762. ⓪"
  1763. ⓪$BEGIN
  1764. ⓪&IF ~ success THEN RETURN END;
  1765. ⓪&
  1766. ⓪&IF mode = setValue THEN
  1767. ⓪&
  1768. ⓪(ReadBlock (f, loc);
  1769. ⓪(IF State (f) < fOK THEN success := FALSE; RETURN END;
  1770. ⓪(WITH loc DO
  1771. ⓪*x := x * INTEGER (charWidth); y := y * INTEGER (charWidth);
  1772. ⓪(END;
  1773. ⓪(SetObjSpace (obj, TransRect (ObjectSpace (obj), loc));
  1774. ⓪(ensureVisibility (obj);  (*  Icon should be within 'deskSize'  *)
  1775. ⓪(
  1776. ⓪&ELSE
  1777. ⓪(
  1778. ⓪(loc := MinPoint (ObjectSpace (obj));
  1779. ⓪(WITH loc DO
  1780. ⓪*x := x DIV INTEGER (charWidth); y := y DIV INTEGER (charWidth);
  1781. ⓪(END;
  1782. ⓪(WriteBlock (f, loc);
  1783. ⓪(IF State (f) < fOK THEN success := FALSE END;
  1784. ⓪(
  1785. ⓪&END;
  1786. ⓪$END setGetOnePos;
  1787. ⓪$
  1788. ⓪"VAR   d: Drive;
  1789. ⓪$
  1790. ⓪"BEGIN
  1791. ⓪$success := TRUE;
  1792. ⓪$
  1793. ⓪$SetCurrObjTree (desk, FALSE);
  1794. ⓪$FOR d := minDrv TO maxDrv DO setGetOnePos (drives[d].treeIndex) END;
  1795. ⓪$setGetOnePos (Trash);
  1796. ⓪$setGetOnePos (Edit); setGetOnePos (Compile);
  1797. ⓪$setGetOnePos (Execute); setGetOnePos (Link);
  1798. ⓪$setGetOnePos (Resident); setGetOnePos (Scan);
  1799. ⓪$setGetOnePos (Currfile);
  1800. ⓪$setGetOnePos (Work0); setGetOnePos (Work1);
  1801. ⓪$setGetOnePos (Work2); setGetOnePos (Work3);
  1802. ⓪$setGetOnePos (Work4); setGetOnePos (Work5);
  1803. ⓪$setGetOnePos (Work6); setGetOnePos (Work7);
  1804. ⓪$setGetOnePos (Work8); setGetOnePos (Work9);
  1805. ⓪"END SetGetDeskPositions;
  1806. ⓪ 
  1807. ⓪ (*  setWorkfileName -- Assigns the specified workfile a new name.
  1808. ⓪!*)
  1809. ⓪ 
  1810. ⓪ PROCEDURE setWorkfileName (idx: CARDINAL; VAR name: ARRAY OF CHAR);
  1811. ⓪ 
  1812. ⓪"BEGIN
  1813. ⓪$Upper (name);
  1814. ⓪$WITH WorkField.elems[idx]
  1815. ⓪$DO
  1816. ⓪&Assign (name, sourceName, voidO);
  1817. ⓪&codeName := '';
  1818. ⓪$END;
  1819. ⓪$
  1820. ⓪$redrawWorkfile (idx);
  1821. ⓪"END setWorkfileName;
  1822. ⓪"
  1823. ⓪ 
  1824. ⓪8(*  menu proc.s  *)
  1825. ⓪8(*  ===========  *)
  1826. ⓪ 
  1827. ⓪ (*  setTools -- Verändert den Menubaum so, daß nur noch die in 'ToolField'
  1828. ⓪!*              vorhandenen Menu-Tool-Einträge sichtbar sind.
  1829. ⓪!*)
  1830. ⓪ 
  1831. ⓪ PROCEDURE setTools;
  1832. ⓪ 
  1833. ⓪"CONST   toolNameLen = 12;
  1834. ⓪ 
  1835. ⓪"VAR   f1, f2    : Rectangle;
  1836. ⓪(h         : INTEGER;
  1837. ⓪(i         : CARDINAL;
  1838. ⓪(str, str2 : FileStr;
  1839. ⓪"
  1840. ⓪"BEGIN
  1841. ⓪"
  1842. ⓪$SetCurrObjTree (menu, FALSE);
  1843. ⓪$h := 0;
  1844. ⓪$FOR i := 1 TO MaxTool DO
  1845. ⓪&WITH ToolField[i]
  1846. ⓪&DO
  1847. ⓪(IF used THEN
  1848. ⓪(
  1849. ⓪*GetTextString (menu, index, str);
  1850. ⓪*SplitPath (name, void128, str2);
  1851. ⓪*Append (Space (toolNameLen - Length (str2)), str2, voidO);
  1852. ⓪*Delete (str, 2, toolNameLen, voidO);
  1853. ⓪*Insert (str2, 2, str, voidO);
  1854. ⓪*MenuText (menu, index, str);
  1855. ⓪*f1 := ObjectSpace (index);
  1856. ⓪*h := h + f1.h
  1857. ⓪*
  1858. ⓪(END;
  1859. ⓪(hideObj (index, NOT used);
  1860. ⓪&END
  1861. ⓪$END;
  1862. ⓪$IF h = 0
  1863. ⓪$THEN
  1864. ⓪&IF NOT ObjectFlag (menu, Mtools, hideTreeFlg)
  1865. ⓪&THEN
  1866. ⓪(hideObj (Mtools, TRUE);
  1867. ⓪(f1 := ObjectSpace (Mibox);
  1868. ⓪(f2 := ObjectSpace (Mtools);
  1869. ⓪(DEC (f1.w, f2.w);
  1870. ⓪(SetObjSpace (Mibox, f1);
  1871. ⓪&END;
  1872. ⓪$ELSE
  1873. ⓪&IF ObjectFlag (menu, Mtools, hideTreeFlg) THEN
  1874. ⓪(hideObj (Mtools, FALSE);
  1875. ⓪(f1 := ObjectSpace (Mibox);
  1876. ⓪(f2 := ObjectSpace (Mtools);
  1877. ⓪(INC (f1.w, f2.w);
  1878. ⓪(SetObjSpace (Mibox, f1);
  1879. ⓪&END;
  1880. ⓪&f1 := ObjectSpace (Tibox);
  1881. ⓪&f1.h := h;
  1882. ⓪&SetObjSpace (Tibox, f1);
  1883. ⓪$END;
  1884. ⓪$
  1885. ⓪"END setTools;
  1886. ⓪ 
  1887. ⓪ PROCEDURE animateMenuTitle (title: CARDINAL; VAR space: Rectangle);
  1888. ⓪ 
  1889. ⓪"BEGIN
  1890. ⓪$NormalTitle (menu, title, FALSE);
  1891. ⓪$space := AbsObjectSpace (menu, title);
  1892. ⓪"END animateMenuTitle;
  1893. ⓪ 
  1894. ⓪ PROCEDURE deAnimateMenuTitle (title: CARDINAL);
  1895. ⓪ 
  1896. ⓪"BEGIN
  1897. ⓪$NormalTitle (menu, title, TRUE);
  1898. ⓪"END deAnimateMenuTitle;
  1899. ⓪"
  1900. ⓪ 
  1901. ⓪0(*  Routinen für das Dialogbox-Managment  *)
  1902. ⓪0(*  ====================================  *)
  1903. ⓪ 
  1904. ⓪((*  misc. box primitives  *)
  1905. ⓪ 
  1906. ⓪ TYPE    arrayOfTwoCards = ARRAY[1..2] OF CARDINAL;
  1907. ⓪ 
  1908. ⓪ PROCEDURE twoCardsInArray (c1, c2: CARDINAL): arrayOfTwoCards;
  1909. ⓪ 
  1910. ⓪"VAR   res: arrayOfTwoCards;
  1911. ⓪"
  1912. ⓪"BEGIN
  1913. ⓪$res[1] := c1;
  1914. ⓪$res[2] := c2;
  1915. ⓪$RETURN res
  1916. ⓪"END twoCardsInArray;
  1917. ⓪"
  1918. ⓪ TYPE    arrayOfTwoEnumRefs      = ARRAY[1..2] OF ObjEnumRef;
  1919. ⓪ 
  1920. ⓪ PROCEDURE twoEnumsInRefArray (obj1      : CARDINAL;
  1921. ⓪>enumValue1: WORD;
  1922. ⓪>obj2      : CARDINAL;
  1923. ⓪>enumValue2: WORD): arrayOfTwoEnumRefs;
  1924. ⓪ 
  1925. ⓪"VAR   refs: arrayOfTwoEnumRefs;
  1926. ⓪(i   : CARDINAL;
  1927. ⓪(
  1928. ⓪"BEGIN
  1929. ⓪$refs[1].obj := obj1;
  1930. ⓪$refs[1].value := enumValue1;
  1931. ⓪$refs[2].obj := obj2;
  1932. ⓪$refs[2].value := enumValue2;
  1933. ⓪$
  1934. ⓪$RETURN refs
  1935. ⓪"END twoEnumsInRefArray;
  1936. ⓪ 
  1937. ⓪ 
  1938. ⓪((*  box handlers  *)
  1939. ⓪"
  1940. ⓪ PROCEDURE doCompilerOptionBox;
  1941. ⓪ 
  1942. ⓪"PROCEDURE setGetCompOpts (mode: SetGetMode);
  1943. ⓪"
  1944. ⓪$VAR notProtocol,
  1945. ⓪(found      : BOOLEAN;
  1946. ⓪(fname      : FileStr;
  1947. ⓪"
  1948. ⓪$BEGIN
  1949. ⓪&WITH CompilerParm DO
  1950. ⓪(SetGetBoxStr (optBox, Oname, mode, name);
  1951. ⓪(Upper (name);
  1952. ⓪(SetGetBoxState (optBox, Oquite, mode, checkObj, shortMsgs);
  1953. ⓪(SetGetBoxState (optBox, Opmark, mode, checkObj, protocol);
  1954. ⓪(IF mode = setValue THEN
  1955. ⓪*notProtocol := ~ protocol;
  1956. ⓪*SetGetBoxState (optBox, Oppath, setValue, disableObj, notProtocol);
  1957. ⓪*SetGetBoxState (optBox, Opwidth, setValue, disableObj, notProtocol);
  1958. ⓪(END;
  1959. ⓪(SetGetBoxStr (optBox, Oargs, mode, CompilerArgs);
  1960. ⓪(SetGetBoxStr (optBox, Oppath, mode, protName);
  1961. ⓪(SetGetBoxCard (optBox, Opwidth, mode, protWidth);
  1962. ⓪(IF protWidth < 10 THEN protWidth := stdProtWidth END;
  1963. ⓪(
  1964. ⓪(SetGetBoxStr (optBox, Ooutput, mode, MainOutputPath);
  1965. ⓪(ValidatePath (MainOutputPath);
  1966. ⓪(SetGetBoxStr (optBox, Olibrary, mode, DefLibName);
  1967. ⓪(IF mode = getValue THEN
  1968. ⓪*Upper (DefLibName);
  1969. ⓪*IF Length (FilePath (DefLibName)) = 0 THEN
  1970. ⓪,SearchFile (DefLibName, DefPaths, fromStart, found, DefLibName);
  1971. ⓪*END
  1972. ⓪(END;
  1973. ⓪(SetGetBoxStr (optBox, Oerror, mode, ErrListFile);
  1974. ⓪(Upper (ErrListFile);
  1975. ⓪&END;
  1976. ⓪$END setGetCompOpts;
  1977. ⓪$
  1978. ⓪ 
  1979. ⓪"VAR   space, start    : Rectangle;
  1980. ⓪(exit            : CARDINAL;
  1981. ⓪"
  1982. ⓪"BEGIN
  1983. ⓪$AESUpdateWindow (TRUE);
  1984. ⓪$animateMenuTitle (Mparms, start);
  1985. ⓪$
  1986. ⓪$setGetCompOpts (setValue);
  1987. ⓪$PrepareBox (optBox, start, space);
  1988. ⓪$
  1989. ⓪$LOOP
  1990. ⓪&formDo (optBox, Ooutput, exit);
  1991. ⓪&
  1992. ⓪&CASE exit OF
  1993. ⓪(Ook, Oquit: DeselectButton (optBox, exit); EXIT|
  1994. ⓪(Oquite    : ToggleCheckBox (optBox, Oquite)|
  1995. ⓪(Opmark    : ToggleCheckPlus (optBox, Opmark,
  1996. ⓪EtwoCardsInArray (Oppath, Opwidth))|
  1997. ⓪&ELSE
  1998. ⓪&END;
  1999. ⓪$END;
  2000. ⓪$
  2001. ⓪$IF exit = Ook THEN setGetCompOpts (getValue) END;
  2002. ⓪$
  2003. ⓪$ReleaseBox(optBox, start, space);
  2004. ⓪$deAnimateMenuTitle (Mparms);
  2005. ⓪$AESUpdateWindow (FALSE);
  2006. ⓪"END doCompilerOptionBox;
  2007. ⓪ 
  2008. ⓪ PROCEDURE doLinkerOptionBox;
  2009. ⓪ 
  2010. ⓪"PROCEDURE setGetLinkOpts (mode: SetGetMode);
  2011. ⓪ 
  2012. ⓪$VAR i       : CARDINAL;
  2013. ⓪(valid,
  2014. ⓪(notValid: BOOLEAN;
  2015. ⓪(refs    : ARRAY [1..4] OF ObjEnumRef;
  2016. ⓪$
  2017. ⓪$BEGIN
  2018. ⓪&SetGetBoxStr (linkBox, Loname, mode, LinkerParm.name);
  2019. ⓪&Upper (LinkerParm.name);
  2020. ⓪&FOR i:= 1 TO 8 DO
  2021. ⓪(WITH linkBoxIdx[i] DO
  2022. ⓪*SetGetBoxState (linkBox, check, mode, checkObj, LinkerParm.linkList[i].valid);
  2023. ⓪*IF mode = setValue THEN
  2024. ⓪,notValid := ~ LinkerParm.linkList[i].valid;
  2025. ⓪,SetGetBoxState (linkBox, path, setValue, disableObj, notValid);
  2026. ⓪*END;
  2027. ⓪*SetGetBoxStr (linkBox, path, mode, LinkerParm.linkList[i].name);
  2028. ⓪(END
  2029. ⓪&END;
  2030. ⓪&valid := (LinkerParm.linkStackSize # 0L); notValid := ~ valid;
  2031. ⓪&SetGetBoxState (linkBox, Lochecks, mode, checkObj, valid);
  2032. ⓪&IF mode = setValue THEN
  2033. ⓪(SetGetBoxState (linkBox, Lostack, setValue, disableObj, notValid);
  2034. ⓪&END;
  2035. ⓪&SetGetBoxLCard (linkBox, Lostack, mode, LinkerParm.linkStackSize);
  2036. ⓪&IF ~ valid THEN LinkerParm.linkStackSize := 0L END;
  2037. ⓪&SetGetBoxCard (linkBox, Lomaxmod, mode, LinkerParm.maxLinkMod);
  2038. ⓪&
  2039. ⓪&SetGetBoxState (linkBox, Lofastld, mode, checkObj, LinkerParm.fastLoad);
  2040. ⓪&SetGetBoxState (linkBox, Lofastco, mode, checkObj, LinkerParm.fastCode);
  2041. ⓪&SetGetBoxState (linkBox, Lofastme, mode, checkObj, LinkerParm.fastMemory);
  2042. ⓪&
  2043. ⓪&SetGetBoxState (linkBox, Losymfil, mode, checkObj, LinkerParm.symbolFile);
  2044. ⓪&
  2045. ⓪&refs[1].obj := Lonoopt;
  2046. ⓪&refs[1].value := WORD (noOptimize);
  2047. ⓪&refs[2].obj := Lonamopt;
  2048. ⓪&refs[2].value := WORD (nameOptimize);
  2049. ⓪&refs[3].obj := Lomiddle;
  2050. ⓪&refs[3].value := WORD (partOptimize);
  2051. ⓪&refs[4].obj := Lofull;
  2052. ⓪&refs[4].value := WORD (fullOptimize);
  2053. ⓪&i := ORD (LinkerParm.optimize);
  2054. ⓪&SetGetBoxEnum (linkBox, refs, mode, i);
  2055. ⓪&LinkerParm.optimize := VAL (LinkMode, i);
  2056. ⓪$END setGetLinkOpts;
  2057. ⓪$
  2058. ⓪ 
  2059. ⓪"VAR   space, start    : Rectangle;
  2060. ⓪(exit, i         : CARDINAL;
  2061. ⓪"
  2062. ⓪"BEGIN
  2063. ⓪$AESUpdateWindow (TRUE);
  2064. ⓪$animateMenuTitle (Mparms, start);
  2065. ⓪$
  2066. ⓪$setGetLinkOpts (setValue);
  2067. ⓪$PrepareBox (linkBox, start, space);
  2068. ⓪$
  2069. ⓪$LOOP
  2070. ⓪&formDo (linkBox, Root, exit);
  2071. ⓪&
  2072. ⓪&IF (exit = Look) OR (exit = Loquit) THEN
  2073. ⓪(DeselectButton (linkBox, exit); EXIT
  2074. ⓪&ELSIF exit = Lochecks THEN
  2075. ⓪(ToggleCheckPlus (linkBox, Lochecks, Lostack)
  2076. ⓪&ELSIF (exit = Lofastld) OR (exit = Lofastco) OR (exit = Lofastme)
  2077. ⓪&OR (exit = Losymfil) THEN
  2078. ⓪(ToggleCheckBox (linkBox, exit)
  2079. ⓪&ELSE
  2080. ⓪(FOR i := 1 TO 8 DO
  2081. ⓪*IF linkBoxIdx[i].check = exit THEN
  2082. ⓪,ToggleCheckPlus (linkBox, exit, linkBoxIdx[i].path)
  2083. ⓪*END
  2084. ⓪(END;
  2085. ⓪&END;
  2086. ⓪$END;
  2087. ⓪$
  2088. ⓪$IF exit = Look THEN setGetLinkOpts (getValue) END;
  2089. ⓪"
  2090. ⓪$ReleaseBox(linkBox, start,space);
  2091. ⓪$deAnimateMenuTitle (Mparms);
  2092. ⓪$AESUpdateWindow (FALSE);
  2093. ⓪"END doLinkerOptionBox;
  2094. ⓪"
  2095. ⓪ PROCEDURE doScanBox (): BOOLEAN;
  2096. ⓪ 
  2097. ⓪"VAR     but : CARDINAL;
  2098. ⓪"
  2099. ⓪"BEGIN
  2100. ⓪$ScanAddr := 0L;
  2101. ⓪$SetTextString (scanBox, Saddr, '');
  2102. ⓪$DoSimpleBox (scanBox, deskObjSpace (Scan), but);
  2103. ⓪$IF but = Sok THEN SetGetBoxLCard (scanBox, Saddr, getValue, ScanAddr) END;
  2104. ⓪$RETURN ScanAddr # 0L
  2105. ⓪"END doScanBox;
  2106. ⓪ 
  2107. ⓪ (*  doFileBox -- Inquires a file name from the user, that becomes the new
  2108. ⓪!*               work file number 'idx', if 'idx # noCurrentWorkfile',
  2109. ⓪!*               else the new current file.
  2110. ⓪!*)
  2111. ⓪ 
  2112. ⓪ PROCEDURE doFileBox (idx: INTEGER);
  2113. ⓪ 
  2114. ⓪"VAR     str   : FileStr;
  2115. ⓪*but   : CARDINAL;
  2116. ⓪*space : Rectangle;
  2117. ⓪"
  2118. ⓪"BEGIN
  2119. ⓪$AESUpdateWindow (TRUE);
  2120. ⓪$SetCurrObjTree (fileBox, FALSE);
  2121. ⓪$IF idx = noCurrentWorkfile THEN
  2122. ⓪&hideObj (Cfcurr, FALSE);
  2123. ⓪&hideObj (Cfwork, TRUE);
  2124. ⓪&space := deskObjSpace (Cfname);
  2125. ⓪$ELSE
  2126. ⓪&str := WorkField.elems[idx].sourceName;
  2127. ⓪&IF Length (str) > fileBoxLength THEN str := '' END;
  2128. ⓪&SetTextString (fileBox, Cfedit, str);
  2129. ⓪&hideObj (Cfcurr, TRUE);
  2130. ⓪&hideObj (Cfwork, FALSE);
  2131. ⓪&space := deskObjSpace (WorkField.elems[idx].carrierIdx);
  2132. ⓪$END;
  2133. ⓪"
  2134. ⓪$DoSimpleBox (fileBox, space, but);
  2135. ⓪$
  2136. ⓪$IF but = Cfbok THEN
  2137. ⓪&GetTextString (fileBox, Cfedit, str); Upper (str);
  2138. ⓪&SearchFile (str, SrcPaths, fromStart, voidO, str);
  2139. ⓪&IF idx = noCurrentWorkfile THEN setCurrTextAndCode (str)
  2140. ⓪&ELSE setWorkfileName (idx, str) END;
  2141. ⓪$END;
  2142. ⓪$IF idx # noCurrentWorkfile THEN SetTextString (fileBox, Cfedit, '') END;
  2143. ⓪$AESUpdateWindow (FALSE);
  2144. ⓪"END doFileBox;
  2145. ⓪ 
  2146. ⓪ TYPE    fNameBoxMode    = (requestFolderName, nameConflict);
  2147. ⓪ 
  2148. ⓪ PROCEDURE doFNameBox (    mode: fNameBoxMode;
  2149. ⓪6VAR name: ARRAY OF CHAR;
  2150. ⓪6VAR ok  : BOOLEAN);
  2151. ⓪ 
  2152. ⓪"VAR   but     : CARDINAL;
  2153. ⓪(start   : Rectangle;
  2154. ⓪(folder  : BOOLEAN;
  2155. ⓪ 
  2156. ⓪"BEGIN
  2157. ⓪$folder := (mode = requestFolderName);
  2158. ⓪$IF folder THEN animateMenuTitle (Mdatei, start) ELSE start.w := -1 END;
  2159. ⓪$
  2160. ⓪$SetCurrObjTree (fNameBox, FALSE);
  2161. ⓪$hideObj (Fdfolder, NOT folder); hideObj (Fdconf, folder);
  2162. ⓪$
  2163. ⓪$SetTextString (fNameBox, Fdname, killPoint (name));
  2164. ⓪$DoSimpleBox (fNameBox, start, but);
  2165. ⓪$ok := (but = Fdok);
  2166. ⓪$IF ok THEN
  2167. ⓪&GetTextString (fNameBox, Fdname, name); Upper (name);
  2168. ⓪&Assign (addPoint (name), name, voidO);
  2169. ⓪$END;
  2170. ⓪$
  2171. ⓪$IF folder THEN deAnimateMenuTitle (Mdatei) END;
  2172. ⓪"END doFNameBox;
  2173. ⓪ 
  2174. ⓪ (*$Z-*)
  2175. ⓪ PROCEDURE doConflictBox (VAR name: ARRAY OF CHAR): BOOLEAN;
  2176. ⓪ (*$Z=*)
  2177. ⓪ 
  2178. ⓪"VAR   ok: BOOLEAN;
  2179. ⓪ 
  2180. ⓪"BEGIN
  2181. ⓪$doFNameBox (nameConflict, name, ok); FlushEvents; ShowBee;
  2182. ⓪$IF shellParm.confirmCopy THEN drawObject (confirmBox, Root) END;
  2183. ⓪$RETURN ok
  2184. ⓪"END doConflictBox;
  2185. ⓪ 
  2186. ⓪ PROCEDURE doShellParameterBox;
  2187. ⓪ 
  2188. ⓪"PROCEDURE setGetShellParm (mode: SetGetMode);
  2189. ⓪"
  2190. ⓪$BEGIN
  2191. ⓪&WITH shellParm DO
  2192. ⓪(SetGetBoxEnum (shellParmBox,
  2193. ⓪7twoEnumsInRefArray (Sproot, FALSE, Spcurr, TRUE),
  2194. ⓪7mode, defaultOpenCurrDir);
  2195. ⓪(SetGetBoxState (shellParmBox, Spcopy, mode, checkObj, confirmCopy);
  2196. ⓪(SetGetBoxState (shellParmBox, Spdelete, mode, checkObj, confirmDelete);
  2197. ⓪(SetGetBoxState (shellParmBox, Spbreak, mode, checkObj, breakActive);
  2198. ⓪(SetGetBoxState (shellParmBox, Spallmem, mode, checkObj,
  2199. ⓪8useAllMemForCopy);
  2200. ⓪(SetGetBoxStr (shellParmBox, Spbaname, mode, batchPath);
  2201. ⓪(Upper (batchPath);
  2202. ⓪(SetGetBoxStr (shellParmBox, Sppaname, mode, parameterPath);
  2203. ⓪(Upper (parameterPath);
  2204. ⓪(SetGetBoxStr (shellParmBox, Spscpath, mode, TemporaryPath);
  2205. ⓪(ValidatePath (TemporaryPath);
  2206. ⓪(IF TemporaryPath[0] # HomeSymbol THEN
  2207. ⓪*MakeFullPath (TemporaryPath, voidI);
  2208. ⓪(END;
  2209. ⓪(SetGetBoxStr (shellParmBox, Spmake, mode, makeName);
  2210. ⓪(SetGetBoxStr (shellParmBox, Spfontn, mode, fontSetting.name);
  2211. ⓪(SetGetBoxCard (shellParmBox, Spfonts, mode, fontSetting.size);
  2212. ⓪(Upper (makeName);
  2213. ⓪&END;
  2214. ⓪$END setGetShellParm;
  2215. ⓪$
  2216. ⓪"VAR   space, start    : Rectangle;
  2217. ⓪(exit            : CARDINAL;
  2218. ⓪"
  2219. ⓪"BEGIN
  2220. ⓪$animateMenuTitle (Mparms, start);
  2221. ⓪$
  2222. ⓪$setGetShellParm (setValue);
  2223. ⓪$PrepareBox (shellParmBox, start, space);
  2224. ⓪$
  2225. ⓪$LOOP
  2226. ⓪&formDo (shellParmBox, Root, exit);
  2227. ⓪&
  2228. ⓪&CASE exit OF
  2229. ⓪(Spok, Spquit: DeselectButton (shellParmBox, exit); EXIT|
  2230. ⓪(
  2231. ⓪(Spcopy,
  2232. ⓪(Spdelete,
  2233. ⓪(Spbreak,
  2234. ⓪(Spallmem    : ToggleCheckBox (shellParmBox, exit)|
  2235. ⓪&ELSE
  2236. ⓪&END;
  2237. ⓪$END;
  2238. ⓪$
  2239. ⓪$IF exit = Spok THEN
  2240. ⓪&setGetShellParm (getValue);
  2241. ⓪&SetFonts;
  2242. ⓪$END;
  2243. ⓪$
  2244. ⓪$ReleaseBox(shellParmBox, start, space);
  2245. ⓪$deAnimateMenuTitle (Mparms);
  2246. ⓪"END doShellParameterBox;
  2247. ⓪ 
  2248. ⓪ PROCEDURE doEditorParameterBox;
  2249. ⓪ 
  2250. ⓪"PROCEDURE setGetEditorParm (mode: SetGetMode);
  2251. ⓪"
  2252. ⓪$VAR disable: BOOLEAN;
  2253. ⓪"
  2254. ⓪$BEGIN
  2255. ⓪&WITH EditorParm DO
  2256. ⓪(SetGetBoxStr (editorParmBox, Epname, mode, name);
  2257. ⓪(Upper (name);
  2258. ⓪(SetGetBoxState (editorParmBox, Epsearch, mode,
  2259. ⓪8checkObj, searchSources);
  2260. ⓪(SetGetBoxState (editorParmBox, Epstoper, mode,
  2261. ⓪8checkObj, waitOnError);
  2262. ⓪(SetGetBoxState (editorParmBox, Epshtemp, mode,
  2263. ⓪8checkObj, tempShellFile);
  2264. ⓪(disable := ~ tempShellFile;
  2265. ⓪(SetGetBoxState (editorParmBox, Epshname, mode, disableObj, disable);
  2266. ⓪(SetGetBoxStr (editorParmBox, Epshname, mode, tempShellName);
  2267. ⓪(
  2268. ⓪(SetGetBoxState (editorParmBox, Epedtemp, mode,
  2269. ⓪8checkObj, tempEditorFile);
  2270. ⓪(disable := ~ tempEditorFile;
  2271. ⓪(SetGetBoxState (editorParmBox, Epedname, mode, disableObj, disable);
  2272. ⓪(SetGetBoxStr (editorParmBox, Epedname, mode, tempEditorName);
  2273. ⓪ 
  2274. ⓪(SetGetBoxState (editorParmBox, Eparg, mode,
  2275. ⓪8checkObj, passArgument);
  2276. ⓪(SetGetBoxState (editorParmBox, Eparname, mode,
  2277. ⓪8checkObj, passName);
  2278. ⓪(SetGetBoxState (editorParmBox, Eparerro, mode,
  2279. ⓪8checkObj, passErrorText);
  2280. ⓪(SetGetBoxState (editorParmBox, Eparpos, mode,
  2281. ⓪8checkObj, passErrorPos);
  2282. ⓪&END;
  2283. ⓪$END setGetEditorParm;
  2284. ⓪$
  2285. ⓪"VAR   start, space: Rectangle;
  2286. ⓪(exit        : CARDINAL;
  2287. ⓪ 
  2288. ⓪"BEGIN
  2289. ⓪$animateMenuTitle (Mparms, start);
  2290. ⓪$
  2291. ⓪$setGetEditorParm (setValue);
  2292. ⓪$PrepareBox (editorParmBox, start, space);
  2293. ⓪$
  2294. ⓪$LOOP
  2295. ⓪&formDo (editorParmBox, Root, exit);
  2296. ⓪&
  2297. ⓪&CASE exit OF
  2298. ⓪(Epok, Epquit: DeselectButton (editorParmBox, exit); EXIT|
  2299. ⓪(
  2300. ⓪(Epsearch,
  2301. ⓪(Epstoper,
  2302. ⓪(Eparg,
  2303. ⓪(Eparname,
  2304. ⓪(Eparerro,
  2305. ⓪(Eparpos     : ToggleCheckBox (editorParmBox, exit)|
  2306. ⓪(Epshtemp    : ToggleCheckPlus (editorParmBox, Epshtemp, Epshname)|
  2307. ⓪(Epedtemp    : ToggleCheckPlus (editorParmBox, Epedtemp, Epedname)|
  2308. ⓪&ELSE
  2309. ⓪&END;
  2310. ⓪$END;
  2311. ⓪$
  2312. ⓪$IF exit = Epok THEN setGetEditorParm (getValue) END;
  2313. ⓪"
  2314. ⓪$ReleaseBox(editorParmBox, start, space);
  2315. ⓪$deAnimateMenuTitle (Mparms);
  2316. ⓪"END doEditorParameterBox;
  2317. ⓪"
  2318. ⓪ PROCEDURE showFormatStatus (tracks: CARDINAL; VAR stop: BOOLEAN);
  2319. ⓪ 
  2320. ⓪"VAR   ch   : GemChar;
  2321. ⓪(valid: BOOLEAN;
  2322. ⓪ 
  2323. ⓪"BEGIN
  2324. ⓪$SetGetBoxCard (formatBox, Foremain, setValue, tracks);
  2325. ⓪$drawObject (formatBox, Foremain);
  2326. ⓪$
  2327. ⓪$busyReadGemChar (ch, valid);
  2328. ⓪$stop := valid AND (ch.scan = undoKey);
  2329. ⓪"END showFormatStatus;
  2330. ⓪"
  2331. ⓪ PROCEDURE doFormatBox;
  2332. ⓪ 
  2333. ⓪"PROCEDURE setGetFormat (mode: SetGetMode; VAR volName: NameStr);
  2334. ⓪"
  2335. ⓪$BEGIN
  2336. ⓪&SetGetBoxEnum (formatBox,
  2337. ⓪5twoEnumsInRefArray (Fosingle, 1, Fodouble, 2),
  2338. ⓪5mode, shellParm.sides);
  2339. ⓪&SetGetBoxEnum (formatBox,
  2340. ⓪5twoEnumsInRefArray (Fo80, 80, Fo81, 81),
  2341. ⓪5mode, shellParm.tracks);
  2342. ⓪&SetGetBoxEnum (formatBox,
  2343. ⓪5twoEnumsInRefArray (Fo9, 9, Fo10, 10),
  2344. ⓪5mode, shellParm.sectors);
  2345. ⓪&IF mode = setValue THEN volName := '' END;
  2346. ⓪&SetGetBoxStr (formatBox, Foname, mode, volName);
  2347. ⓪&volName := killPoint (volName);
  2348. ⓪$END setGetFormat;
  2349. ⓪$
  2350. ⓪"VAR   start,
  2351. ⓪(space    : Rectangle;
  2352. ⓪(volName  : NameStr;
  2353. ⓪(exit     : CARDINAL;
  2354. ⓪(drive    : FormatDrive;
  2355. ⓪(result   : FormatResult;
  2356. ⓪(driveName: CHAR;
  2357. ⓪ 
  2358. ⓪"BEGIN
  2359. ⓪$AESUpdateWindow (TRUE);
  2360. ⓪$animateMenuTitle (Mdatei, start);
  2361. ⓪$setGetFormat (setValue, volName);
  2362. ⓪$hideObj (Foremain, TRUE);
  2363. ⓪$
  2364. ⓪$PrepareBox (formatBox, start, space);
  2365. ⓪$LOOP
  2366. ⓪&formDo (formatBox, Root, exit);
  2367. ⓪&DeselectButton (formatBox, exit);
  2368. ⓪&
  2369. ⓪&IF exit = Foquit THEN EXIT
  2370. ⓪&ELSE
  2371. ⓪(IF exit = Foa THEN drive := MOSGlobals.drvA; driveName := 'A'
  2372. ⓪(ELSE drive := MOSGlobals.drvB; driveName := 'B' END;
  2373. ⓪(
  2374. ⓪(flexAlert (2, driveName, '', formatAlt, exit);
  2375. ⓪(IF exit = 1 THEN
  2376. ⓪(
  2377. ⓪*ShowBee;
  2378. ⓪*hideObj (Foremain, FALSE);
  2379. ⓪*setGetFormat (getValue, volName);
  2380. ⓪*
  2381. ⓪*WITH shellParm DO
  2382. ⓪,FormatDisk (drive, sides, tracks, sectors, 1, volName,
  2383. ⓪8showFormatStatus, result);
  2384. ⓪*END;
  2385. ⓪*
  2386. ⓪*hideAndRedrawObj (Foremain, TRUE);
  2387. ⓪*ShowArrow;
  2388. ⓪*
  2389. ⓪*IF result # okFR THEN doAlert (formatErrAlt) END;
  2390. ⓪*
  2391. ⓪(END;
  2392. ⓪&END;
  2393. ⓪$END;
  2394. ⓪$
  2395. ⓪$ReleaseBox (formatBox, start, space);
  2396. ⓪$deAnimateMenuTitle (Mdatei);
  2397. ⓪$AESUpdateWindow (FALSE);
  2398. ⓪"END doFormatBox;
  2399. ⓪ 
  2400. ⓪ PROCEDURE doFileInfoBox (VAR entry: DirEntry);
  2401. ⓪ 
  2402. ⓪"VAR   name  : NameStr;
  2403. ⓪(isProt: BOOLEAN;
  2404. ⓪(
  2405. ⓪"PROCEDURE setGetFileInfo (mode: SetGetMode);
  2406. ⓪"
  2407. ⓪$BEGIN
  2408. ⓪&SetGetBoxStr (fileInfoBox, Finame, mode, name);
  2409. ⓪&SetGetBoxLCard (fileInfoBox, Fisize, mode, entry.size);
  2410. ⓪&SetGetBoxEnum (fileInfoBox, twoEnumsInRefArray (Firw, FALSE,
  2411. ⓪VFiprot, TRUE),
  2412. ⓪5mode, isProt);
  2413. ⓪$END setGetFileInfo;
  2414. ⓪$
  2415. ⓪"VAR   start : Rectangle;
  2416. ⓪(but   : CARDINAL;
  2417. ⓪ 
  2418. ⓪"BEGIN
  2419. ⓪$animateMenuTitle (Mdatei, start);
  2420. ⓪$
  2421. ⓪$Assign (killPoint (entry.name), name, voidO);
  2422. ⓪$isProt := (readOnlyAttr IN entry.attr);
  2423. ⓪$setGetFileInfo (setValue);
  2424. ⓪$
  2425. ⓪$DoSimpleBox (fileInfoBox, start, but);
  2426. ⓪$
  2427. ⓪$IF but = Fiok THEN
  2428. ⓪&setGetFileInfo (getValue);
  2429. ⓪&Upper (name);
  2430. ⓪&Assign (addPoint (name), entry.name, voidO);
  2431. ⓪&IF isProt THEN INCL (entry.attr, readOnlyAttr)
  2432. ⓪&ELSE EXCL (entry.attr, readOnlyAttr) END;
  2433. ⓪$END;
  2434. ⓪$deAnimateMenuTitle (Mdatei);
  2435. ⓪"END doFileInfoBox;
  2436. ⓪"
  2437. ⓪ PROCEDURE doHelpBox (REF fname: ARRAY OF CHAR);
  2438. ⓪ 
  2439. ⓪"CONST noLines = 14;   (*  Anzahl der Zeilen in der Hilfe-Box  *)
  2440. ⓪(noRows  = 65;
  2441. ⓪ 
  2442. ⓪"VAR   start, space    : Rectangle;
  2443. ⓪(but, i,
  2444. ⓪(visibleLines    : CARDINAL;
  2445. ⓪(text            : List;
  2446. ⓪(err, end, first : BOOLEAN;
  2447. ⓪(f               : File;
  2448. ⓪(str             : ptrString;
  2449. ⓪(path            : PathStr;
  2450. ⓪ 
  2451. ⓪"PROCEDURE fileErr (): BOOLEAN;
  2452. ⓪"
  2453. ⓪$VAR state: INTEGER;
  2454. ⓪$
  2455. ⓪$BEGIN
  2456. ⓪&state := State (f);
  2457. ⓪&IF (state < fOK) OR (state = fEOF)
  2458. ⓪&THEN
  2459. ⓪)ResetState (f);
  2460. ⓪)FileAlert (state);
  2461. ⓪)RETURN TRUE
  2462. ⓪&ELSE
  2463. ⓪)RETURN FALSE
  2464. ⓪&END;
  2465. ⓪$END fileErr;
  2466. ⓪$
  2467. ⓪"PROCEDURE addLine (obj: CARDINAL);
  2468. ⓪"
  2469. ⓪$BEGIN
  2470. ⓪&IF NOT end THEN
  2471. ⓪(str := NextEntry (text);
  2472. ⓪(IF str = NIL THEN end := TRUE ELSE INC (visibleLines) END;
  2473. ⓪&END;
  2474. ⓪&IF end THEN SetTextString (helpBox, obj, '')
  2475. ⓪&ELSE
  2476. ⓪(IF Length (str^) > noRows THEN
  2477. ⓪*Delete (str^, noRows, Length (str^) - noRows, voidO);
  2478. ⓪(END;
  2479. ⓪(SetTextString (helpBox, obj, str^);
  2480. ⓪&END;
  2481. ⓪$END addLine;
  2482. ⓪$
  2483. ⓪"BEGIN
  2484. ⓪$AESUpdateWindow (TRUE);
  2485. ⓪$animateMenuTitle (Minfo, start);
  2486. ⓪$
  2487. ⓪$(*  Lies Hilfe-Datei ein.
  2488. ⓪%*)
  2489. ⓪ 
  2490. ⓪$Concat (ShellPath, fname, path, voidO);
  2491. ⓪$CreateList (text, err);
  2492. ⓪$IF err THEN
  2493. ⓪&reportOutOfMemory;
  2494. ⓪&deAnimateMenuTitle (Minfo);
  2495. ⓪&AESUpdateWindow (FALSE);
  2496. ⓪&RETURN
  2497. ⓪$END;
  2498. ⓪$ShowBee;
  2499. ⓪$Open (f, path, readSeqTxt);
  2500. ⓪$IF (State (f)) # fOK
  2501. ⓪$THEN
  2502. ⓪&doAlert (noHelpAlt);
  2503. ⓪&DeleteList (text, voidO);
  2504. ⓪&deAnimateMenuTitle (Minfo);
  2505. ⓪&ShowArrow;
  2506. ⓪&AESUpdateWindow (FALSE);
  2507. ⓪&RETURN
  2508. ⓪$END;
  2509. ⓪$LOOP
  2510. ⓪$
  2511. ⓪&NEW (str);
  2512. ⓪&IF str = NIL THEN reportOutOfMemory; EXIT END;
  2513. ⓪&IF fileErr () THEN DISPOSE (str); EXIT END;
  2514. ⓪&Text.ReadString (f, str^);
  2515. ⓪&AppendEntry (text, str, err);
  2516. ⓪&IF err THEN reportOutOfMemory; DISPOSE (str); EXIT END;
  2517. ⓪&IF fileErr () THEN EXIT END;
  2518. ⓪&Text.ReadLn (f);
  2519. ⓪$
  2520. ⓪$END;
  2521. ⓪$Close (f);
  2522. ⓪$ShowArrow;
  2523. ⓪$AESUpdateWindow (FALSE);
  2524. ⓪$
  2525. ⓪$(*  Zeige Hilfe-Datei an.
  2526. ⓪%*)
  2527. ⓪%
  2528. ⓪$ResetList (text);
  2529. ⓪$but := Hpnext; visibleLines := 0; first := TRUE;
  2530. ⓪$REPEAT
  2531. ⓪$
  2532. ⓪&IF but = Hpprev THEN
  2533. ⓪(IF EndOfList (text) THEN INC (visibleLines) END;
  2534. ⓪(FOR i := 1 TO noLines + visibleLines DO voidADR := PrevEntry (text) END;
  2535. ⓪&END;
  2536. ⓪&SetObjStateElem (helpBox, Hpprev, disableObj, EndOfList (text));
  2537. ⓪&end := FALSE; visibleLines := 0;
  2538. ⓪&addLine (Hpmsg1); addLine (Hpmsg2); addLine (Hpmsg3);
  2539. ⓪&addLine (Hpmsg4); addLine (Hpmsg5); addLine (Hpmsg6);
  2540. ⓪&addLine (Hpmsg7); addLine (Hpmsg8); addLine (Hpmsg9);
  2541. ⓪&addLine (Hpmsg10); addLine (Hpmsg11); addLine (Hpmsg12);
  2542. ⓪&addLine (Hpmsg13); addLine (Hpmsg14);
  2543. ⓪&SetObjStateElem (helpBox, Hpnext, disableObj, EndOfList (text));
  2544. ⓪&SetObjFlag (helpBox, Hpnext, defaultFlg, NOT EndOfList (text));
  2545. ⓪&SetObjFlag (helpBox, Hpquit, defaultFlg, EndOfList (text));
  2546. ⓪&
  2547. ⓪&IF first THEN PrepareBox (helpBox, start, space); first := FALSE
  2548. ⓪&ELSE DrawObject (helpBox, Root, MaxDepth, space) END;
  2549. ⓪&formDo (helpBox, Root, but);
  2550. ⓪&DeselectButton (helpBox, but);
  2551. ⓪&
  2552. ⓪$UNTIL but = Hpquit;
  2553. ⓪$ReleaseBox (helpBox, start, space);
  2554. ⓪$
  2555. ⓪$(*  Lösche Hilfe-Datei.
  2556. ⓪%*)
  2557. ⓪$deleteSimpleList (text, TRUE);
  2558. ⓪$
  2559. ⓪$deAnimateMenuTitle (Minfo);
  2560. ⓪"END doHelpBox;
  2561. ⓪ 
  2562. ⓪ 
  2563. ⓪ PROCEDURE doInfoBox;
  2564. ⓪ 
  2565. ⓪ (*
  2566. ⓪!* Umgebungsinformationen
  2567. ⓪!*)
  2568. ⓪ 
  2569. ⓪"VAR   dftPath,
  2570. ⓪(codeFile        : FileStr;
  2571. ⓪(dftPathEditable : BOOLEAN;
  2572. ⓪(
  2573. ⓪"PROCEDURE setGetInfo (mode: SetGetMode);
  2574. ⓪"
  2575. ⓪$VAR lc: LONGCARD; s: ARRAY [0..13] OF CHAR;
  2576. ⓪"
  2577. ⓪$BEGIN
  2578. ⓪&SetObjFlag (infoBox, Inpath, editFlg, dftPathEditable);
  2579. ⓪&SetGetBoxStr (infoBox, Inpath, mode, dftPath);
  2580. ⓪&SetGetBoxLCard (infoBox, Instack, mode, DefaultStackSize);
  2581. ⓪&SetGetBoxStr (infoBox, Inmkfile, mode, MakeFileName);
  2582. ⓪&SetGetBoxState (infoBox, Stponrtn, mode, checkObj, shellParm.waitOnReturn);
  2583. ⓪&Upper (MakeFileName);
  2584. ⓪&IF mode = setValue THEN
  2585. ⓪(lc := MemAvail ();
  2586. ⓪(SetGetBoxLCard (infoBox, Inblock, setValue, lc);
  2587. ⓪(lc := AllAvail ();
  2588. ⓪(SetGetBoxLCard (infoBox, Inall, setValue, lc);
  2589. ⓪(SetGetBoxStr (infoBox, Ihome, setValue, HomePath);
  2590. ⓪(SetGetBoxStr (infoBox, Incode, setValue, codeFile);
  2591. ⓪(SetGetBoxLCard (infoBox, Inlength, setValue, LastCodeSize);
  2592. ⓪(IF UsedFormat = IEEEReal THEN
  2593. ⓪*IF RealMode = 2 THEN
  2594. ⓪,s:= 'IEEE (ST-FPU)'
  2595. ⓪*ELSE
  2596. ⓪,s:= 'IEEE (TT-FPU)'
  2597. ⓪*END
  2598. ⓪(ELSE
  2599. ⓪*s:= 'Megamax'
  2600. ⓪(END;
  2601. ⓪(SetGetBoxStr (infoBox, Realform, setValue, s);
  2602. ⓪&END;
  2603. ⓪$END setGetInfo;
  2604. ⓪$
  2605. ⓪"VAR   space, start   : Rectangle;
  2606. ⓪(exit     : CARDINAL;
  2607. ⓪(res     : INTEGER;
  2608. ⓪ 
  2609. ⓪"BEGIN
  2610. ⓪$animateMenuTitle (Minfo, start);
  2611. ⓪$
  2612. ⓪$GetDefaultPath (dftPath);
  2613. ⓪$dftPathEditable := (maxDftPathInfo >= Length (dftPath));
  2614. ⓪$truncCopyString (dftPath, maxDftPathInfo, dftPath);
  2615. ⓪$truncCopyString (LastCodeName, maxCodeFileInfo, codeFile);
  2616. ⓪$setGetInfo (setValue);
  2617. ⓪$
  2618. ⓪$PrepareBox (infoBox, start, space);
  2619. ⓪$LOOP
  2620. ⓪&formDo (infoBox, Root, exit);
  2621. ⓪&CASE exit OF
  2622. ⓪(Inok, Inquit: DeselectButton (infoBox, exit); EXIT|
  2623. ⓪(Stponrtn    : ToggleCheckBox (infoBox, exit)|
  2624. ⓪&ELSE
  2625. ⓪&END;
  2626. ⓪$END;
  2627. ⓪$ReleaseBox(infoBox, start, space);
  2628. ⓪$
  2629. ⓪$IF exit = Inok THEN
  2630. ⓪&setGetInfo (getValue);
  2631. ⓪&IF dftPathEditable THEN
  2632. ⓪(ValidatePath (dftPath);
  2633. ⓪(ReplaceHome (dftPath);
  2634. ⓪(SetDefaultPath (dftPath, res);
  2635. ⓪(FileAlert (res);
  2636. ⓪&END;
  2637. ⓪$END;
  2638. ⓪$deAnimateMenuTitle (Minfo);
  2639. ⓪"END doInfoBox;
  2640. ⓪"
  2641. ⓪ 
  2642. ⓪0(*  Exportierte Box-Funktionen  *)
  2643. ⓪ 
  2644. ⓪ PROCEDURE ScanBox (VAR name: ARRAY OF CHAR): BOOLEAN;
  2645. ⓪ 
  2646. ⓪"VAR   but: CARDINAL;
  2647. ⓪ 
  2648. ⓪"BEGIN
  2649. ⓪$SetTextString (sNameBox, Snedit, name);
  2650. ⓪$DoSimpleBox (sNameBox, deskObjSpace (Scan), but);
  2651. ⓪$CASE but OF
  2652. ⓪&Snok  : GetTextString(sNameBox, Snedit, name); Upper (name)|
  2653. ⓪&Snwork: WITH WorkField DO
  2654. ⓪0IF current >= 0
  2655. ⓪0THEN Assign(elems[current].sourceName, name, voidO)
  2656. ⓪0ELSE Assign ('', name, voidO); END;
  2657. ⓪.END|
  2658. ⓪$ELSE
  2659. ⓪$END;
  2660. ⓪$RETURN but # Snquit
  2661. ⓪"END ScanBox;
  2662. ⓪ 
  2663. ⓪ PROCEDURE RequestArg (VAR name: ARRAY OF CHAR);
  2664. ⓪ 
  2665. ⓪"BEGIN
  2666. ⓪$SetTextString (argBox, Aedit, name);
  2667. ⓪$DoSimpleBox (argBox, Rect (0, 0, 50, 30), voidC);
  2668. ⓪$GetTextString (argBox, Aedit, name);
  2669. ⓪"END RequestArg;
  2670. ⓪ 
  2671. ⓪ TYPE    TellMode        = (initTell, newTellValue, endTell);
  2672. ⓪ 
  2673. ⓪ PROCEDURE TellLoading (mode: TellMode; REF fname: ARRAY OF CHAR);
  2674. ⓪ 
  2675. ⓪"VAR     start   : Rectangle;
  2676. ⓪"
  2677. ⓪"BEGIN
  2678. ⓪$start := Rect (0, 0, 50, 30);
  2679. ⓪$
  2680. ⓪$CASE mode OF
  2681. ⓪&initTell            : SetTextString (loadBox, Lfname, '');
  2682. ⓪<PrepareBox (loadBox, start, tellSpace);
  2683. ⓪<ShowBee|
  2684. ⓪<
  2685. ⓪&newTellValue        : SetTextString (loadBox, Lfname, '            ');
  2686. ⓪<drawObject (loadBox, Lfname);
  2687. ⓪<SetTextString (loadBox, Lfname, FileName (fname));
  2688. ⓪<drawObject (loadBox, Lfname)|
  2689. ⓪<
  2690. ⓪&endTell             : ReleaseBox (loadBox, start, tellSpace);
  2691. ⓪<ShowArrow|
  2692. ⓪$END;
  2693. ⓪"END TellLoading;
  2694. ⓪ 
  2695. ⓪ 
  2696. ⓪8(*  window managment  *)
  2697. ⓪8(*  ================  *)
  2698. ⓪(
  2699. ⓪((*  misc.  *)
  2700. ⓪ 
  2701. ⓪ CONST   onlyOneSelected   = 0L;
  2702. ⓪(multipleSelect    = 1L;
  2703. ⓪(pickUpSelect      = 2L;
  2704. ⓪(pickUpMultiple    = multipleSelect + pickUpSelect;
  2705. ⓪(doubleClickSelect = 4L;
  2706. ⓪(
  2707. ⓪ 
  2708. ⓪ (*  scanSlots -- calls the proc. 'match' for every window slot, until
  2709. ⓪!*               'match' supplies TRUE. Therefor the result is:
  2710. ⓪!*
  2711. ⓪!*     [(match (slot) = TRUE) AND (success = TRUE)] OR
  2712. ⓪!*     [(<for all> slot <elem> wdwSlotIdx : match (slot) = FALSE) AND
  2713. ⓪!*      (success = FALSE)]
  2714. ⓪!*)
  2715. ⓪ 
  2716. ⓪ TYPE    scanProc        = PROCEDURE ((*slot: *) wdwSlotIdx): BOOLEAN;
  2717. ⓪ 
  2718. ⓪ PROCEDURE scanSlots ((*$Z-*)
  2719. ⓪9match  : scanProc;
  2720. ⓪5(*$Z=*)
  2721. ⓪5VAR slot   : wdwSlotIdx;
  2722. ⓪5VAR success: BOOLEAN);
  2723. ⓪"BEGIN
  2724. ⓪$slot := MIN (wdwSlotIdx);
  2725. ⓪$LOOP
  2726. ⓪&IF match (slot) THEN success := TRUE; EXIT
  2727. ⓪&ELSIF slot = MAX (wdwSlotIdx) THEN success := FALSE; EXIT
  2728. ⓪&ELSE INC (slot) END;
  2729. ⓪$END;
  2730. ⓪"END scanSlots;
  2731. ⓪"
  2732. ⓪ PROCEDURE slotIsFree (slot: wdwSlotIdx): BOOLEAN;
  2733. ⓪ 
  2734. ⓪"BEGIN
  2735. ⓪$RETURN ~ wdws[slot]^.used
  2736. ⓪"END slotIsFree;
  2737. ⓪"
  2738. ⓪ (*
  2739. ⓪ PROCEDURE slotIsUsed (slot: wdwSlotIdx): BOOLEAN;
  2740. ⓪ 
  2741. ⓪"BEGIN
  2742. ⓪$RETURN wdws[slot]^.used
  2743. ⓪"END slotIsUsed;
  2744. ⓪!*)
  2745. ⓪ 
  2746. ⓪ PROCEDURE isDirWdw (slot: wdwSlotIdx): BOOLEAN;
  2747. ⓪ 
  2748. ⓪"BEGIN
  2749. ⓪$WITH wdws[slot]^ DO RETURN used AND (kind = dirWdw)
  2750. ⓪$END;
  2751. ⓪"END isDirWdw;
  2752. ⓪"
  2753. ⓪ PROCEDURE isModWdw (slot: wdwSlotIdx): BOOLEAN;
  2754. ⓪ 
  2755. ⓪"BEGIN
  2756. ⓪$WITH wdws[slot]^ DO RETURN used AND (kind = modWdw)
  2757. ⓪$END;
  2758. ⓪"END isModWdw;
  2759. ⓪"
  2760. ⓪ PROCEDURE isTopWdw (slot: wdwSlotIdx): BOOLEAN;
  2761. ⓪ 
  2762. ⓪"BEGIN
  2763. ⓪$RETURN IsTopWindowWL (wdws[slot]^.wl)
  2764. ⓪"END isTopWdw;
  2765. ⓪ 
  2766. ⓪ PROCEDURE hasSelectedEntries (slot: wdwSlotIdx): BOOLEAN;
  2767. ⓪ 
  2768. ⓪"BEGIN
  2769. ⓪$RETURN wdws[slot]^.noSelected > 0
  2770. ⓪"END hasSelectedEntries;
  2771. ⓪"
  2772. ⓪ 
  2773. ⓪ (*$Z-*)
  2774. ⓪ PROCEDURE deselectEntry (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;
  2775. ⓪ (*$Z=*)
  2776. ⓪ 
  2777. ⓪"BEGIN
  2778. ⓪$IF selectedWL IN attrs THEN entrySelected (env, entry, FALSE) END;
  2779. ⓪$RETURN TRUE
  2780. ⓪"END deselectEntry;
  2781. ⓪"
  2782. ⓪ PROCEDURE deselectWList (slotPtr: ptrWdwSlot);
  2783. ⓪ 
  2784. ⓪"BEGIN
  2785. ⓪$QueryListWL (slotPtr^.wl, forwardWL, deselectEntry, slotPtr,
  2786. ⓪1voidO, voidADR);
  2787. ⓪"END deselectWList;
  2788. ⓪ 
  2789. ⓪ 
  2790. ⓪ PROCEDURE selectEntry (wl     : WindowList;
  2791. ⓪7entry,
  2792. ⓪7env    : ADDRESS;
  2793. ⓪7selMode: LONGCARD);
  2794. ⓪ 
  2795. ⓪"VAR   slotPtr        : ptrWdwSlot;
  2796. ⓪(slot           : wdwSlotIdx;
  2797. ⓪(success,
  2798. ⓪(alreadySelected,
  2799. ⓪(err            : BOOLEAN;
  2800. ⓪(entry2         : ADDRESS;
  2801. ⓪ 
  2802. ⓪"BEGIN
  2803. ⓪$slotPtr := ptrWdwSlot (env);
  2804. ⓪$
  2805. ⓪$careOfDeselectDrive;
  2806. ⓪$
  2807. ⓪$WITH slotPtr^ DO
  2808. ⓪&alreadySelected := selectedWL IN EntryAttributesWL (wl, entry);
  2809. ⓪&
  2810. ⓪&scanSlots (hasSelectedEntries, slot, success);
  2811. ⓪&IF success AND ((selMode = onlyOneSelected) OR (slotPtr # wdws[slot])
  2812. ⓪6OR (selMode = doubleClickSelect)
  2813. ⓪6OR ((selMode = pickUpSelect) AND ~ alreadySelected) )
  2814. ⓪&THEN
  2815. ⓪(deselectWList (wdws[slot])
  2816. ⓪&END;
  2817. ⓪$
  2818. ⓪&entrySelected (slotPtr, entry,
  2819. ⓪5NOT alreadySelected
  2820. ⓪5OR (alreadySelected AND (selMode # multipleSelect))
  2821. ⓪4);
  2822. ⓪$END;
  2823. ⓪"END selectEntry;
  2824. ⓪"
  2825. ⓪"
  2826. ⓪((*  directory windows  *)
  2827. ⓪ 
  2828. ⓪ VAR     dirList  : List;
  2829. ⓪ 
  2830. ⓪ (*$Z-*)
  2831. ⓪ PROCEDURE insertDirEntry (REF path: ARRAY OF CHAR; entry: DirEntry): BOOLEAN;
  2832. ⓪ (*$Z=*)
  2833. ⓪ 
  2834. ⓪"VAR   data, e : ptrDirEntry;
  2835. ⓪(ins, err: BOOLEAN;
  2836. ⓪ 
  2837. ⓪"BEGIN
  2838. ⓪$IF (entry.name[0] # '.')
  2839. ⓪'AND (entry.attr * FileAttrSet{hiddenAttr, systemAttr, volLabelAttr}
  2840. ⓪,= FileAttrSet{})
  2841. ⓪$THEN
  2842. ⓪$
  2843. ⓪&NEW (data);         (*  alloc. carrier  *)
  2844. ⓪&data^.entry := entry;
  2845. ⓪&data^.entry.attr := data^.entry.attr * FileAttrSet{subdirAttr};
  2846. ⓪&data^.str := '';
  2847. ⓪$
  2848. ⓪&(*  alphabetic order, folders first
  2849. ⓪'*)
  2850. ⓪'
  2851. ⓪&ResetList (dirList);
  2852. ⓪&LOOP
  2853. ⓪(e := NextEntry (dirList);
  2854. ⓪(IF e = NIL THEN
  2855. ⓪(
  2856. ⓪*AppendEntry (dirList, data, err);
  2857. ⓪*IF err THEN reportOutOfMemory; RETURN FALSE END;
  2858. ⓪*EXIT
  2859. ⓪*
  2860. ⓪(ELSE
  2861. ⓪*ins := (subdirAttr IN data^.entry.attr)
  2862. ⓪1AND NOT (subdirAttr IN e^.entry.attr);
  2863. ⓪*IF ~ ins AND (data^.entry.attr = e^.entry.attr)
  2864. ⓪*THEN
  2865. ⓪,ins := (fastCompare (data^.entry.name, e^.entry.name) = less)
  2866. ⓪*END;
  2867. ⓪*IF ins THEN
  2868. ⓪*
  2869. ⓪,e := PrevEntry (dirList);
  2870. ⓪,InsertEntry (dirList, data, err);
  2871. ⓪,IF err THEN reportOutOfMemory; RETURN FALSE END;
  2872. ⓪,EXIT
  2873. ⓪,
  2874. ⓪*END;
  2875. ⓪(END;
  2876. ⓪&END;
  2877. ⓪$
  2878. ⓪$END;
  2879. ⓪&
  2880. ⓪$RETURN TRUE
  2881. ⓪"END insertDirEntry;
  2882. ⓪ 
  2883. ⓪ FORWARD dirEntryToStr (entry, env: ADDRESS; VAR str: MaxStr);
  2884. ⓪ 
  2885. ⓪ FORWARD closeDirWdw (wl: WindowList; env: ADDRESS);
  2886. ⓪ 
  2887. ⓪ PROCEDURE createDirList (slotPtr: ptrWdwSlot; VAR success:BOOLEAN);
  2888. ⓪ 
  2889. ⓪"VAR err     : BOOLEAN;
  2890. ⓪&wildName: Str128;
  2891. ⓪&res     : INTEGER;
  2892. ⓪"
  2893. ⓪"BEGIN
  2894. ⓪$ShowBee;
  2895. ⓪$
  2896. ⓪$WITH slotPtr^ DO
  2897. ⓪$
  2898. ⓪&Concat (path, '*.*', wildName, success);
  2899. ⓪&IF ~ success THEN doAlert (pathToLongAlt); ShowArrow; RETURN END;
  2900. ⓪&
  2901. ⓪&CreateList (dirList, err); success := ~ err;
  2902. ⓪&IF err THEN reportOutOfMemory; ShowArrow; RETURN END;
  2903. ⓪$
  2904. ⓪&DirQuery (wildName, FileAttrSet{subdirAttr}, insertDirEntry, res);
  2905. ⓪&IF (res # fFileNotFound) AND (res # fOK)
  2906. ⓪&THEN
  2907. ⓪(FileAlert (res);
  2908. ⓪&END;
  2909. ⓪&
  2910. ⓪&SetListWL (wl, dirList,
  2911. ⓪5dirEntryToStr, closeDirWdw, selectEntry, slotPtr,
  2912. ⓪5dirWdwWidth, path);
  2913. ⓪5
  2914. ⓪$END;
  2915. ⓪$
  2916. ⓪$ShowArrow;
  2917. ⓪"END createDirList;
  2918. ⓪ 
  2919. ⓪ PROCEDURE deleteDirList (slotPtr: ptrWdwSlot);
  2920. ⓪ 
  2921. ⓪"VAR   l: List;
  2922. ⓪ 
  2923. ⓪"BEGIN
  2924. ⓪$GetListWL (slotPtr^.wl, l);
  2925. ⓪$deleteSimpleList (l, TRUE);
  2926. ⓪$slotPtr^.noSelected := 0;
  2927. ⓪"END deleteDirList;
  2928. ⓪ 
  2929. ⓪ 
  2930. ⓪ (*  dirEntryToString -- Wandelt einen Directoryeintrag in einen String um.
  2931. ⓪!*)
  2932. ⓪!
  2933. ⓪ PROCEDURE dirEntryToStr (entry, env: ADDRESS; VAR str: MaxStr);
  2934. ⓪ 
  2935. ⓪"CONST subdirChar      = 7C;   (*  Das Ordnerzeichen  *)
  2936. ⓪ 
  2937. ⓪"VAR   dataPtr         : ptrDirEntry;
  2938. ⓪(slotPtr         : ptrWdwSlot;
  2939. ⓪(
  2940. ⓪(pre, suf        : ARRAY[0..7] OF CHAR;
  2941. ⓪(pos             : CARDINAL;
  2942. ⓪(str0            : String;
  2943. ⓪"
  2944. ⓪"PROCEDURE extendStr (offset: CARDINAL);
  2945. ⓪"
  2946. ⓪$BEGIN
  2947. ⓪&pos := pos + offset;
  2948. ⓪&appendSpcTo (pos, str);
  2949. ⓪$END extendStr;
  2950. ⓪$
  2951. ⓪"
  2952. ⓪"BEGIN
  2953. ⓪$dataPtr := ptrDirEntry (entry);
  2954. ⓪$slotPtr := ptrWdwSlot (env);
  2955. ⓪$
  2956. ⓪$IF Empty (dataPtr^.str) THEN
  2957. ⓪$
  2958. ⓪&WITH dataPtr^.entry DO
  2959. ⓪&
  2960. ⓪(pos := 0; str := '';
  2961. ⓪(
  2962. ⓪(IF isSubdir (dataPtr^.entry) THEN         (*  folder  *)
  2963. ⓪*Concat (' ',subdirChar, str, voidO)
  2964. ⓪(END;
  2965. ⓪(extendStr (dirLeftBorder);
  2966. ⓪(
  2967. ⓪(SplitName (name, pre, suf);
  2968. ⓪(Append (pre, str, voidO);                 (*  name  *)
  2969. ⓪(extendStr (dirNameLen);
  2970. ⓪(
  2971. ⓪(Append (suf, str, voidO);                 (*  extension  *)
  2972. ⓪(extendStr (dirExtLen + dirGap);
  2973. ⓪(
  2974. ⓪(IF ~ isSubdir (dataPtr^.entry) THEN       (*  size  *)
  2975. ⓪*Append (CardToStr (size, dirSizeLen), str, voidO);
  2976. ⓪(END;
  2977. ⓪(extendStr (dirSizeLen + dirGap);
  2978. ⓪(
  2979. ⓪(DateToText (date, '', str0);              (*  date  *)
  2980. ⓪(Append (str0, str, voidO);
  2981. ⓪(extendStr (dirDateLen + dirGap);
  2982. ⓪(
  2983. ⓪(TimeToText (time, '', str0);                  (*  time  *)
  2984. ⓪(Delete (str0, 5, 3, voidO);
  2985. ⓪(Append (str0, str, voidO);
  2986. ⓪(extendStr (dirTimeLen + dirRightBorder);
  2987. ⓪(
  2988. ⓪&END;
  2989. ⓪&
  2990. ⓪&Assign (str, dataPtr^.str, voidO);
  2991. ⓪$
  2992. ⓪$ELSE Assign (dataPtr^.str, str, voidO) END;
  2993. ⓪$
  2994. ⓪"END dirEntryToStr;
  2995. ⓪(
  2996. ⓪ PROCEDURE closeDirWdw (wl: WindowList; env: ADDRESS);
  2997. ⓪ 
  2998. ⓪"VAR   slotPtr: ptrWdwSlot;
  2999. ⓪(i, j,
  3000. ⓪(len : INTEGER;
  3001. ⓪ 
  3002. ⓪"BEGIN
  3003. ⓪$slotPtr := ptrWdwSlot (env);
  3004. ⓪$
  3005. ⓪$deleteDirList (slotPtr);
  3006. ⓪$ViewLineWL (slotPtr^.wl, 1);
  3007. ⓪&
  3008. ⓪$WITH slotPtr^ DO
  3009. ⓪$
  3010. ⓪&len := INTEGER (Length (path));
  3011. ⓪&i := PosLen ('\', path, 0);
  3012. ⓪&j := PosLen ('\', path, i + 1);
  3013. ⓪&IF j = len THEN                   (*  close root => close window  *)
  3014. ⓪&
  3015. ⓪(used := FALSE;
  3016. ⓪(HideWindowWL (wl);
  3017. ⓪(
  3018. ⓪&ELSE                              (*  close folder  *)
  3019. ⓪&
  3020. ⓪(WHILE j < (len - 1) DO
  3021. ⓪*i := j;
  3022. ⓪*j := PosLen ('\', path, i + 1);
  3023. ⓪(END;
  3024. ⓪(Delete (path, i + 1, j - i, voidO);
  3025. ⓪(createDirList (slotPtr, voidO);
  3026. ⓪(
  3027. ⓪&END;
  3028. ⓪$END;
  3029. ⓪"END closeDirWdw;
  3030. ⓪ 
  3031. ⓪ (*  openDirWdw -- Opens a new directory window on drive 'drive'. Depending on
  3032. ⓪!*                on 'openCurrDir' the root or the current path of the drive
  3033. ⓪!*                is displayed.
  3034. ⓪!*                Result is the used window slot in 'slot' and 'success = TRUE'
  3035. ⓪!*                if no error occured.
  3036. ⓪!*)
  3037. ⓪"
  3038. ⓪ PROCEDURE openDirWdw (VAR slot       : wdwSlotIdx;
  3039. ⓪:driv       : Drive;
  3040. ⓪:openCurrDir: BOOLEAN);
  3041. ⓪ 
  3042. ⓪"VAR   str    : Str128;
  3043. ⓪(drive  : MOSGlobals.Drive;
  3044. ⓪(result : INTEGER;
  3045. ⓪(success: BOOLEAN;
  3046. ⓪ 
  3047. ⓪"BEGIN
  3048. ⓪$drive:= VAL (MOSGlobals.Drive, ORD (driv));
  3049. ⓪$
  3050. ⓪$scanSlots (slotIsFree, slot, success);
  3051. ⓪$IF ~ success THEN doAlert (noWindAlt); RETURN END;
  3052. ⓪$
  3053. ⓪$WITH wdws[slot]^ DO         (*  init.  *)
  3054. ⓪$
  3055. ⓪&Assign (DriveToStr (drive), path, voidO);
  3056. ⓪&IF openCurrDir
  3057. ⓪&THEN
  3058. ⓪(GetCurrentDir (drive, str);
  3059. ⓪(SetCurrentDir (drive, str, result);
  3060. ⓪(IF result < fOK
  3061. ⓪(THEN
  3062. ⓪*openCurrDir := FALSE;
  3063. ⓪*IF str[1] = 0C THEN RETURN END; (* RETURN, if 'str' describes root  *)
  3064. ⓪(END;
  3065. ⓪&END;
  3066. ⓪&IF openCurrDir
  3067. ⓪&THEN
  3068. ⓪(Append (str, path, success);
  3069. ⓪&ELSE
  3070. ⓪(Append ('\', path, success);
  3071. ⓪&END;
  3072. ⓪&
  3073. ⓪&kind := dirWdw;
  3074. ⓪&
  3075. ⓪$END;
  3076. ⓪$
  3077. ⓪$(*  create and display the 'WindowList'
  3078. ⓪%*)
  3079. ⓪$
  3080. ⓪$createDirList (wdws[slot], success); IF ~ success THEN RETURN END;
  3081. ⓪$ShowBee; ShowWindowWL (wdws[slot]^.wl); ShowArrow;
  3082. ⓪$IF StateWL (wdws[slot]^.wl) = cantShowWL THEN
  3083. ⓪&ResetStateWL (wdws[slot]^.wl);
  3084. ⓪&deleteDirList (wdws[slot]);
  3085. ⓪&doAlert (noWindAlt);
  3086. ⓪&RETURN
  3087. ⓪$END;
  3088. ⓪$wdws[slot]^.used := TRUE;
  3089. ⓪"END openDirWdw;
  3090. ⓪"
  3091. ⓪ PROCEDURE openFolder (slotPtr: ptrWdwSlot; data: ptrDirEntry);
  3092. ⓪ 
  3093. ⓪"VAR   newPath : Str128;
  3094. ⓪(success : BOOLEAN;
  3095. ⓪ 
  3096. ⓪"BEGIN
  3097. ⓪$IF isSubdir (data^.entry) THEN
  3098. ⓪$
  3099. ⓪&concatPath (slotPtr^.path, data^.entry.name, newPath, success);
  3100. ⓪&IF success THEN
  3101. ⓪(Append ('\', newPath, success);
  3102. ⓪(IF ~ success THEN doAlert (pathToLongAlt) END;
  3103. ⓪&END;
  3104. ⓪&
  3105. ⓪&IF success THEN
  3106. ⓪&
  3107. ⓪(deleteDirList (slotPtr);
  3108. ⓪(ViewLineWL (slotPtr^.wl, 1);
  3109. ⓪(Assign (newPath, slotPtr^.path, voidO);
  3110. ⓪(createDirList (slotPtr, success);
  3111. ⓪(
  3112. ⓪&END;
  3113. ⓪&
  3114. ⓪$END;
  3115. ⓪"END openFolder;
  3116. ⓪"
  3117. ⓪"
  3118. ⓪((*  module windows  *)
  3119. ⓪ 
  3120. ⓪ (*  insertModEntry -- Inserts one module alphabetical in the 'modList'.
  3121. ⓪!*                    'modFlag = TRUE' means to insert every module, else
  3122. ⓪!*                    there are only loaded moduls inserted.
  3123. ⓪!*)
  3124. ⓪ 
  3125. ⓪ VAR     modList: List;
  3126. ⓪(modFlag: BOOLEAN;
  3127. ⓪ 
  3128. ⓪ PROCEDURE insertModEntry (REF codeName: ARRAY OF CHAR;
  3129. ⓪>codeAddr: ADDRESS;
  3130. ⓪>codeLen : LONGCARD;
  3131. ⓪>varAddr : ADDRESS;
  3132. ⓪>varLen  : LONGCARD;
  3133. ⓪:REF fileName: ARRAY OF CHAR;
  3134. ⓪>module  : BOOLEAN;
  3135. ⓪>loaded  : BOOLEAN;
  3136. ⓪>resident: BOOLEAN );
  3137. ⓪ 
  3138. ⓪"VAR   data, e: ptrModEntry;
  3139. ⓪(err    : BOOLEAN;
  3140. ⓪"
  3141. ⓪"BEGIN
  3142. ⓪$IF modFlag OR loaded THEN
  3143. ⓪$
  3144. ⓪&NEW (data);
  3145. ⓪&IF data = NIL THEN reportOutOfMemory; RETURN END;
  3146. ⓪&
  3147. ⓪&WITH data^ DO
  3148. ⓪(Assign (codeName, name, voidO);
  3149. ⓪(lenOfCode := codeLen;
  3150. ⓪(lenOfVar := varLen;
  3151. ⓪(isModul := module;
  3152. ⓪(wasLoaded := loaded;
  3153. ⓪(isResident := resident;
  3154. ⓪&END;
  3155. ⓪&
  3156. ⓪&ResetList (modList);
  3157. ⓪&LOOP
  3158. ⓪(e := NextEntry (modList);
  3159. ⓪(IF e = NIL THEN
  3160. ⓪(
  3161. ⓪*AppendEntry (modList, data, err);
  3162. ⓪*IF err THEN reportOutOfMemory; RETURN END;
  3163. ⓪*EXIT
  3164. ⓪*
  3165. ⓪(ELSE
  3166. ⓪(
  3167. ⓪*IF fastCompare (data^.name, e^.name) = less THEN
  3168. ⓪*
  3169. ⓪,e := PrevEntry (modList);
  3170. ⓪,InsertEntry (modList, data, err);
  3171. ⓪,IF err THEN reportOutOfMemory; RETURN END;
  3172. ⓪,EXIT
  3173. ⓪,
  3174. ⓪*END;
  3175. ⓪(END;
  3176. ⓪&END;
  3177. ⓪&
  3178. ⓪$END;
  3179. ⓪"END insertModEntry;
  3180. ⓪ 
  3181. ⓪ FORWARD modEntryToStr (entry, env: ADDRESS; VAR str: MaxStr);
  3182. ⓪ 
  3183. ⓪ FORWARD closeModWdw (wl: WindowList; env: ADDRESS);
  3184. ⓪ 
  3185. ⓪ PROCEDURE createModList (slotPtr: ptrWdwSlot; VAR success:BOOLEAN);
  3186. ⓪ 
  3187. ⓪"VAR   err : BOOLEAN;
  3188. ⓪(w   : CARDINAL;
  3189. ⓪(name: FileStr;
  3190. ⓪"
  3191. ⓪"BEGIN
  3192. ⓪$AESUpdateWindow (TRUE);
  3193. ⓪$ShowBee;
  3194. ⓪$
  3195. ⓪$CreateList (modList, err); success := ~ err;
  3196. ⓪$IF err THEN reportOutOfMemory; ShowArrow; AESUpdateWindow (FALSE); RETURN END;
  3197. ⓪$WITH slotPtr^ DO
  3198. ⓪$
  3199. ⓪&modFlag := all;
  3200. ⓪$
  3201. ⓪&ModQuery (insertModEntry);
  3202. ⓪&
  3203. ⓪&IF all THEN
  3204. ⓪(Assign (modWdwTitleAll, name, voidO);
  3205. ⓪(w := modWdwWidthAll;
  3206. ⓪&ELSE
  3207. ⓪(Assign (modWdwTitle, name, voidO);
  3208. ⓪(w := modWdwWidth;
  3209. ⓪&END;
  3210. ⓪&SetListWL (wl, modList,
  3211. ⓪5modEntryToStr, closeModWdw, selectEntry, slotPtr,
  3212. ⓪5w, name);
  3213. ⓪5
  3214. ⓪$END;
  3215. ⓪$
  3216. ⓪$ShowArrow;
  3217. ⓪$AESUpdateWindow (FALSE);
  3218. ⓪"END createModList;
  3219. ⓪ 
  3220. ⓪ PROCEDURE deleteModList (slotPtr: ptrWdwSlot);
  3221. ⓪ 
  3222. ⓪"VAR   l: List;
  3223. ⓪"
  3224. ⓪"BEGIN
  3225. ⓪$GetListWL (slotPtr^.wl, l);
  3226. ⓪$deleteSimpleList (l, TRUE);
  3227. ⓪$slotPtr^.noSelected := 0;
  3228. ⓪"END deleteModList;
  3229. ⓪"
  3230. ⓪ 
  3231. ⓪ PROCEDURE modEntryToStr (entry, env: ADDRESS; VAR str: MaxStr);
  3232. ⓪ 
  3233. ⓪"VAR   dataPtr: ptrModEntry;
  3234. ⓪(slotPtr: ptrWdwSlot;
  3235. ⓪(
  3236. ⓪(pos    : CARDINAL;
  3237. ⓪"
  3238. ⓪"PROCEDURE extendStr (offset: CARDINAL);
  3239. ⓪"
  3240. ⓪$BEGIN
  3241. ⓪&pos := pos + offset;
  3242. ⓪&appendSpcTo (pos, str);
  3243. ⓪$END extendStr;
  3244. ⓪"
  3245. ⓪"PROCEDURE appFlg (REF text: ARRAY OF CHAR; len: CARDINAL; flg: BOOLEAN);
  3246. ⓪6
  3247. ⓪$BEGIN
  3248. ⓪&extendStr (modGap);
  3249. ⓪&
  3250. ⓪&IF flg THEN Append (text, str, voidO) END;
  3251. ⓪&extendStr (len);
  3252. ⓪$END appFlg;
  3253. ⓪$
  3254. ⓪"
  3255. ⓪"BEGIN
  3256. ⓪$dataPtr := ptrModEntry (entry);
  3257. ⓪$slotPtr := ptrWdwSlot (env);
  3258. ⓪$
  3259. ⓪$WITH dataPtr^ DO
  3260. ⓪$
  3261. ⓪&pos := 0; str := '';
  3262. ⓪&
  3263. ⓪&Assign (name, str, voidO);
  3264. ⓪&extendStr (maxModNameLen + modGap);
  3265. ⓪&
  3266. ⓪&Append (CardToStr (lenOfCode, lCardLog), str, voidO);
  3267. ⓪&extendStr (lCardLog + modGap);
  3268. ⓪&
  3269. ⓪&Append (CardToStr (lenOfVar, lCardLog), str, voidO);
  3270. ⓪&extendStr (lCardLog);
  3271. ⓪&
  3272. ⓪&appFlg (modModFlag, modModLen, isModul);
  3273. ⓪&IF slotPtr^.all THEN appFlg (modLoadFlag, modLoadLen, wasLoaded) END;
  3274. ⓪&appFlg (modRsdFlag, modRsdLen, isResident);
  3275. ⓪&
  3276. ⓪$END;
  3277. ⓪$
  3278. ⓪"END modEntryToStr;
  3279. ⓪ 
  3280. ⓪ PROCEDURE closeModWdw (wl: WindowList; env: ADDRESS);
  3281. ⓪ 
  3282. ⓪"VAR   slotPtr: ptrWdwSlot;
  3283. ⓪ 
  3284. ⓪"BEGIN
  3285. ⓪$slotPtr := ptrWdwSlot (env);
  3286. ⓪$
  3287. ⓪$deleteModList (slotPtr);
  3288. ⓪$WITH slotPtr^
  3289. ⓪$DO
  3290. ⓪&used := FALSE;
  3291. ⓪&HideWindowWL (wl);
  3292. ⓪$END;
  3293. ⓪"END closeModWdw;
  3294. ⓪"
  3295. ⓪ PROCEDURE openModWdw (VAR slot       : wdwSlotIdx;
  3296. ⓪:allMods    : BOOLEAN);
  3297. ⓪"
  3298. ⓪"VAR   success: BOOLEAN;
  3299. ⓪"
  3300. ⓪"BEGIN
  3301. ⓪$scanSlots (slotIsFree, slot, success);
  3302. ⓪$IF ~ success THEN doAlert (noWindAlt); RETURN END;
  3303. ⓪$
  3304. ⓪$WITH wdws[slot]^ DO         (*  init.  *)
  3305. ⓪$
  3306. ⓪&all := allMods;
  3307. ⓪&
  3308. ⓪&kind := modWdw;
  3309. ⓪&used := TRUE;
  3310. ⓪&
  3311. ⓪$END;
  3312. ⓪$
  3313. ⓪$(*  create and display the 'WindowList'
  3314. ⓪%*)
  3315. ⓪$
  3316. ⓪$AESUpdateWindow (TRUE);
  3317. ⓪$createModList (wdws[slot], success); IF ~ success THEN AESUpdateWindow (FALSE); RETURN END;
  3318. ⓪$ShowBee; ShowWindowWL (wdws[slot]^.wl); ShowArrow;
  3319. ⓪$IF StateWL (wdws[slot]^.wl) = cantShowWL THEN
  3320. ⓪&ResetStateWL (wdws[slot]^.wl);
  3321. ⓪&doAlert (noWindAlt);
  3322. ⓪$END;
  3323. ⓪$AESUpdateWindow (FALSE);
  3324. ⓪"END openModWdw;
  3325. ⓪"
  3326. ⓪"
  3327. ⓪((*  general window proc.s  *)
  3328. ⓪ 
  3329. ⓪ (*  getSelectedName -- Ermittelt die zu dem aktuell selektierten Fenster-
  3330. ⓪!*                     eintrag gehörende Zeichenkette.
  3331. ⓪!*                     Zusätzlich wird noch der Typ des Eintrages geliefert.
  3332. ⓪!*                     Ist kein Eintrag oder sind mehrere selektiert, so
  3333. ⓪!*                     wird 'kind = noNK' geliefert.
  3334. ⓪!*                     'slot' liefert den Fensterslot, in dem sich der Eintrag
  3335. ⓪!*                     befindet.
  3336. ⓪!*)
  3337. ⓪ 
  3338. ⓪ TYPE    nameKind        = (noNK, fileNK, folderNK, modulNK);
  3339. ⓪ 
  3340. ⓪ PROCEDURE getSelectedName (VAR name      : ARRAY OF CHAR;
  3341. ⓪;VAR slot      : wdwSlotIdx;
  3342. ⓪;VAR kindOfName: nameKind);
  3343. ⓪ 
  3344. ⓪"VAR   somethingSelected: BOOLEAN;
  3345. ⓪(entry            : ADDRESS;
  3346. ⓪(dirEntryPtr      : ptrDirEntry;
  3347. ⓪(modEntryPtr      : ptrModEntry;
  3348. ⓪(success          : BOOLEAN;
  3349. ⓪ 
  3350. ⓪"BEGIN
  3351. ⓪$scanSlots (hasSelectedEntries, slot, somethingSelected);
  3352. ⓪$IF somethingSelected AND (wdws[slot]^.noSelected = 1) THEN
  3353. ⓪$
  3354. ⓪&WITH wdws[slot]^ DO
  3355. ⓪(entry := firstSelectedEntry (slot);
  3356. ⓪(IF kind = dirWdw THEN                   (*  dir. wdw  *)
  3357. ⓪(
  3358. ⓪*dirEntryPtr := ptrDirEntry (entry);
  3359. ⓪*concatPath (path, dirEntryPtr^.entry.name, name, success);
  3360. ⓪*IF success THEN
  3361. ⓪,IF isSubdir (dirEntryPtr^.entry) THEN kindOfName := folderNK
  3362. ⓪,ELSE kindOfName := fileNK END;
  3363. ⓪*ELSE kindOfName := noNK END;
  3364. ⓪*
  3365. ⓪(ELSE                                    (*  mod. wdw  *)
  3366. ⓪(
  3367. ⓪*modEntryPtr := ptrModEntry (entry);
  3368. ⓪*Assign (modEntryPtr^.name, name, voidO);
  3369. ⓪*kindOfName := modulNK;
  3370. ⓪*
  3371. ⓪(END;
  3372. ⓪&END;
  3373. ⓪&
  3374. ⓪$ELSE kindOfName := noNK END;
  3375. ⓪"END getSelectedName;
  3376. ⓪"
  3377. ⓪ PROCEDURE careOfDeselectEntries;
  3378. ⓪ 
  3379. ⓪"VAR   slot   : wdwSlotIdx;
  3380. ⓪(success: BOOLEAN;
  3381. ⓪ 
  3382. ⓪"BEGIN
  3383. ⓪$scanSlots (hasSelectedEntries, slot, success);
  3384. ⓪$IF success THEN deselectWList (wdws[slot]) END;
  3385. ⓪"END careOfDeselectEntries;
  3386. ⓪ 
  3387. ⓪ PROCEDURE closeTopWdw (complete: BOOLEAN);
  3388. ⓪ 
  3389. ⓪"VAR   slot   : wdwSlotIdx;
  3390. ⓪(success: BOOLEAN;
  3391. ⓪ 
  3392. ⓪"BEGIN
  3393. ⓪$AESUpdateWindow (TRUE);
  3394. ⓪$scanSlots (isTopWdw, slot, success);
  3395. ⓪$IF success
  3396. ⓪$THEN
  3397. ⓪&WITH wdws[slot]^ DO CASE kind OF
  3398. ⓪&
  3399. ⓪(dirWdw  : IF complete THEN path := '' END;      (*  forces closure  *)
  3400. ⓪2closeDirWdw (wl, wdws[slot])|
  3401. ⓪(modWdw  : closeModWdw (wl, wdws[slot])|
  3402. ⓪(
  3403. ⓪&END END;
  3404. ⓪$END;
  3405. ⓪$AESUpdateWindow (FALSE);
  3406. ⓪"END closeTopWdw;
  3407. ⓪ 
  3408. ⓪ PROCEDURE closeWdw (slot: wdwSlotIdx): BOOLEAN;
  3409. ⓪ 
  3410. ⓪"BEGIN
  3411. ⓪$AESUpdateWindow (TRUE);
  3412. ⓪$WITH wdws[slot]^ DO IF used THEN CASE kind OF
  3413. ⓪&
  3414. ⓪(dirWdw  : path := '';                   (*  forces closure  *)
  3415. ⓪2closeDirWdw (wl, wdws[slot])|
  3416. ⓪(modWdw  : closeModWdw (wl, wdws[slot])|
  3417. ⓪(
  3418. ⓪$END END END;
  3419. ⓪$AESUpdateWindow (FALSE);
  3420. ⓪$RETURN FALSE
  3421. ⓪"END closeWdw;
  3422. ⓪ 
  3423. ⓪ PROCEDURE hideWdw (slot: wdwSlotIdx): BOOLEAN;
  3424. ⓪ 
  3425. ⓪"BEGIN
  3426. ⓪$WITH wdws[slot]^ DO IF used THEN
  3427. ⓪$
  3428. ⓪&CASE kind OF
  3429. ⓪$
  3430. ⓪(dirWdw  : deleteDirList (wdws[slot])|
  3431. ⓪(modWdw  : deleteModList (wdws[slot])|
  3432. ⓪(
  3433. ⓪&END;
  3434. ⓪&HideWindowWL (wl);
  3435. ⓪&
  3436. ⓪$END END;
  3437. ⓪$RETURN FALSE
  3438. ⓪"END hideWdw;
  3439. ⓪"
  3440. ⓪ PROCEDURE setTopWdw (slot: wdwSlotIdx): BOOLEAN;
  3441. ⓪ 
  3442. ⓪"BEGIN
  3443. ⓪$IF wdws[slot]^.used AND wdws[slot]^.isTop THEN
  3444. ⓪&PutWindowOnTopWL (wdws[slot]^.wl);
  3445. ⓪$END;
  3446. ⓪$RETURN TRUE
  3447. ⓪"END setTopWdw;
  3448. ⓪"
  3449. ⓪ PROCEDURE showWdw (slot: wdwSlotIdx): BOOLEAN;
  3450. ⓪ 
  3451. ⓪"VAR   success: BOOLEAN;
  3452. ⓪ 
  3453. ⓪"BEGIN
  3454. ⓪$WITH wdws[slot]^ DO IF used THEN
  3455. ⓪$
  3456. ⓪&CASE kind OF
  3457. ⓪&
  3458. ⓪(dirWdw  : createDirList (wdws[slot], success)|
  3459. ⓪(modWdw  : createModList (wdws[slot], success)|
  3460. ⓪(
  3461. ⓪&END;
  3462. ⓪&IF success THEN
  3463. ⓪(AESUpdateWindow (TRUE);
  3464. ⓪(ShowBee; ShowWindowWL (wl); ShowArrow;
  3465. ⓪(AESUpdateWindow (FALSE);
  3466. ⓪(IF StateWL (wl) = cantShowWL THEN
  3467. ⓪*ResetStateWL (wl);
  3468. ⓪*voidO := hideWdw (slot);
  3469. ⓪*used := FALSE;
  3470. ⓪(END;
  3471. ⓪&ELSE used := FALSE END;
  3472. ⓪&
  3473. ⓪$END END;
  3474. ⓪$RETURN FALSE
  3475. ⓪"END showWdw;
  3476. ⓪ 
  3477. ⓪ PROCEDURE updateModWdw (slot: wdwSlotIdx): BOOLEAN;
  3478. ⓪ 
  3479. ⓪"VAR   slotPtr: ptrWdwSlot;
  3480. ⓪ 
  3481. ⓪"BEGIN
  3482. ⓪$slotPtr := wdws[slot];
  3483. ⓪$AESUpdateWindow (TRUE);
  3484. ⓪$IF slotPtr^.used AND (slotPtr^.kind = modWdw) THEN
  3485. ⓪&deleteModList (slotPtr);
  3486. ⓪&createModList (slotPtr, voidO);
  3487. ⓪$END;
  3488. ⓪$AESUpdateWindow (FALSE);
  3489. ⓪$
  3490. ⓪$RETURN FALSE
  3491. ⓪"END updateModWdw;
  3492. ⓪"
  3493. ⓪ PROCEDURE updateWdw (slotPtr: ptrWdwSlot);
  3494. ⓪ 
  3495. ⓪"BEGIN
  3496. ⓪$AESUpdateWindow (TRUE);
  3497. ⓪$CASE slotPtr^.kind OF
  3498. ⓪&dirWdw    : deleteDirList (slotPtr);
  3499. ⓪2createDirList (slotPtr, voidO)|
  3500. ⓪&modWdw    : deleteModList (slotPtr);
  3501. ⓪2createModList (slotPtr, voidO)|
  3502. ⓪$END;
  3503. ⓪$AESUpdateWindow (FALSE);
  3504. ⓪"END updateWdw;
  3505. ⓪"
  3506. ⓪ 
  3507. ⓪ (*  detectWdw -- tries to find a window at 'loc', if success then
  3508. ⓪!*               'contSearch = FALSE' and 'slotPtr' references
  3509. ⓪!*               the slot of the window. If there is also an entry
  3510. ⓪!*               beneath 'loc', then 'entry' is a reference to the
  3511. ⓪!*               entry. In any other case 'entry = NIL'. 'clicks',
  3512. ⓪!*               'specials' and 'buts' are used to calc. the selection
  3513. ⓪!*               mode. 'mode' says, if a selection has to be done.
  3514. ⓪!*)
  3515. ⓪!
  3516. ⓪ PROCEDURE detectWdws (    loc       : Point;
  3517. ⓪:mode      : DetectModeWL;
  3518. ⓪:clicks    : CARDINAL;
  3519. ⓪:specials  : SpecialKeySet;
  3520. ⓪:buts      : MButtonSet;
  3521. ⓪6VAR entry     : ADDRESS;
  3522. ⓪6VAR slotPtr   : ptrWdwSlot;
  3523. ⓪6VAR contSearch: BOOLEAN);
  3524. ⓪(
  3525. ⓪"VAR   wls     : ARRAY wdwSlotIdx OF WindowList;
  3526. ⓪(wl      : WindowList;
  3527. ⓪(slot    : wdwSlotIdx;
  3528. ⓪(selMode : LONGCARD;
  3529. ⓪(env     : ADDRESS;
  3530. ⓪ 
  3531. ⓪"BEGIN
  3532. ⓪$FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO
  3533. ⓪&wls[slot] := wdws[slot]^.wl
  3534. ⓪$END;
  3535. ⓪$IF clicks = 1 THEN
  3536. ⓪&IF withShift (specials) THEN selMode := multipleSelect
  3537. ⓪&ELSE selMode := onlyOneSelected END;
  3538. ⓪&IF msBut1 IN buts THEN selMode := selMode + pickUpSelect END;
  3539. ⓪$ELSE selMode := doubleClickSelect END;
  3540. ⓪$
  3541. ⓪$DetectWindowWL (wls,0, loc, mode, selMode, wl, entry, env, contSearch);
  3542. ⓪$
  3543. ⓪$IF wl = NoWindowList THEN entry := NIL END;
  3544. ⓪$slotPtr := ptrWdwSlot (env);
  3545. ⓪"END detectWdws;
  3546. ⓪ 
  3547. ⓪ 
  3548. ⓪ PROCEDURE SetGetWindows (f: File; mode: SetGetMode);
  3549. ⓪ 
  3550. ⓪"VAR   slot          : wdwSlotIdx;
  3551. ⓪"
  3552. ⓪(wdwParmCarrier: RECORD
  3553. ⓪(
  3554. ⓪:used, isTop : BOOLEAN;
  3555. ⓪:space       : Rectangle;
  3556. ⓪:
  3557. ⓪:CASE kind: wdwKind
  3558. ⓪:OF
  3559. ⓪<dirWdw    : path  : Str128|
  3560. ⓪<modWdw    : all   : BOOLEAN|
  3561. ⓪:END;
  3562. ⓪:
  3563. ⓪8END;
  3564. ⓪ 
  3565. ⓪"BEGIN
  3566. ⓪$FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO WITH wdws[slot]^ DO
  3567. ⓪&IF mode = setValue THEN
  3568. ⓪&
  3569. ⓪(ReadBlock (f, wdwParmCarrier); IF State (f) < fOK THEN RETURN END;
  3570. ⓪(
  3571. ⓪(tmpSpace:= wdwParmCarrier.space;
  3572. ⓪(used := wdwParmCarrier.used;
  3573. ⓪(isTop := wdwParmCarrier.isTop;
  3574. ⓪(IF used THEN
  3575. ⓪*kind := wdwParmCarrier.kind;
  3576. ⓪*CASE kind OF
  3577. ⓪,dirWdw    : path := wdwParmCarrier.path|
  3578. ⓪,modWdw    : all := wdwParmCarrier.all|
  3579. ⓪*END;
  3580. ⓪(END;
  3581. ⓪(
  3582. ⓪&ELSE
  3583. ⓪&
  3584. ⓪(wdwParmCarrier.space := WindowSizeWL (wl);
  3585. ⓪(wdwParmCarrier.used := used;
  3586. ⓪(wdwParmCarrier.isTop := isTop;
  3587. ⓪(IF used THEN
  3588. ⓪*wdwParmCarrier.kind := kind;
  3589. ⓪*CASE kind OF
  3590. ⓪,dirWdw    : wdwParmCarrier.path := path|
  3591. ⓪,modWdw    : wdwParmCarrier.all := all|
  3592. ⓪*END;
  3593. ⓪(END;
  3594. ⓪(
  3595. ⓪(WriteBlock (f, wdwParmCarrier); IF State (f) < fOK THEN RETURN END;
  3596. ⓪(
  3597. ⓪&END;
  3598. ⓪$END END;
  3599. ⓪"END SetGetWindows;
  3600. ⓪"
  3601. ⓪"
  3602. ⓪8(*  drag procs  *)
  3603. ⓪8(*  ==========  *)
  3604. ⓪ 
  3605. ⓪ TYPE    dragObjectKind  = (fileDOK, filesDOK, modulDOK, modulsDOK);
  3606. ⓪(
  3607. ⓪(targetObjectKind= (objTOK, wdwTOK);
  3608. ⓪ 
  3609. ⓪(targetObject    = RECORD
  3610. ⓪<CASE kind: targetObjectKind OF
  3611. ⓪<
  3612. ⓪>objTOK  : obj     : CARDINAL|
  3613. ⓪>
  3614. ⓪>(*  'valid = TRUE' means, that 'entry'
  3615. ⓪?*  is a valid target.
  3616. ⓪?*)
  3617. ⓪>wdwTOK  : slotPtr : ptrWdwSlot;
  3618. ⓪Hvalid   : BOOLEAN;
  3619. ⓪Hentry   : ADDRESS|
  3620. ⓪H
  3621. ⓪<END;
  3622. ⓪:END;
  3623. ⓪ 
  3624. ⓪ (*  toggleTarget -- Toggle the target object, which is desribed by 'which'.
  3625. ⓪!*                  Don't toggle wdws without entry and the 'Root' object.
  3626. ⓪!*)
  3627. ⓪ 
  3628. ⓪ PROCEDURE toggleTarget (which: targetObject; selected: BOOLEAN);
  3629. ⓪ 
  3630. ⓪"VAR   found: BOOLEAN;
  3631. ⓪"
  3632. ⓪"BEGIN
  3633. ⓪$WITH which DO CASE kind OF
  3634. ⓪&objTOK  : IF obj # Root THEN toggleDeskObj (obj, voidO) END|
  3635. ⓪&wdwTOK  : IF valid THEN
  3636. ⓪2entrySelected (slotPtr, entry, selected)
  3637. ⓪0END|
  3638. ⓪$END END;
  3639. ⓪"END toggleTarget;
  3640. ⓪ 
  3641. ⓪ TYPE    selObj          = RECORD
  3642. ⓪<loc  : Point;
  3643. ⓪<boxes: List;
  3644. ⓪:END;
  3645. ⓪(ptrSelObj       = POINTER TO selObj;
  3646. ⓪ 
  3647. ⓪ PROCEDURE toggleSelectedBox (entry, env: ADDRESS): BOOLEAN;
  3648. ⓪ 
  3649. ⓪"VAR   selObjPtr : ptrSelObj;
  3650. ⓪(data      : ptrRectangle;
  3651. ⓪(
  3652. ⓪(pts       : ARRAY[0..4] OF Point;
  3653. ⓪(x, y, w, h: INTEGER;
  3654. ⓪"
  3655. ⓪"BEGIN
  3656. ⓪$selObjPtr := ptrSelObj (env);
  3657. ⓪$data := ptrRectangle (entry);
  3658. ⓪$
  3659. ⓪$x := selObjPtr^.loc.x + data^.x; x := x - x MOD 2;
  3660. ⓪$y := selObjPtr^.loc.y + data^.y; y := y - y MOD 2;
  3661. ⓪$w := data^.w - data^.w MOD 2;
  3662. ⓪$h := data^.h - data^.h MOD 2;
  3663. ⓪$pts[0].x := x;
  3664. ⓪$pts[0].y := y;
  3665. ⓪$pts[1].x := x + w;
  3666. ⓪$pts[1].y := y;
  3667. ⓪$pts[2].x := x + w;
  3668. ⓪$pts[2].y := y + h;
  3669. ⓪$pts[3].x := x;
  3670. ⓪$pts[3].y := y + h;
  3671. ⓪$pts[4].x := x;
  3672. ⓪$pts[4].y := y;
  3673. ⓪$PolyLine (dev, pts, 0);
  3674. ⓪$
  3675. ⓪$RETURN TRUE
  3676. ⓪"END toggleSelectedBox;
  3677. ⓪"
  3678. ⓪ PROCEDURE dragSensitive (    objFrame: Rectangle;
  3679. ⓪=object  : ADDRESS;
  3680. ⓪=objKind : dragObjectKind;
  3681. ⓪9VAR loc     : Point;
  3682. ⓪9VAR result  : targetObject);
  3683. ⓪"
  3684. ⓪"(*  scanTarget -- Scans at 'loc' for icons, wdws, etc. Looks only at objects
  3685. ⓪#*                that are interesting for 'objKind'.
  3686. ⓪#*                If a wdw entry is not interesting 'result.valid = FALSE'
  3687. ⓪#*                and if an icon is not interesting 'result.obj = Root'.
  3688. ⓪#*
  3689. ⓪#*    This proc.s logic depends strongly on the semantic of the shells objs.
  3690. ⓪#*)
  3691. ⓪ 
  3692. ⓪"PROCEDURE scanTarget (    loc      : Point;
  3693. ⓪<objKind  : dragObjectKind;
  3694. ⓪<oldResult: targetObject;
  3695. ⓪8VAR result   : targetObject);
  3696. ⓪ 
  3697. ⓪$VAR contSearch,
  3698. ⓪(isModul,
  3699. ⓪(onlyOne,
  3700. ⓪(foundDrive,
  3701. ⓪(foundWorkfile: BOOLEAN;
  3702. ⓪(d            : Drive;
  3703. ⓪(i            : CARDINAL;
  3704. ⓪(dirEntryPtr  : ptrDirEntry;
  3705. ⓪"
  3706. ⓪$BEGIN
  3707. ⓪&isModul := (objKind = modulDOK) OR (objKind = modulsDOK);
  3708. ⓪&onlyOne := (objKind = modulDOK) OR (objKind = fileDOK);
  3709. ⓪&WITH result DO
  3710. ⓪&
  3711. ⓪(kind := wdwTOK;
  3712. ⓪(detectWdws (loc, scanWL, 0, SpecialKeySet {}, MButtonSet {}, entry,
  3713. ⓪4slotPtr, contSearch);
  3714. ⓪(
  3715. ⓪(IF ~ contSearch THEN
  3716. ⓪(
  3717. ⓪*(*  'valid = TRUE' is only allowed, if entry is a subdirectory
  3718. ⓪+*  and there are files moved and subdir. is not selected yet,
  3719. ⓪+*  or if it is same entry as the last entry (within 'oldResult').
  3720. ⓪+*)
  3721. ⓪*IF slotPtr^.kind = dirWdw THEN
  3722. ⓪,dirEntryPtr := ptrDirEntry (entry);
  3723. ⓪,valid := NOT ((entry = NIL) OR ~ isSubdir (dirEntryPtr^.entry)
  3724. ⓪:OR isModul
  3725. ⓪:OR ((selectedWL IN EntryAttributesWL (slotPtr^.wl,
  3726. ⓪_entry))
  3727. ⓪>AND ((entry # oldResult.entry)
  3728. ⓪COR NOT oldResult.valid
  3729. ⓪COR (oldResult.kind # wdwTOK))
  3730. ⓪9) );
  3731. ⓪*ELSE valid := FALSE; entry := NIL END;
  3732. ⓪*
  3733. ⓪(ELSE
  3734. ⓪(
  3735. ⓪*kind := objTOK;
  3736. ⓪*obj := FindObject (desk, Root, MaxDepth, loc);
  3737. ⓪*searchDrive (obj, d, foundDrive);
  3738. ⓪*searchWorkfile (obj, i, foundWorkfile);
  3739. ⓪*IF (obj # Trash) AND
  3740. ⓪-(~ onlyOne OR (obj # Execute)) AND
  3741. ⓪-(isModul OR ~ foundDrive) AND
  3742. ⓪-((objKind # fileDOK) OR
  3743. ⓪.((obj # Edit) AND (obj # Compile) AND (obj # Link) AND
  3744. ⓪/(obj # Scan) AND (obj # Resident) AND (obj # Cfname) AND
  3745. ⓪/~ foundWorkfile
  3746. ⓪.)
  3747. ⓪-) THEN obj := Root END;
  3748. ⓪(END;
  3749. ⓪*
  3750. ⓪&END;
  3751. ⓪$END scanTarget;
  3752. ⓪"
  3753. ⓪"PROCEDURE toggleObj (loc: Point; object: ADDRESS);
  3754. ⓪"
  3755. ⓪$VAR selObjPtr: ptrSelObj;
  3756. ⓪"
  3757. ⓪$BEGIN
  3758. ⓪&selObjPtr := ptrSelObj (object);
  3759. ⓪&
  3760. ⓪&SetClipping (dev, deskSize);
  3761. ⓪&SetLineColor (dev, black);
  3762. ⓪&SetWritingMode (dev, xorWrt);
  3763. ⓪&SetLineType (dev, userLn);
  3764. ⓪&DefUserLine (dev, $5555);
  3765. ⓪&
  3766. ⓪&HideMouse;
  3767. ⓪&selObjPtr^.loc := loc;
  3768. ⓪&applyAtList (selObjPtr^.boxes, toggleSelectedBox, object, voidO);
  3769. ⓪&ShowMouse;
  3770. ⓪&
  3771. ⓪$END toggleObj;
  3772. ⓪$
  3773. ⓪"PROCEDURE notSame (trgObj1, trgObj2: targetObject): BOOLEAN;
  3774. ⓪"
  3775. ⓪$VAR res: BOOLEAN;
  3776. ⓪"
  3777. ⓪$BEGIN
  3778. ⓪&res := (trgObj1.kind # trgObj2.kind);
  3779. ⓪&IF ~ res THEN
  3780. ⓪(IF trgObj1.kind = objTOK THEN res := (trgObj1.obj # trgObj2.obj)
  3781. ⓪(ELSE res := (trgObj1.slotPtr # trgObj2.slotPtr) OR
  3782. ⓪4(trgObj1.entry   # trgObj2.entry)
  3783. ⓪(END;
  3784. ⓪&END;
  3785. ⓪&RETURN res
  3786. ⓪$END notSame;
  3787. ⓪$
  3788. ⓪$
  3789. ⓪"VAR   buts     : MButtonSet;
  3790. ⓪(specials : SpecialKeySet;
  3791. ⓪(
  3792. ⓪(oldLoc   : Point;
  3793. ⓪(oldResult: targetObject;
  3794. ⓪(
  3795. ⓪(deskSize : Rectangle;
  3796. ⓪"
  3797. ⓪"BEGIN
  3798. ⓪$MouseControl (TRUE);
  3799. ⓪$
  3800. ⓪$deskSize := DeskSize ();
  3801. ⓪$MouseKeyState (oldLoc, buts, specials);
  3802. ⓪$oldLoc := loc;
  3803. ⓪$oldResult.kind := objTOK;
  3804. ⓪$oldResult.obj := Root;
  3805. ⓪$
  3806. ⓪$toggleObj (MinPoint (objFrame), object);
  3807. ⓪$
  3808. ⓪$WHILE msBut1 IN buts DO
  3809. ⓪$
  3810. ⓪&IF (loc.x # oldLoc.x) OR (loc.y # oldLoc.y) THEN
  3811. ⓪"
  3812. ⓪(toggleObj (MinPoint (objFrame), object);
  3813. ⓪(
  3814. ⓪(objFrame.x := objFrame.x - oldLoc.x + loc.x;
  3815. ⓪(objFrame.y := objFrame.y - oldLoc.y + loc.y;
  3816. ⓪"
  3817. ⓪(WITH objFrame DO                           (* Rahmen innerhalb Desk! *)
  3818. ⓪*IF x < deskSize.x THEN x := deskSize.x END;
  3819. ⓪*IF y < deskSize.y THEN y := deskSize.y END;
  3820. ⓪*IF (x + w) > (deskSize.x + deskSize.w) THEN
  3821. ⓪,x := deskSize.x + deskSize.w - w END;
  3822. ⓪*IF (y + h) > (deskSize.y + deskSize.h) THEN
  3823. ⓪,y := deskSize.y + deskSize.h - h END;
  3824. ⓪(END;
  3825. ⓪(
  3826. ⓪(scanTarget (loc, objKind, oldResult, result);
  3827. ⓪(
  3828. ⓪(IF notSame (result, oldResult) THEN
  3829. ⓪*toggleTarget (oldResult, FALSE);
  3830. ⓪*toggleTarget (result, TRUE);
  3831. ⓪*oldResult := result;
  3832. ⓪(END;
  3833. ⓪$
  3834. ⓪(toggleObj (MinPoint (objFrame), object);
  3835. ⓪(oldLoc := loc;
  3836. ⓪(
  3837. ⓪&END;(*IF*)
  3838. ⓪"
  3839. ⓪&MouseKeyState (loc, buts, specials);
  3840. ⓪"
  3841. ⓪$END;(*WHILE*)
  3842. ⓪$
  3843. ⓪$toggleObj (MinPoint (objFrame), object);
  3844. ⓪$
  3845. ⓪$MouseControl (FALSE);
  3846. ⓪"END dragSensitive;
  3847. ⓪ 
  3848. ⓪ 
  3849. ⓪ TYPE    (*  Environment record for 'frameSelectedBox' and 'buildObject'.
  3850. ⓪)*)
  3851. ⓪(fBEnvRec        = RECORD
  3852. ⓪<wl    : WindowList;
  3853. ⓪<frame : Rectangle;
  3854. ⓪<selObj: ptrSelObj;
  3855. ⓪:END;
  3856. ⓪(ptrFBEnv        = POINTER TO fBEnvRec;
  3857. ⓪ 
  3858. ⓪ (*$Z-*)
  3859. ⓪ PROCEDURE frameSelectedBox (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;
  3860. ⓪ (*$Z=*)
  3861. ⓪ 
  3862. ⓪"VAR   framerEnv: ptrFBEnv;
  3863. ⓪(box      : Rectangle;
  3864. ⓪ 
  3865. ⓪"BEGIN
  3866. ⓪$IF selectedWL IN attrs THEN
  3867. ⓪$
  3868. ⓪&framerEnv := ptrFBEnv (env);
  3869. ⓪&
  3870. ⓪&GetEntryBoxWL (framerEnv^.wl, entry, box, voidO);
  3871. ⓪&box.w := box.w DIV INTEGER (dirWdwWidth) * INTEGER (dirVisibleWidth);
  3872. ⓪&IF framerEnv^.frame.h = 0 THEN framerEnv^.frame := box
  3873. ⓪&ELSE
  3874. ⓪(framerEnv^.frame := FrameRects (framerEnv^.frame, box)
  3875. ⓪&END;
  3876. ⓪&
  3877. ⓪$END;
  3878. ⓪$
  3879. ⓪$RETURN TRUE
  3880. ⓪"END frameSelectedBox;
  3881. ⓪ 
  3882. ⓪ (*$Z-*)
  3883. ⓪ PROCEDURE buildObject (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;
  3884. ⓪ (*$Z=*)
  3885. ⓪ 
  3886. ⓪"VAR   builderEnv: ptrFBEnv;
  3887. ⓪(box       : Rectangle;
  3888. ⓪(data      : ptrRectangle;
  3889. ⓪(err       : BOOLEAN;
  3890. ⓪(
  3891. ⓪"BEGIN
  3892. ⓪$builderEnv := ptrFBEnv (env);
  3893. ⓪$
  3894. ⓪$IF selectedWL IN attrs THEN WITH builderEnv^ DO
  3895. ⓪$
  3896. ⓪&GetEntryBoxWL (wl, entry, box, voidO);
  3897. ⓪&
  3898. ⓪&NEW (data);
  3899. ⓪&IF data = NIL THEN RETURN FALSE END;
  3900. ⓪&WITH box DO
  3901. ⓪(data^ := Rect (x - selObj^.loc.x, y - selObj^.loc.y,
  3902. ⓪7w DIV INTEGER (dirWdwWidth) * INTEGER (dirVisibleWidth),
  3903. ⓪7h);
  3904. ⓪&END;
  3905. ⓪&AppendEntry (selObj^.boxes, data, err);
  3906. ⓪&IF err THEN DISPOSE (data); RETURN FALSE END;
  3907. ⓪&
  3908. ⓪$END END;
  3909. ⓪&
  3910. ⓪$RETURN TRUE
  3911. ⓪"END buildObject;
  3912. ⓪"
  3913. ⓪ PROCEDURE moveFileModul (    slotPtr: ptrWdwSlot;
  3914. ⓪=which  : dragObjectKind;
  3915. ⓪=loc    : Point;
  3916. ⓪9VAR result : targetObject;
  3917. ⓪9VAR success: BOOLEAN);
  3918. ⓪9
  3919. ⓪"VAR   fBEnv : fBEnvRec;
  3920. ⓪(
  3921. ⓪(err   : BOOLEAN;
  3922. ⓪"
  3923. ⓪"BEGIN
  3924. ⓪$WITH slotPtr^ DO IF noSelected > 0 THEN
  3925. ⓪$
  3926. ⓪&fBEnv.wl := wl;
  3927. ⓪&fBEnv.frame.h := 0;
  3928. ⓪&QueryListWL (wl, forwardWL, frameSelectedBox, ADR (fBEnv),
  3929. ⓪3voidO, voidADR);
  3930. ⓪&
  3931. ⓪&NEW (fBEnv.selObj); success := (fBEnv.selObj # NIL);
  3932. ⓪&IF success THEN
  3933. ⓪(CreateList (fBEnv.selObj^.boxes, err); success := ~ err;
  3934. ⓪(IF NOT success THEN DISPOSE (fBEnv.selObj) END;
  3935. ⓪&END;
  3936. ⓪&IF err THEN reportOutOfMemory; RETURN END;
  3937. ⓪&fBEnv.selObj^.loc := MinPoint (fBEnv.frame);
  3938. ⓪&QueryListWL (wl, forwardWL, buildObject, ADR (fBEnv), voidO, voidADR);
  3939. ⓪&
  3940. ⓪&dragSensitive (fBEnv.frame, fBEnv.selObj, which, loc, result);
  3941. ⓪&
  3942. ⓪&deleteSimpleList (fBEnv.selObj^.boxes, TRUE);
  3943. ⓪&DISPOSE (fBEnv.selObj);
  3944. ⓪&
  3945. ⓪$END END;
  3946. ⓪"END moveFileModul;
  3947. ⓪"
  3948. ⓪ 
  3949. ⓪8(*  misc. II  *)
  3950. ⓪8(*  ========  *)
  3951. ⓪ 
  3952. ⓪ PROCEDURE enableAndDisableMenuItems;
  3953. ⓪ 
  3954. ⓪"VAR   slot            : wdwSlotIdx;
  3955. ⓪(aDirWdwIsOpen,
  3956. ⓪(aModWdwIsOpen,
  3957. ⓪(aTopWdw,
  3958. ⓪(bothOpen        : BOOLEAN;
  3959. ⓪(kindOfName      : nameKind;
  3960. ⓪ 
  3961. ⓪"BEGIN
  3962. ⓪$scanSlots (isDirWdw, slot, aDirWdwIsOpen);
  3963. ⓪$scanSlots (isModWdw, slot, aModWdwIsOpen);
  3964. ⓪$scanSlots (isTopWdw, slot, aTopWdw);
  3965. ⓪$
  3966. ⓪$bothOpen := (aDirWdwIsOpen OR aModWdwIsOpen);
  3967. ⓪$
  3968. ⓪$EnableItem (menu,Mdclose, bothOpen);
  3969. ⓪$EnableItem (menu,Mdclosew, bothOpen);
  3970. ⓪$EnableItem (menu,Mdfolder, aTopWdw AND (wdws[slot]^.kind = dirWdw));
  3971. ⓪$
  3972. ⓪$getSelectedName (void128, voidSlot, kindOfName);
  3973. ⓪$
  3974. ⓪$EnableItem (menu,Mdinfo, (kindOfName = fileNK)
  3975. ⓪=OR (kindOfName = folderNK)
  3976. ⓪=OR (selectedDrive # defaultDrv));
  3977. ⓪$
  3978. ⓪$EnableItem (menu,Mdnwork, WorkField.noUsed < maxWorkFiles);
  3979. ⓪$EnableItem (menu,Mdkwork, WorkField.current # noCurrentWorkfile);
  3980. ⓪"END enableAndDisableMenuItems;
  3981. ⓪ 
  3982. ⓪0(*  Arbeitende Routinen  *)
  3983. ⓪0(*  ===================  *)
  3984. ⓪ 
  3985. ⓪ FORWARD HideSS (complete: BOOLEAN);
  3986. ⓪ FORWARD ShowSS (isCompleteHidden: BOOLEAN);
  3987. ⓪ 
  3988. ⓪ (*  selectWorkfile -- Selects another work file object. Only used slots would
  3989. ⓪!*                    be selected.
  3990. ⓪!*)
  3991. ⓪!
  3992. ⓪ PROCEDURE selectWorkfile (i: INTEGER);
  3993. ⓪ 
  3994. ⓪"VAR   old: INTEGER;
  3995. ⓪ 
  3996. ⓪"BEGIN
  3997. ⓪$IF ~ WorkField.elems[i].used THEN i := noCurrentWorkfile END;
  3998. ⓪$old := WorkField.current;
  3999. ⓪$WorkField.current := i;
  4000. ⓪$IF old >= 0 THEN redrawWorkfile (old) END;
  4001. ⓪$IF i >= 0 THEN redrawWorkfile (i) END;
  4002. ⓪"END selectWorkfile;
  4003. ⓪ 
  4004. ⓪ (*  makeNewWorkfile -- Tries to make another work file object.
  4005. ⓪!*)
  4006. ⓪!
  4007. ⓪ PROCEDURE makeNewWorkfile;
  4008. ⓪ 
  4009. ⓪"VAR   i    : CARDINAL;
  4010. ⓪(
  4011. ⓪"BEGIN
  4012. ⓪$animateMenuTitle (Mdatei, voidFrame);
  4013. ⓪$
  4014. ⓪$(*  find free slot.
  4015. ⓪%*)
  4016. ⓪$(* wir wollen mit Nr. 1 anfangen, erst nach Nr. 9 soll Nr. 0 kommen *)
  4017. ⓪$i := 1;
  4018. ⓪$WHILE (i <= maxWorkFiles) AND WorkField.elems[i MOD 10].used DO INC (i) END;
  4019. ⓪$IF i = 10 THEN i:= 0 END;
  4020. ⓪$
  4021. ⓪$IF i < maxWorkFiles THEN    (*  if found, then init. slot  *)
  4022. ⓪$
  4023. ⓪&INC (WorkField.noUsed);
  4024. ⓪&WITH WorkField.elems[i] DO
  4025. ⓪(used := TRUE;
  4026. ⓪(sourceName := '';
  4027. ⓪(codeName := '';
  4028. ⓪&END;
  4029. ⓪&selectWorkfile (i);
  4030. ⓪&
  4031. ⓪$ELSE
  4032. ⓪&doAlert (noNewWorkAlt)
  4033. ⓪$END;
  4034. ⓪$
  4035. ⓪$deAnimateMenuTitle (Mdatei);
  4036. ⓪"END makeNewWorkfile;
  4037. ⓪ 
  4038. ⓪ (*  killWorkfile -- Releases the current workfile object.
  4039. ⓪!*)
  4040. ⓪ 
  4041. ⓪ PROCEDURE killWorkfile;
  4042. ⓪ 
  4043. ⓪"BEGIN
  4044. ⓪$animateMenuTitle (Mdatei, voidFrame);
  4045. ⓪$
  4046. ⓪$WITH WorkField DO
  4047. ⓪&IF current # noCurrentWorkfile THEN
  4048. ⓪&
  4049. ⓪(DEC (noUsed);
  4050. ⓪(elems[current].used := FALSE;
  4051. ⓪(redrawWorkfile (current);
  4052. ⓪(current := noCurrentWorkfile;
  4053. ⓪(
  4054. ⓪&END;
  4055. ⓪$END;
  4056. ⓪&
  4057. ⓪$deAnimateMenuTitle (Mdatei);
  4058. ⓪"END killWorkfile;
  4059. ⓪#
  4060. ⓪ PROCEDURE saveParameter;
  4061. ⓪ 
  4062. ⓪"VAR   but: CARDINAL;
  4063. ⓪ 
  4064. ⓪"BEGIN
  4065. ⓪$FormAlert (1, parmSaveAlt^, but);
  4066. ⓪$IF but = 1 THEN SaveParameter END;
  4067. ⓪"END saveParameter;
  4068. ⓪ 
  4069. ⓪ PROCEDURE makeFolder;
  4070. ⓪ 
  4071. ⓪"VAR   ok,
  4072. ⓪(success: BOOLEAN;
  4073. ⓪(name   : Str128;
  4074. ⓪(slot   : wdwSlotIdx;
  4075. ⓪(result : INTEGER;
  4076. ⓪ 
  4077. ⓪"BEGIN
  4078. ⓪$IF ObjectStateElem (menu, Mdfolder, disableObj) THEN RETURN END;
  4079. ⓪$
  4080. ⓪$AESUpdateWindow (TRUE);
  4081. ⓪$name := '';
  4082. ⓪$doFNameBox (requestFolderName, name, ok);
  4083. ⓪$IF ok THEN
  4084. ⓪$
  4085. ⓪&scanSlots (isTopWdw, slot, success);
  4086. ⓪&IF ~ success THEN
  4087. ⓪(AESUpdateWindow (FALSE);
  4088. ⓪(RETURN
  4089. ⓪&END;
  4090. ⓪&concatPath (wdws[slot]^.path, name, name, success);
  4091. ⓪&IF ~ success THEN AESUpdateWindow (FALSE); RETURN END;
  4092. ⓪&
  4093. ⓪&ShowBee;
  4094. ⓪&CreateDir (name, result); FileAlert (result);
  4095. ⓪&ShowArrow;
  4096. ⓪&
  4097. ⓪&updateWdw (wdws[slot]);
  4098. ⓪&
  4099. ⓪$END;
  4100. ⓪$AESUpdateWindow (FALSE);
  4101. ⓪"END makeFolder;
  4102. ⓪ 
  4103. ⓪ PROCEDURE inform;
  4104. ⓪ 
  4105. ⓪"VAR   spc          : LONGCARD;
  4106. ⓪(slot         : wdwSlotIdx;
  4107. ⓪(name         : Str128;
  4108. ⓪(kindOfName   : nameKind;
  4109. ⓪ 
  4110. ⓪"BEGIN
  4111. ⓪$AESUpdateWindow (TRUE);
  4112. ⓪$IF selectedDrive # defaultDrv THEN          (*  drive info  *)
  4113. ⓪&ShowBee; spc := FreeSpace (MOSGlobals.Drive(selectedDrive)); ShowArrow;
  4114. ⓪&flexAlert (1, DriveToStr (MOSGlobals.Drive(selectedDrive)),
  4115. ⓪(CardToStr (spc, 0), drvSpaceMsg, voidC);
  4116. ⓪$ELSE
  4117. ⓪&getSelectedName (name, slot, kindOfName);
  4118. ⓪&IF (kindOfName=fileNK) OR (kindOfName=folderNK) THEN  (* file info *)
  4119. ⓪(FileInformation (name, doFileInfoBox, FileAlert);
  4120. ⓪(updateWdw (wdws[slot]);
  4121. ⓪&END;
  4122. ⓪$END;
  4123. ⓪$AESUpdateWindow (FALSE);
  4124. ⓪"END inform;
  4125. ⓪ 
  4126. ⓪ (*$Z-*)
  4127. ⓪ PROCEDURE addEntryToList (entry, env: ADDRESS; VAR attrs: AttributesWL): BOOLEAN;
  4128. ⓪ (*$Z=*)
  4129. ⓪ 
  4130. ⓪"VAR   dirEntryPtr: ptrDirEntry;
  4131. ⓪(listPtr    : ptrList;
  4132. ⓪(err        : BOOLEAN;
  4133. ⓪ 
  4134. ⓪"BEGIN
  4135. ⓪$dirEntryPtr := ptrDirEntry (entry);
  4136. ⓪$listPtr := ptrList (env);
  4137. ⓪$
  4138. ⓪$IF selectedWL IN attrs
  4139. ⓪$THEN
  4140. ⓪&AppendEntry (listPtr^, ADR (dirEntryPtr^.entry.name), err)
  4141. ⓪$ELSE err := FALSE END;
  4142. ⓪$
  4143. ⓪$RETURN ~ err
  4144. ⓪"END addEntryToList;
  4145. ⓪ 
  4146. ⓪ PROCEDURE showCopyStatus (noFiles: CARDINAL; VAR stop: BOOLEAN);
  4147. ⓪ 
  4148. ⓪"VAR   ch   : GemChar;
  4149. ⓪(valid: BOOLEAN;
  4150. ⓪ 
  4151. ⓪"BEGIN
  4152. ⓪$IF shellParm.confirmCopy THEN
  4153. ⓪&SetGetBoxCard (confirmBox, Conumber, setValue, noFiles);
  4154. ⓪&drawObject (confirmBox, Conumber);
  4155. ⓪$END;
  4156. ⓪$
  4157. ⓪$busyReadGemChar (ch, valid);
  4158. ⓪$stop := valid AND (ch.scan = undoKey);
  4159. ⓪"END showCopyStatus;
  4160. ⓪"
  4161. ⓪ PROCEDURE showDeleteStatus (noFiles: CARDINAL; VAR stop: BOOLEAN);
  4162. ⓪ 
  4163. ⓪"VAR   ch   : GemChar;
  4164. ⓪(valid: BOOLEAN;
  4165. ⓪ 
  4166. ⓪"BEGIN
  4167. ⓪$IF shellParm.confirmDelete THEN
  4168. ⓪&SetGetBoxCard (confirmBox, Conumber, setValue, noFiles);
  4169. ⓪&drawObject (confirmBox, Conumber);
  4170. ⓪$END;
  4171. ⓪$
  4172. ⓪$busyReadGemChar (ch, valid);
  4173. ⓪$stop := valid AND (ch.scan = undoKey);
  4174. ⓪"END showDeleteStatus;
  4175. ⓪"
  4176. ⓪ TYPE    copyDeleteMode  = (copyCDM, deleteCDM);
  4177. ⓪ 
  4178. ⓪ PROCEDURE prepareCopyAndDelete (    slotPtr: ptrWdwSlot;
  4179. ⓪Dmode   : copyDeleteMode;
  4180. ⓪@VAR files  : List;
  4181. ⓪@VAR noFiles: CARDINAL;
  4182. ⓪@VAR space  : Rectangle;
  4183. ⓪@VAR ok     : BOOLEAN;
  4184. ⓪@VAR err    : BOOLEAN);
  4185. ⓪ 
  4186. ⓪"VAR   exitBut: CARDINAL;
  4187. ⓪ 
  4188. ⓪"BEGIN
  4189. ⓪$WITH slotPtr^ DO
  4190. ⓪&CreateList (files, err);
  4191. ⓪&IF err THEN reportOutOfMemory; RETURN END;
  4192. ⓪&QueryListWL (wl, forwardWL, addEntryToList, ADR (files), err, voidADR);
  4193. ⓪&IF err THEN deleteList (files); reportOutOfMemory; RETURN END;
  4194. ⓪&
  4195. ⓪&IF ((mode = copyCDM) AND shellParm.confirmCopy)
  4196. ⓪)OR ((mode = deleteCDM) AND shellParm.confirmDelete) THEN
  4197. ⓪)
  4198. ⓪(ShowBee;
  4199. ⓪(CountFilesAndDirs (path, files, noFiles);
  4200. ⓪(
  4201. ⓪(SetCurrObjTree (confirmBox, FALSE);
  4202. ⓪(hideObj (Cocopy, mode = deleteCDM); hideObj (Codelete, mode = copyCDM);
  4203. ⓪(hideObj (Cook, FALSE); hideObj (Coquit, FALSE);
  4204. ⓪(hideObj (Cowork, TRUE);
  4205. ⓪(SetGetBoxCard (confirmBox, Conumber, setValue, noFiles);
  4206. ⓪(
  4207. ⓪(PrepareBox (confirmBox, Rect (-1, -1, -1, -1), space);
  4208. ⓪(formDo (confirmBox, Root, exitBut);
  4209. ⓪(DeselectButton (confirmBox, exitBut);
  4210. ⓪(ok := (exitBut = Cook);
  4211. ⓪(
  4212. ⓪(IF ok THEN
  4213. ⓪*SetCurrObjTree (confirmBox, FALSE);
  4214. ⓪*hideAndRedrawObj (Cook, TRUE); hideAndRedrawObj (Coquit, TRUE);
  4215. ⓪*hideAndRedrawObj (Cowork, FALSE);
  4216. ⓪(END;
  4217. ⓪&
  4218. ⓪&ELSE noFiles := 0; ok := TRUE END;
  4219. ⓪$END;
  4220. ⓪$ShowBee;
  4221. ⓪"END prepareCopyAndDelete;
  4222. ⓪ 
  4223. ⓪ PROCEDURE copyFiles (slotPtr  : ptrWdwSlot;
  4224. ⓪5REF destPath : ARRAY OF CHAR;
  4225. ⓪5deleteOld: BOOLEAN);
  4226. ⓪ 
  4227. ⓪"VAR   files  : List;
  4228. ⓪(noFiles: CARDINAL;
  4229. ⓪(ok, err: BOOLEAN;
  4230. ⓪(space  : Rectangle;
  4231. ⓪ 
  4232. ⓪"BEGIN
  4233. ⓪$prepareCopyAndDelete (slotPtr, copyCDM, files, noFiles, space, ok, err);
  4234. ⓪$IF err THEN RETURN END;
  4235. ⓪$IF ok THEN
  4236. ⓪&CopyFiles (slotPtr^.path, files, noFiles, destPath,
  4237. ⓪1deleteOld, shellParm.useAllMemForCopy,
  4238. ⓪1doConflictBox, showCopyStatus, FileAlert);
  4239. ⓪$END;
  4240. ⓪$IF shellParm.confirmCopy THEN
  4241. ⓪&ReleaseBox (confirmBox, Rect (-1, -1, -1, -1), space)
  4242. ⓪$END;
  4243. ⓪$deleteList (files);
  4244. ⓪$ShowArrow;
  4245. ⓪"END copyFiles;
  4246. ⓪ 
  4247. ⓪ PROCEDURE deleteFiles (slotPtr: ptrWdwSlot);
  4248. ⓪ 
  4249. ⓪"VAR   files  : List;
  4250. ⓪(noFiles: CARDINAL;
  4251. ⓪(ok, err: BOOLEAN;
  4252. ⓪(space  : Rectangle;
  4253. ⓪ 
  4254. ⓪"BEGIN
  4255. ⓪$prepareCopyAndDelete (slotPtr, deleteCDM, files, noFiles, space, ok, err);
  4256. ⓪$IF err THEN RETURN END;
  4257. ⓪$IF ok THEN
  4258. ⓪&DeleteFiles (slotPtr^.path, files, noFiles, showDeleteStatus, FileAlert);
  4259. ⓪$END;
  4260. ⓪$IF shellParm.confirmDelete THEN
  4261. ⓪&ReleaseBox (confirmBox, Rect (-1, -1, -1, -1), space)
  4262. ⓪$END;
  4263. ⓪$deleteList (files);
  4264. ⓪$ShowArrow;
  4265. ⓪"END deleteFiles;
  4266. ⓪ 
  4267. ⓪ (*  actManager -- Prepares the shell to execute a shell action and then calls
  4268. ⓪!*                the 'action' procedure in the outer module.
  4269. ⓪!*
  4270. ⓪!*                'obj'       -- Desktop object associated with the desired
  4271. ⓪!*                               action.
  4272. ⓪!*                'specials'  -- Special keys pressed at action selection time.
  4273. ⓪!*                'work'      -- Parameter of the action is a work file?
  4274. ⓪!*                'tool'      -- Is a executed file a tool? (to set the correct
  4275. ⓪!*                               path in 'call')
  4276. ⓪!*                'alsoExec'  -- Also excecute code after compilation?
  4277. ⓪!*)
  4278. ⓪"
  4279. ⓪ PROCEDURE actManager (obj     : CARDINAL;
  4280. ⓪6specials: SpecialKeySet;
  4281. ⓪6work,
  4282. ⓪6tool,
  4283. ⓪6alsoExec: BOOLEAN);
  4284. ⓪ 
  4285. ⓪"PROCEDURE assignMsg (REF name: ARRAY OF CHAR);
  4286. ⓪$BEGIN
  4287. ⓪&truncCopyString (name, msgStrLen, msgStr);
  4288. ⓪$END assignMsg;
  4289. ⓪ 
  4290. ⓪"PROCEDURE setSourceCurrFnAndMsg;
  4291. ⓪$BEGIN
  4292. ⓪&IF ~work AND (currFn[0]='') THEN
  4293. ⓪(currFn := lastFn;
  4294. ⓪&END;
  4295. ⓪&IF work THEN
  4296. ⓪(WITH WorkField DO
  4297. ⓪*IF current >= 0 THEN assignMsg (elems[current].sourceName)
  4298. ⓪*ELSE msgStr := '' END;
  4299. ⓪(END;
  4300. ⓪&ELSE assignMsg (currFn) END;
  4301. ⓪$END setSourceCurrFnAndMsg;
  4302. ⓪$
  4303. ⓪"PROCEDURE setCodeCurrFnAndMsg;
  4304. ⓪$BEGIN
  4305. ⓪&IF ~work AND (currFn[0]='') THEN
  4306. ⓪(currFn := CodeName;
  4307. ⓪&END;
  4308. ⓪&IF work THEN
  4309. ⓪(WITH WorkField DO
  4310. ⓪*IF current # noCurrentWorkfile THEN
  4311. ⓪,assignMsg (elems[current].codeName)
  4312. ⓪*ELSE msgStr := '' END;
  4313. ⓪(END;
  4314. ⓪&ELSE assignMsg (currFn) END;
  4315. ⓪$END setCodeCurrFnAndMsg;
  4316. ⓪"
  4317. ⓪"TYPE  testProc        = PROCEDURE (REF (* name: *) ARRAY OF CHAR): BOOLEAN;
  4318. ⓪$
  4319. ⓪"PROCEDURE testWorkAndCurrFn ((*$Z-*)test: testProc(*$Z=*)): BOOLEAN;
  4320. ⓪$BEGIN
  4321. ⓪&WITH WorkField DO
  4322. ⓪(IF work AND (current = noCurrentWorkfile) THEN RETURN FALSE
  4323. ⓪(ELSE
  4324. ⓪*RETURN (work AND test (elems[current].sourceName)) OR test (currFn)
  4325. ⓪(END;
  4326. ⓪&END;
  4327. ⓪$END testWorkAndCurrFn;
  4328. ⓪$
  4329. ⓪"VAR slot       : wdwSlotIdx;
  4330. ⓪&wasSelected: BOOLEAN;
  4331. ⓪ 
  4332. ⓪"BEGIN
  4333. ⓪$selectDeskObj (obj, TRUE, wasSelected);
  4334. ⓪$CASE obj OF
  4335. ⓪&Compile  : setSourceCurrFnAndMsg;
  4336. ⓪1IF testWorkAndCurrFn (isMakeFile) THEN
  4337. ⓪3IF alsoExec THEN action (doMkEx, work, tool)
  4338. ⓪3ELSE action (doMake, work, tool) END;
  4339. ⓪1ELSE
  4340. ⓪3IF alsoExec THEN action (doCpEx, work, tool)
  4341. ⓪3ELSE action (doComp, work, tool) END;
  4342. ⓪1END|
  4343. ⓪&Edit     : setSourceCurrFnAndMsg; action (doEdit, work, tool)|
  4344. ⓪&Execute  : setCodeCurrFnAndMsg;
  4345. ⓪1Assign (lastFn, TextName, voidO);
  4346. ⓪1IF ~ work AND IsSourceName (currFn) THEN
  4347. ⓪3assignMsg (currFn);
  4348. ⓪3action (doExec, work, tool);
  4349. ⓪1ELSE
  4350. ⓪3IF testWorkAndCurrFn (IsMBTFile)    (*  exec. Batch-File  *) THEN
  4351. ⓪5action (doBtch, work, tool);
  4352. ⓪3ELSIF testWorkAndCurrFn (isMSPFile) (*  exec. Parm.-File  *) THEN
  4353. ⓪5action (doParm, work, tool);
  4354. ⓪3ELSIF testWorkAndCurrFn (isMakeFile)(*  exec. Make-File  *) THEN
  4355. ⓪5action (doMkEx, work, tool);
  4356. ⓪3ELSE                                (*  exec. norm. code  *)
  4357. ⓪5IF withShift (specials) THEN
  4358. ⓪7RequestArg (lastArgs);
  4359. ⓪7args := lastArgs;
  4360. ⓪5ELSE
  4361. ⓪7args := '';
  4362. ⓪5END;
  4363. ⓪5noDirChange := withAlt (specials);
  4364. ⓪5action (doExec, work, tool);
  4365. ⓪5noDirChange := FALSE;
  4366. ⓪3END;
  4367. ⓪1END;
  4368. ⓪1Assign (TextName, lastFn, voidO)|
  4369. ⓪&Link     : setCodeCurrFnAndMsg; action (doLink, work, tool)|
  4370. ⓪&
  4371. ⓪&Scan     : setSourceCurrFnAndMsg;
  4372. ⓪1IF (ChainDepth < 0) OR ~ withShift (specials) THEN
  4373. ⓪3IF doScanBox () THEN
  4374. ⓪5action (doScan, work, tool);
  4375. ⓪3END;
  4376. ⓪1ELSE msgStr := ''; action (doCont, TRUE, tool) END|
  4377. ⓪1
  4378. ⓪&Resident : setCodeCurrFnAndMsg;
  4379. ⓪1IF work THEN
  4380. ⓪3openModWdw (slot, withAlt (specials))
  4381. ⓪1ELSE
  4382. ⓪3AESUpdateWindow (TRUE);
  4383. ⓪3HideSS (FALSE);
  4384. ⓪3TellLoading (initTell, '');
  4385. ⓪3action (doLoad, FALSE, tool);
  4386. ⓪3TellLoading (endTell, '');
  4387. ⓪3ShowSS (FALSE);
  4388. ⓪3scanSlots (updateModWdw, voidSlot, voidO);
  4389. ⓪3AESUpdateWindow (FALSE);
  4390. ⓪1END|
  4391. ⓪$ELSE
  4392. ⓪$END;
  4393. ⓪$IF ~ wasSelected THEN selectDeskObj (obj, FALSE, voidO) END;
  4394. ⓪"END actManager;
  4395. ⓪9
  4396. ⓪ PROCEDURE executeTool (i: CARDINAL; specials: SpecialKeySet);
  4397. ⓪ 
  4398. ⓪"VAR   code: FileStr;
  4399. ⓪ 
  4400. ⓪"BEGIN
  4401. ⓪$IF ToolField[i].used AND NOT Empty (ToolField[i].name) THEN
  4402. ⓪&currFn := ToolField[i].name;
  4403. ⓪&code := CodeName;           (* Akt. Code-Datei retten *)
  4404. ⓪&actManager (Execute, specials, FALSE, TRUE, FALSE);
  4405. ⓪&CodeName := code;           (* Akt. Code-Datei wiederherstellen *)
  4406. ⓪$END;
  4407. ⓪"END executeTool;
  4408. ⓪ 
  4409. ⓪ PROCEDURE editDocu (specials: SpecialKeySet);
  4410. ⓪ 
  4411. ⓪"VAR   oldText, oldLast: FileStr;
  4412. ⓪"
  4413. ⓪"BEGIN
  4414. ⓪$animateMenuTitle (Minfo, voidFrame);
  4415. ⓪$
  4416. ⓪$ConcatName (shellParm.parameterPath, suf[m2d], currFn);
  4417. ⓪$oldText := TextName;
  4418. ⓪$oldLast := lastFn;
  4419. ⓪$actManager (Edit, specials, FALSE, FALSE, FALSE);
  4420. ⓪$TextName := oldText;
  4421. ⓪$lastFn := oldLast;
  4422. ⓪$
  4423. ⓪$deAnimateMenuTitle (Minfo);
  4424. ⓪"END editDocu;
  4425. ⓪"
  4426. ⓪ 
  4427. ⓪ CONST   maxObjsElem             = 1023;
  4428. ⓪ 
  4429. ⓪ TYPE    loadAndUnloadMode       = (loadModuls, unloadModuls);
  4430. ⓪(loadAndUnloadEnv        = RECORD
  4431. ⓪(
  4432. ⓪Dmode: loadAndUnloadMode;
  4433. ⓪D
  4434. ⓪D(*  Storage area for the obj. names.
  4435. ⓪E*  Seperated through '0C's. 'free'
  4436. ⓪E*  points to the next free elem.
  4437. ⓪E*)
  4438. ⓪Dobjs: ARRAY[0..maxObjsElem] OF CHAR;
  4439. ⓪Dfree: CARDINAL;
  4440. ⓪D
  4441. ⓪BEND;
  4442. ⓪(ptrLoadAndUnloadEnv     = POINTER TO loadAndUnloadEnv;
  4443. ⓪ 
  4444. ⓪ (*$Z-*)
  4445. ⓪ PROCEDURE loadAndUnloadOneModul (    entry,
  4446. ⓪Eenv   : ADDRESS;
  4447. ⓪AVAR attrs : AttributesWL): BOOLEAN;
  4448. ⓪ (*$Z=*)
  4449. ⓪ 
  4450. ⓪"VAR   envPtr          : ptrLoadAndUnloadEnv;
  4451. ⓪(dirEntryPtr     : ptrDirEntry;
  4452. ⓪(modEntryPtr     : ptrModEntry;
  4453. ⓪(l, i            : CARDINAL;
  4454. ⓪ 
  4455. ⓪"BEGIN
  4456. ⓪$envPtr := ptrLoadAndUnloadEnv (env);
  4457. ⓪$
  4458. ⓪$IF selectedWL IN attrs
  4459. ⓪$THEN
  4460. ⓪&WITH envPtr^ DO
  4461. ⓪&
  4462. ⓪(IF mode = loadModuls THEN               (*  laden  *)
  4463. ⓪&
  4464. ⓪*dirEntryPtr := ptrDirEntry (entry);
  4465. ⓪*l := Length (dirEntryPtr^.entry.name);
  4466. ⓪*IF (l + free) > maxObjsElem THEN RETURN FALSE END;
  4467. ⓪*FOR i := 0 TO l - 1 DO
  4468. ⓪,objs[free] := dirEntryPtr^.entry.name[i];
  4469. ⓪,INC (free);
  4470. ⓪*END;
  4471. ⓪*objs[free] := 0C;
  4472. ⓪*INC (free);
  4473. ⓪*(*Insert (dirEntryPtr^.entry.name, free, objs); is wohl put*)
  4474. ⓪*
  4475. ⓪(ELSE                                    (*  löschen  *)
  4476. ⓪(
  4477. ⓪*modEntryPtr := ptrModEntry (entry);
  4478. ⓪*l := Length (modEntryPtr^.name);
  4479. ⓪*IF (l + free) > maxObjsElem THEN RETURN FALSE END;
  4480. ⓪*FOR i := 0 TO l - 1 DO
  4481. ⓪,objs[free] := modEntryPtr^.name[i];
  4482. ⓪,INC (free);
  4483. ⓪*END;
  4484. ⓪*objs[free] := 0C;
  4485. ⓪*INC (free);
  4486. ⓪*(*Insert (modEntryPtr^.name, free, objs); is wohl put*)
  4487. ⓪*
  4488. ⓪(END;
  4489. ⓪((*INC (free, l + 1);    (*  '0C' nicht vergessen  *)*)
  4490. ⓪(
  4491. ⓪&END;
  4492. ⓪$END;
  4493. ⓪$
  4494. ⓪$RETURN TRUE
  4495. ⓪"END loadAndUnloadOneModul;
  4496. ⓪ 
  4497. ⓪ PROCEDURE loadAndUnload (slotPtr: ptrWdwSlot; mode: loadAndUnloadMode);
  4498. ⓪ 
  4499. ⓪"VAR   env     : loadAndUnloadEnv;
  4500. ⓪(str     : ARRAY[0..79] OF CHAR;
  4501. ⓪(i, j    : CARDINAL;
  4502. ⓪(err,
  4503. ⓪(success : BOOLEAN;
  4504. ⓪ 
  4505. ⓪"BEGIN
  4506. ⓪$env.mode := mode;
  4507. ⓪$env.free := 0;
  4508. ⓪$QueryListWL (slotPtr^.wl, forwardWL, loadAndUnloadOneModul, ADR (env),
  4509. ⓪1err, voidADR);
  4510. ⓪$IF err THEN doAlert (loadFailedAlt); RETURN END;
  4511. ⓪$
  4512. ⓪$AESUpdateWindow (TRUE);
  4513. ⓪$HideSS (FALSE);
  4514. ⓪$IF mode = loadModuls THEN TellLoading (initTell, '') END;
  4515. ⓪$
  4516. ⓪$i := 0;
  4517. ⓪$j := 0;
  4518. ⓪$WHILE j < env.free DO
  4519. ⓪&str[i] := env.objs[j];
  4520. ⓪&INC (i);
  4521. ⓪&IF env.objs[j] = 0C THEN
  4522. ⓪(IF mode = loadModuls THEN
  4523. ⓪*TellLoading (newTellValue, str);
  4524. ⓪*concatPath (slotPtr^.path, str, currFn, success);
  4525. ⓪*IF success THEN action (doLoad, FALSE, FALSE) END;
  4526. ⓪(ELSE
  4527. ⓪*Assign (str, currFn, voidO);
  4528. ⓪*action (doUnLd, FALSE, FALSE);
  4529. ⓪(END;(*ELSE*)
  4530. ⓪(i := 0;
  4531. ⓪&END;(*IF*)
  4532. ⓪&INC (j);
  4533. ⓪$END;(*WHILE*)
  4534. ⓪$IF mode = loadModuls THEN TellLoading (endTell, '') END;
  4535. ⓪&
  4536. ⓪$ShowSS (FALSE);
  4537. ⓪$scanSlots (updateModWdw, voidSlot, voidO);  (*  mod. wdws updaten  *)
  4538. ⓪$AESUpdateWindow (FALSE);
  4539. ⓪"END loadAndUnload;
  4540. ⓪!
  4541. ⓪ 
  4542. ⓪0(*  Routinen zur De-/Aktivierung der ShellShell  *)
  4543. ⓪0(*  ===========================================  *)
  4544. ⓪"
  4545. ⓪ PROCEDURE ClearDeskAndShowMsg;
  4546. ⓪ 
  4547. ⓪"BEGIN
  4548. ⓪$MenuBar (NIL, FALSE);
  4549. ⓪$SetNewDesk (NIL, Root);
  4550. ⓪$ForceDeskRedraw;
  4551. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  4552. ⓪&(* MS unter MultiGEM nichts in Menüleise zeichnen *)
  4553. ⓪&DrawObject (msgBar, Root, MaxDepth, ObjectSpaceWithAttrs (msgBar, Root));
  4554. ⓪$END;
  4555. ⓪"END ClearDeskAndShowMsg;
  4556. ⓪ 
  4557. ⓪ PROCEDURE ShowSS (isCompleteHidden: BOOLEAN);
  4558. ⓪ 
  4559. ⓪"VAR   i   : INTEGER;
  4560. ⓪(name: NameStr;
  4561. ⓪ 
  4562. ⓪"BEGIN
  4563. ⓪$IF isCompleteHidden THEN
  4564. ⓪$
  4565. ⓪&SetCurrGemHandle (gemHdl, ok);
  4566. ⓪&IF ~ ok THEN (* Shell muß hier terminieren ! *) HALT END;
  4567. ⓪&
  4568. ⓪&setTools;
  4569. ⓪&FOR i := 0 TO maxWorkFiles - 1 DO WITH WorkField.elems[i] DO
  4570. ⓪(SplitPath (sourceName, void128, name);
  4571. ⓪(SetTextString (desk, nameIdx, name);
  4572. ⓪(SetObjStateElem (desk, identIdx, selectObj,
  4573. ⓪9WorkField.current = INTEGER (i));
  4574. ⓪(hideObj (carrierIdx, ~ used);
  4575. ⓪&END END;
  4576. ⓪&
  4577. ⓪&MouseInput (TRUE);
  4578. ⓪&ShowArrow;
  4579. ⓪&SetNewDesk (desk, Root);
  4580. ⓪&ForceDeskRedraw;
  4581. ⓪&MenuBar (menu, TRUE);
  4582. ⓪$END;
  4583. ⓪$
  4584. ⓪$scanSlots (showWdw, voidSlot, voidO);
  4585. ⓪$scanSlots (setTopWdw, voidSlot, voidO);
  4586. ⓪"END ShowSS;
  4587. ⓪"
  4588. ⓪ 
  4589. ⓪ (*  InitWorkfile -- Set hide-flag of the object carrier and find out the
  4590. ⓪!*                  object indices.
  4591. ⓪!*                  The box-char is completely covered from an i-box, that
  4592. ⓪!*                  is the box-char's only child!
  4593. ⓪!*)
  4594. ⓪!
  4595. ⓪ PROCEDURE InitWorkfile (workfileNumber, crrIdx: CARDINAL);
  4596. ⓪ 
  4597. ⓪"VAR head, tail: CARDINAL;
  4598. ⓪&space     : Rectangle;
  4599. ⓪ 
  4600. ⓪"BEGIN
  4601. ⓪$hideObj (crrIdx, TRUE);
  4602. ⓪$ensureVisibility (crrIdx);
  4603. ⓪$WITH WorkField.elems[workfileNumber] DO
  4604. ⓪$
  4605. ⓪&carrierIdx := crrIdx;
  4606. ⓪&
  4607. ⓪&GetObjRelatives (carrierIdx, voidC, head, tail);
  4608. ⓪&LOOP
  4609. ⓪&
  4610. ⓪(IF ObjectType (head) = boxCharObj THEN
  4611. ⓪*GetObjRelatives (head, voidC, identIdx, voidC)
  4612. ⓪(ELSIF ObjectType (head) = boxTextObj THEN nameIdx := head END;
  4613. ⓪(
  4614. ⓪(IF head # tail THEN head := RightSister (head)
  4615. ⓪(ELSE EXIT END;
  4616. ⓪(
  4617. ⓪&END;
  4618. ⓪&
  4619. ⓪$END;
  4620. ⓪"END InitWorkfile;
  4621. ⓪ 
  4622. ⓪ PROCEDURE InitSS () :BOOLEAN;
  4623. ⓪ 
  4624. ⓪"(*  installDriveIcons -- Das 'drives'-Array wird init. und für jedes vor-
  4625. ⓪#*                       handene LW wird ein Icon auf dem Desktop erzeugt.
  4626. ⓪#*                       ACHTUNG: Voraussetzung ist, das LW A: vorhanden ist.
  4627. ⓪#*)
  4628. ⓪ 
  4629. ⓪"PROCEDURE installDriveIcons;
  4630. ⓪"
  4631. ⓪$CONST bufferSize = 4096;    (*  4k are necessary for TT  *)
  4632. ⓪"
  4633. ⓪$VAR   d,d2      : Drive;
  4634. ⓪*
  4635. ⓪*p, q      : Point;
  4636. ⓪*f1, f2    : Rectangle;
  4637. ⓪*text      : String;
  4638. ⓪*p1, p2    : PtrBitPattern;
  4639. ⓪*t         : ObjType;
  4640. ⓪*s         : Rectangle;
  4641. ⓪*col1, col2,
  4642. ⓪*pos, len  : CARDINAL;
  4643. ⓪*fl        : OFlagSet;
  4644. ⓪*obj       : CARDINAL;
  4645. ⓪*infBuf    : ARRAY[0..bufferSize - 1] OF CHAR;
  4646. ⓪*online    : DriveSet;
  4647. ⓪*found     : BOOLEAN;
  4648. ⓪(
  4649. ⓪$BEGIN
  4650. ⓪&online := DriveSet (DrivesOnline ());
  4651. ⓪&SetCurrObjTree (desk, FALSE);
  4652. ⓪&FOR d := minDrv TO maxDrv DO
  4653. ⓪(drives[d].available := FALSE;
  4654. ⓪(hideObj (drives[d].treeIndex, TRUE);
  4655. ⓪&END;
  4656. ⓪&
  4657. ⓪&(*  get the object parm.s from drive A:
  4658. ⓪'*)
  4659. ⓪'
  4660. ⓪&obj := Drivea;
  4661. ⓪&t := ObjectType (obj); s := ObjectSpace (obj);
  4662. ⓪&fl := ObjectFlags (obj) - OFlagSet{lastObjFlg, hideTreeFlg};
  4663. ⓪&GetIconColor (obj, col1, col2);
  4664. ⓪&GetIconForm (obj, p, f1, f2);
  4665. ⓪&GetIconLook (obj, p1, p2, void128, voidCh);
  4666. ⓪&
  4667. ⓪&ShellGet (infBuf, 0); pos := 0; len := Length (infBuf);
  4668. ⓪&
  4669. ⓪&FOR d := drvA TO maxDrv DO
  4670. ⓪(IF d IN online THEN
  4671. ⓪*drives[d].available := TRUE;
  4672. ⓪*obj := drives[d].treeIndex;
  4673. ⓪*SetObjType (obj, t);
  4674. ⓪*SetObjSpace (obj, TransRect (s, MinPoint (ObjectSpace (obj))));
  4675. ⓪*ensureVisibility (obj);
  4676. ⓪*SetObjFlags (obj, fl);
  4677. ⓪*IF obj # Drivea THEN
  4678. ⓪,CreateSpecification (obj, NIL);
  4679. ⓪,IF ObjTreeError () THEN doAlert (memFullAlt) END;
  4680. ⓪*END;
  4681. ⓪*SetIconColor (obj, col1, col2);
  4682. ⓪*SetIconForm (obj, p, f1, f2);
  4683. ⓪7
  4684. ⓪*(* get disk name *)
  4685. ⓪*pos := 0;
  4686. ⓪*found := FALSE;
  4687. ⓪*LOOP
  4688. ⓪,pos := PosLen ('#M', infBuf, pos);
  4689. ⓪,IF pos >= len THEN EXIT END;
  4690. ⓪,pos := pos + 17;
  4691. ⓪,Concat (infBuf[pos - 2], ':', text, voidO);
  4692. ⓪,d2 := Drive (StrToDrive (text));
  4693. ⓪,IF (d2 IN online) & (d2 = d) THEN
  4694. ⓪.Copy (infBuf, pos, PosLen ('@', infBuf, pos) - pos, text, found);
  4695. ⓪.EXIT;
  4696. ⓪,END;
  4697. ⓪*END;
  4698. ⓪*IF found THEN
  4699. ⓪,SetIconLook (obj, p1,p2,create,text,CHR (ORD ('A') + ORD (d) - 1 ))
  4700. ⓪*ELSE
  4701. ⓪,Assign ('Laufwerk',text,voidO);
  4702. ⓪,SetIconLook (obj, p1,p2,create,text,CHR (ORD ('A') + ORD (d) - 1 ))
  4703. ⓪*END;
  4704. ⓪(END;
  4705. ⓪&END;
  4706. ⓪&
  4707. ⓪$END installDriveIcons;
  4708. ⓪"
  4709. ⓪"VAR     success: BOOLEAN;
  4710. ⓪*slot   : wdwSlotIdx;
  4711. ⓪*devParm: PtrDevParm;
  4712. ⓪*space  : Rectangle;
  4713. ⓪*x, w   : INTEGER;
  4714. ⓪"
  4715. ⓪"BEGIN
  4716. ⓪$IF MemAvail () < minNecessaryMem THEN RETURN FALSE END;
  4717. ⓪$
  4718. ⓪$InitGem (RC,dev, success);
  4719. ⓪$IF ~ success THEN
  4720. ⓪&IF GemActive () THEN
  4721. ⓪(multiStringAlert (noGemAlt1,noGemAlt2, voidC);
  4722. ⓪&END;
  4723. ⓪&RETURN FALSE
  4724. ⓪$ELSE
  4725. ⓪&gemHdl:=CurrGemHandle ();
  4726. ⓪$END;
  4727. ⓪$ShellPath:= HomePath;
  4728. ⓪$
  4729. ⓪$GEMBase.GetPBs (gemHdl, vdiPB, aesPB);
  4730. ⓪$multiGEM:= aesPB.pglobal^.count > 1;
  4731. ⓪$multiTOS:= aesPB.pglobal^.count = -1;
  4732. ⓪$
  4733. ⓪ (*$ ? DebugWdw:
  4734. ⓪"
  4735. ⓪$TextWindows.Open (dWdw, 40,20, WQualitySet{titled, dynamic, movable},
  4736. ⓪6TextWindows.noHideWdw, noForce, ' Debug - Fenster ',
  4737. ⓪655,3,20,10, voidO);
  4738. ⓪$
  4739. ⓪!*)
  4740. ⓪#
  4741. ⓪$deskSize := DeskSize ();
  4742. ⓪$CharSize (dev, charWidth, charHeight);
  4743. ⓪$IF deskSize.x MOD INTEGER (charWidth) # 0
  4744. ⓪$THEN
  4745. ⓪&alignedDeskSize.x := deskSize.x + INTEGER (charWidth)
  4746. ⓪;- deskSize.x MOD INTEGER (charWidth);
  4747. ⓪&alignedDeskSize.w := deskSize.w - (alignedDeskSize.x - deskSize.x);
  4748. ⓪$ELSE
  4749. ⓪&alignedDeskSize.x := deskSize.x;
  4750. ⓪&alignedDeskSize.w := deskSize.w;
  4751. ⓪$END;
  4752. ⓪$IF deskSize.y MOD INTEGER (charHeight) # 0
  4753. ⓪$THEN
  4754. ⓪&alignedDeskSize.y := deskSize.y + INTEGER (charHeight)
  4755. ⓪;- deskSize.y MOD INTEGER (charHeight);
  4756. ⓪&alignedDeskSize.h := deskSize.h - (alignedDeskSize.y - deskSize.y);
  4757. ⓪$ELSE
  4758. ⓪&alignedDeskSize.y := deskSize.y;
  4759. ⓪&alignedDeskSize.h := deskSize.h;
  4760. ⓪$END;
  4761. ⓪$
  4762. ⓪2(*  Resource laden und Baumadressen ermitteln  *)
  4763. ⓪2
  4764. ⓪$LoadResource (resourceFile);
  4765. ⓪$IF GemError () THEN
  4766. ⓪&multiStringAlert (noRscAlt1,noRscAlt2, voidC);
  4767. ⓪&ExitGem (gemHdl);
  4768. ⓪&TermProcess (0)
  4769. ⓪$END;
  4770. ⓪$
  4771. ⓪$menu          := TreeAddress (Menu);
  4772. ⓪$msgBar        := TreeAddress (Msgbar);
  4773. ⓪$desk          := TreeAddress (Desktop);
  4774. ⓪$scanBox       := TreeAddress (Scanbox);
  4775. ⓪$shellBox      := TreeAddress (Shellbox);
  4776. ⓪$optBox        := TreeAddress (Optbox);
  4777. ⓪$fileInfoBox   := TreeAddress (Finfobox);
  4778. ⓪$fileBox       := TreeAddress (Filebox);
  4779. ⓪$sNameBox      := TreeAddress (Snamebox);
  4780. ⓪$argBox        := TreeAddress (Argbox);
  4781. ⓪$linkBox       := TreeAddress (Loptbox);
  4782. ⓪$loadBox       := TreeAddress (Loadbox);
  4783. ⓪$fNameBox      := TreeAddress (Fldrbox);
  4784. ⓪$shellParmBox  := TreeAddress (Sparmbox);
  4785. ⓪$formatBox     := TreeAddress (Formabox);
  4786. ⓪$confirmBox    := TreeAddress (Confibox);
  4787. ⓪$editorParmBox := TreeAddress (Eparmbox);
  4788. ⓪$helpBox       := TreeAddress (Helpbox);
  4789. ⓪$infoBox       := TreeAddress (Infobox);
  4790. ⓪$
  4791. ⓪$noWindAlt     := TextStringAddress (Nowdwalt);
  4792. ⓪$pathToLongAlt := TextStringAddress (Pathalt);
  4793. ⓪$windErrAlt    := TextStringAddress (Windalt);
  4794. ⓪$cOptToLongAlt := TextStringAddress (Optalt);
  4795. ⓪$wrgIcon2Alt   := TextStringAddress (Icon2alt);
  4796. ⓪$memFullAlt    := TextStringAddress (Memalt);
  4797. ⓪$drvSpaceMsg   := TextStringAddress (Spacemsg);
  4798. ⓪$debugAlt      := TextStringAddress (Debugalt);
  4799. ⓪$parmSaveAlt   := TextStringAddress (Parmsalt);
  4800. ⓪$formatAlt     := TextStringAddress (Formaalt);
  4801. ⓪$formatErrAlt  := TextStringAddress (Foerralt);
  4802. ⓪$noParmAlt     := TextStringAddress (Noparalt);
  4803. ⓪$ContMakeAlt   := TextStringAddress (Contmalt);
  4804. ⓪$noNewWorkAlt  := TextStringAddress (Nowrkalt);
  4805. ⓪$exitShellAlt  := TextStringAddress (Exitalt);
  4806. ⓪$loadFailedAlt := TextStringAddress (Loadalt);
  4807. ⓪$noHelpAlt     := TextStringAddress (Nohlpalt);
  4808. ⓪$fontErrAlt    := TextStringAddress (Alrtfont);
  4809. ⓪$
  4810. ⓪$NoLoadStr     := TextStringAddress (Noldstr);
  4811. ⓪$OkStr         := TextStringAddress (Okstr);
  4812. ⓪$EditStr       := TextStringAddress (Editstr);
  4813. ⓪$EditBatStr    := TextStringAddress (Editbstr);
  4814. ⓪$NoPathsStr    := TextStringAddress (Npathstr);
  4815. ⓪$NoUnloadStr   := TextStringAddress (Nouldstr);
  4816. ⓪$NoExecStr     := TextStringAddress (Noexestr);
  4817. ⓪$RetStr        := TextStringAddress (Retstr);
  4818. ⓪$EdStr         := TextStringAddress (Edstr);
  4819. ⓪$WorkStr       := TextStringAddress (Workstr);
  4820. ⓪$CompStr       := TextStringAddress (Compstr);
  4821. ⓪$LinkStr       := TextStringAddress (Linkstr);
  4822. ⓪$InfStr        := TextStringAddress (Infstr);
  4823. ⓪$ContStr       := TextStringAddress (Contstr);
  4824. ⓪$MakeStr       := TextStringAddress (Makestr);
  4825. ⓪$
  4826. ⓪$
  4827. ⓪2(*  'desk' und 'msgBar'-Ausmaße der Größe
  4828. ⓪3*   des Ausgabegeräts anpassen
  4829. ⓪3*)
  4830. ⓪"
  4831. ⓪$devParm := DeviceParameter (dev);
  4832. ⓪$
  4833. ⓪$SetCurrObjTree (desk, FALSE);
  4834. ⓪$space := ObjectSpace (Root);
  4835. ⓪$space.w := devParm^.rasterWidth + 1;
  4836. ⓪$space.h := devParm^.rasterHeight + 1;
  4837. ⓪$SetObjSpace (Root, space);
  4838. ⓪$
  4839. ⓪$SetCurrObjTree (msgBar, FALSE);
  4840. ⓪$space.h := deskSize.y-1;
  4841. ⓪$SetObjSpace (Root, space);
  4842. ⓪$SetObjSpace (Mbmsg, space);
  4843. ⓪$
  4844. ⓪$LinkTextString (Mbmsg, ADR (msgStr));
  4845. ⓪ 
  4846. ⓪2(* Indizes ermitteln *)
  4847. ⓪ 
  4848. ⓪$linkBoxIdx[1].check := Locheck1;
  4849. ⓪$linkBoxIdx[1].path  := Lofname1;
  4850. ⓪$linkBoxIdx[2].check := Locheck2;
  4851. ⓪$linkBoxIdx[2].path  := Lofname2;
  4852. ⓪$linkBoxIdx[3].check := Locheck3;
  4853. ⓪$linkBoxIdx[3].path  := Lofname3;
  4854. ⓪$linkBoxIdx[4].check := Locheck4;
  4855. ⓪$linkBoxIdx[4].path  := Lofname4;
  4856. ⓪$linkBoxIdx[5].check := Locheck5;
  4857. ⓪$linkBoxIdx[5].path  := Lofname5;
  4858. ⓪$linkBoxIdx[6].check := Locheck6;
  4859. ⓪$linkBoxIdx[6].path  := Lofname6;
  4860. ⓪$linkBoxIdx[7].check := Locheck7;
  4861. ⓪$linkBoxIdx[7].path  := Lofname7;
  4862. ⓪$linkBoxIdx[8].check := Locheck8;
  4863. ⓪$linkBoxIdx[8].path  := Lofname8;
  4864. ⓪$
  4865. ⓪2(* Bäume initalisieren *)
  4866. ⓪2
  4867. ⓪$drives[drvA].treeIndex := Drivea;
  4868. ⓪$drives[drvB].treeIndex := Driveb;
  4869. ⓪$drives[drvC].treeIndex := Drivec;
  4870. ⓪$drives[drvD].treeIndex := Drived;
  4871. ⓪$drives[drvE].treeIndex := Drivee;
  4872. ⓪$drives[drvF].treeIndex := Drivef;
  4873. ⓪$drives[drvG].treeIndex := Driveg;
  4874. ⓪$drives[drvH].treeIndex := Driveh;
  4875. ⓪$drives[drvI].treeIndex := Drivei;
  4876. ⓪$drives[drvJ].treeIndex := Drivej;
  4877. ⓪$drives[drvK].treeIndex := Drivek;
  4878. ⓪$drives[drvL].treeIndex := Drivel;
  4879. ⓪$drives[drvM].treeIndex := Drivem;
  4880. ⓪$drives[drvN].treeIndex := Driven;
  4881. ⓪$drives[drvO].treeIndex := Driveo;
  4882. ⓪$drives[drvP].treeIndex := Drivep;
  4883. ⓪$
  4884. ⓪$(*  init. work file obj.s
  4885. ⓪%*)
  4886. ⓪$SetCurrObjTree (desk, FALSE);
  4887. ⓪$InitWorkfile (0, Work0);
  4888. ⓪$InitWorkfile (1, Work1);
  4889. ⓪$InitWorkfile (2, Work2);
  4890. ⓪$InitWorkfile (3, Work3);
  4891. ⓪$InitWorkfile (4, Work4);
  4892. ⓪$InitWorkfile (5, Work5);
  4893. ⓪$InitWorkfile (6, Work6);
  4894. ⓪$InitWorkfile (7, Work7);
  4895. ⓪$InitWorkfile (8, Work8);
  4896. ⓪$InitWorkfile (9, Work9);
  4897. ⓪$
  4898. ⓪$ensureVisibility (Trash);
  4899. ⓪$ensureVisibility (Edit); ensureVisibility (Compile);
  4900. ⓪$ensureVisibility (Execute); ensureVisibility (Link);
  4901. ⓪$ensureVisibility (Resident); ensureVisibility (Scan);
  4902. ⓪$ensureVisibility (Currfile);
  4903. ⓪$
  4904. ⓪$SetTextString (fileBox, Cfedit, '');
  4905. ⓪$SetTextString (shellBox, Version, ShellRevision);
  4906. ⓪$
  4907. ⓪$
  4908. ⓪2(*  Initalisiere 'Tools'-Indizies  *)
  4909. ⓪2
  4910. ⓪$ToolField[1].index := Mtool1;
  4911. ⓪$ToolField[2].index := Mtool2;
  4912. ⓪$ToolField[3].index := Mtool3;
  4913. ⓪$ToolField[4].index := Mtool4;
  4914. ⓪$ToolField[5].index := Mtool5;
  4915. ⓪$ToolField[6].index := Mtool6;
  4916. ⓪$ToolField[7].index := Mtool7;
  4917. ⓪$ToolField[8].index := Mtool8;
  4918. ⓪$ToolField[9].index := Mtool9;
  4919. ⓪$ToolField[10].index := Mtool10;
  4920. ⓪$
  4921. ⓪$(*  init of the window slots
  4922. ⓪%*)
  4923. ⓪$
  4924. ⓪$x := firstWdwColumn;
  4925. ⓪$w := (screenColumns - firstWdwColumn - dirVisibleWidth) DIV maxWdw;
  4926. ⓪$
  4927. ⓪$FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO
  4928. ⓪$
  4929. ⓪&NEW (wdws[slot]);
  4930. ⓪&WITH wdws[slot]^ DO
  4931. ⓪(CreateWL (wl, FALSE, Rect (x, CenterWindowWL,
  4932. ⓪CdirVisibleWidth, MaxWindowWL));
  4933. ⓪(used := FALSE;
  4934. ⓪(noSelected := 0;
  4935. ⓪(x := x + w;
  4936. ⓪&END;
  4937. ⓪&
  4938. ⓪$END;
  4939. ⓪$
  4940. ⓪$TemporaryPath:= ShellPath;
  4941. ⓪$LoadParameter (shellParm.parameterPath);
  4942. ⓪$
  4943. ⓪$installDriveIcons;
  4944. ⓪$
  4945. ⓪$ShowSS (TRUE);
  4946. ⓪$
  4947. ⓪$RETURN TRUE;
  4948. ⓪"END InitSS;
  4949. ⓪ 
  4950. ⓪ PROCEDURE HideSS (complete: BOOLEAN);
  4951. ⓪ 
  4952. ⓪"BEGIN
  4953. ⓪$scanSlots (hideWdw, voidSlot, voidO);
  4954. ⓪$IF complete THEN ClearDeskAndShowMsg END;
  4955. ⓪$ShowBee;
  4956. ⓪"END HideSS;
  4957. ⓪ 
  4958. ⓪ PROCEDURE ExitSS;
  4959. ⓪ 
  4960. ⓪"VAR     slot: wdwSlotIdx;
  4961. ⓪"
  4962. ⓪"BEGIN
  4963. ⓪$msgStr := '';
  4964. ⓪$HideSS (TRUE);
  4965. ⓪$
  4966. ⓪$(*  deinit of the window slots
  4967. ⓪%*)
  4968. ⓪$
  4969. ⓪$FOR slot := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO WITH wdws[slot]^ DO
  4970. ⓪&DeleteWL (wl);
  4971. ⓪&DISPOSE (wdws[slot]);
  4972. ⓪$END END;
  4973. ⓪$
  4974. ⓪$FreeResource;
  4975. ⓪$(* ExitGem (gemHdl); *)
  4976. ⓪"END ExitSS;
  4977. ⓪ 
  4978. ⓪*
  4979. ⓪0(*  Routinen zur Event-Verarbeitung  *)
  4980. ⓪0(*  ===============================  *)
  4981. ⓪ 
  4982. ⓪ (*  keyManager -- Bearbeitet alle keyboard events
  4983. ⓪!*)
  4984. ⓪ 
  4985. ⓪ (*$Z-*)
  4986. ⓪ PROCEDURE keyManager (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;
  4987. ⓪ (*$Z=*)
  4988. ⓪ 
  4989. ⓪"CONST   aCode   = BYTE (30);    (*  Buchstabentasten  *)
  4990. ⓪*cCode   = BYTE (46);
  4991. ⓪*eCode   = BYTE (18);
  4992. ⓪*fCode   = BYTE (33);
  4993. ⓪*iCode   = BYTE (23);
  4994. ⓪*lCode   = BYTE (38);
  4995. ⓪*nCode   = BYTE (49);
  4996. ⓪*mCode   = BYTE (50);
  4997. ⓪*oCode   = BYTE (24);
  4998. ⓪*pCode   = BYTE (25);
  4999. ⓪*qCode   = BYTE (16);
  5000. ⓪*rCode   = BYTE (19);
  5001. ⓪*sCode   = BYTE (31);
  5002. ⓪*uCode   = BYTE (22);
  5003. ⓪*xCode   = BYTE (45);
  5004. ⓪*
  5005. ⓪*code1A  = BYTE (2);     (*  Ziffern  *)
  5006. ⓪*code0A  = BYTE (11);
  5007. ⓪*code7N  = BYTE (103);
  5008. ⓪*code0N  = BYTE (112);
  5009. ⓪*
  5010. ⓪*plusCode= BYTE (27);    (*  <+>  *)
  5011. ⓪*
  5012. ⓪*clrHome = BYTE (71);    (*  <Clr>-Taste  *)
  5013. ⓪*delete  = BYTE (83);    (*  <Delete>-Taste  *)
  5014. ⓪*help    = BYTE (98);    (*  <Help>-Taste  *)
  5015. ⓪*escape  = BYTE (1);     (*  <Esc>-Taste  *)
  5016. ⓪*f1      = BYTE (59);    (*  <F1>  *)
  5017. ⓪*f10     = BYTE (68);    (*  <F10>  *)
  5018. ⓪*shiftF1 = BYTE (84);    (*  Shift + <F1>  *)
  5019. ⓪*shiftF10= BYTE (93);    (*  Shift + <F10>  *)
  5020. ⓪"
  5021. ⓪"VAR     buts    : MButtonSet;
  5022. ⓪*loc     : Point;
  5023. ⓪*
  5024. ⓪*slot    : wdwSlotIdx;
  5025. ⓪*slotPtr : ptrWdwSlot;
  5026. ⓪*success : BOOLEAN;
  5027. ⓪*msg     : String;
  5028. ⓪*
  5029. ⓪$PROCEDURE withoutCtrl () :BOOLEAN;
  5030. ⓪$BEGIN
  5031. ⓪&RETURN ~ (controlKey IN specials)
  5032. ⓪$END withoutCtrl;
  5033. ⓪"
  5034. ⓪"BEGIN
  5035. ⓪"
  5036. ⓪$(* MouseKeyState (loc, buts, specials); *)
  5037. ⓪$CASE ch.scan OF
  5038. ⓪$
  5039. ⓪&escape   : scanSlots (isTopWdw, slot, success);  (*  update window  *)
  5040. ⓪1IF success THEN
  5041. ⓪1
  5042. ⓪3slotPtr := wdws[slot];
  5043. ⓪3CASE slotPtr^.kind OF
  5044. ⓪1
  5045. ⓪5dirWdw : ForceMediaChange (StrToDrive (slotPtr^.path)) |
  5046. ⓪5modWdw : slotPtr^.all := (alternateKey IN specials)|
  5047. ⓪5
  5048. ⓪3END;
  5049. ⓪3updateWdw (slotPtr);
  5050. ⓪3
  5051. ⓪1END|
  5052. ⓪(
  5053. ⓪&(*  Icons  *)
  5054. ⓪&
  5055. ⓪&aCode    : actManager (Execute, specials, withoutCtrl (), FALSE, FALSE)|
  5056. ⓪&cCode    : IF withAlt (specials) THEN doCompilerOptionBox
  5057. ⓪1ELSE
  5058. ⓪3actManager (Compile, specials, withoutCtrl (), FALSE, FALSE)
  5059. ⓪1END|
  5060. ⓪&eCode    : IF withAlt (specials) THEN doEditorParameterBox
  5061. ⓪1ELSE
  5062. ⓪3actManager (Edit, specials, withoutCtrl (), FALSE, FALSE)
  5063. ⓪1END|
  5064. ⓪&lCode    : IF withAlt (specials) THEN doLinkerOptionBox
  5065. ⓪1ELSE
  5066. ⓪3actManager (Link, specials, withoutCtrl (), FALSE, FALSE)
  5067. ⓪1END|
  5068. ⓪&sCode    : actManager (Scan, specials, withoutCtrl (), FALSE, FALSE)|
  5069. ⓪&rCode    : actManager (Resident, specials, withoutCtrl (), FALSE, FALSE)|
  5070. ⓪&plusCode : actManager (Compile, specials, withoutCtrl (), FALSE, TRUE)|
  5071. ⓪&
  5072. ⓪&pCode    : IF withCtrl (specials) THEN doFileBox (noCurrentWorkfile)
  5073. ⓪1ELSIF WorkField.current # noCurrentWorkfile THEN
  5074. ⓪3doFileBox (WorkField.current);
  5075. ⓪1END|
  5076. ⓪&
  5077. ⓪&mCode    : Concat ('Making: ', MakeFileName, msg, voidO);
  5078. ⓪1truncCopyString (msg, msgStrLen, msgStr);
  5079. ⓪1action (doDftM, FALSE, FALSE)|
  5080. ⓪ 
  5081. ⓪&(*  Menu: Datei  *)
  5082. ⓪&
  5083. ⓪&iCode    : inform|
  5084. ⓪&oCode    : makeFolder|
  5085. ⓪&clrHome  : IF withBothShifts (specials)
  5086. ⓪1THEN
  5087. ⓪3scanSlots (closeWdw, voidSlot, voidO);
  5088. ⓪1ELSE
  5089. ⓪3closeTopWdw (withShift (specials));
  5090. ⓪1END|
  5091. ⓪&nCode    : makeNewWorkfile|
  5092. ⓪&delete   : killWorkfile|
  5093. ⓪&qCode    : IF withCtrl (specials) THEN quitStatus := quickQuit
  5094. ⓪1ELSE quitStatus := quit END|
  5095. ⓪&
  5096. ⓪&(*  Menu: Parameter  *)
  5097. ⓪&
  5098. ⓪&xCode    : IF withCtrl (specials) THEN saveParameter
  5099. ⓪1ELSE doShellParameterBox END|
  5100. ⓪&
  5101. ⓪&(*  Menu: Info  *)
  5102. ⓪&
  5103. ⓪&uCode    : doInfoBox|
  5104. ⓪&help     : IF withShift (specials) THEN editDocu (specials)
  5105. ⓪1ELSE doHelpBox (helpFile) END|
  5106. ⓪&
  5107. ⓪&(*  Menu: Tools  *)
  5108. ⓪&
  5109. ⓪&f1..f10  : executeTool (ORD (ch.scan) - ORD (f1) + 1, specials)|
  5110. ⓪&shiftF1..shiftF10
  5111. ⓪/: INCL (specials, leftShiftKey);
  5112. ⓪1executeTool (ORD (ch.scan) - ORD (shiftF1) + 1, specials)|
  5113. ⓪&
  5114. ⓪&(*  work files  *)
  5115. ⓪&
  5116. ⓪&code1A..code0A,
  5117. ⓪&code7N..code0N
  5118. ⓪/: selectWorkfile (ORD (ch.ascii) - ORD ('0'))|
  5119. ⓪1
  5120. ⓪$ELSE RETURN TRUE END;
  5121. ⓪$
  5122. ⓪$RETURN FALSE;
  5123. ⓪"END keyManager;
  5124. ⓪ 
  5125. ⓪ (*  butManager -- Bearbeitet alle mouse button events
  5126. ⓪!*)
  5127. ⓪ 
  5128. ⓪ PROCEDURE moveFiles (slotPtr: ptrWdwSlot; loc: Point; specials: SpecialKeySet);
  5129. ⓪ 
  5130. ⓪"VAR   result       : targetObject;
  5131. ⓪(success,
  5132. ⓪(foundDrive,
  5133. ⓪(foundWorkfile: BOOLEAN;
  5134. ⓪(objKind      : dragObjectKind;
  5135. ⓪(name,
  5136. ⓪(destPath     : Str128;
  5137. ⓪(kindOfName   : nameKind;
  5138. ⓪(dirEntryPtr  : ptrDirEntry;
  5139. ⓪(drive        : Drive;
  5140. ⓪(workfileIdx  : CARDINAL;
  5141. ⓪ 
  5142. ⓪"BEGIN
  5143. ⓪$getSelectedName (name, voidSlot, kindOfName);
  5144. ⓪$IF kindOfName = fileNK THEN objKind := fileDOK
  5145. ⓪$ELSE objKind := filesDOK END;
  5146. ⓪$
  5147. ⓪$moveFileModul (slotPtr, objKind, loc, result, success);
  5148. ⓪$IF ~ success THEN RETURN END;
  5149. ⓪$
  5150. ⓪$toggleTarget (result, FALSE);
  5151. ⓪$CASE result.kind OF
  5152. ⓪$
  5153. ⓪&objTOK: searchDrive (result.obj, drive, foundDrive);
  5154. ⓪.searchWorkfile (result.obj, workfileIdx, foundWorkfile);
  5155. ⓪.IF foundDrive THEN                (*  copy into drive  *)
  5156. ⓪0Assign (DriveToStr (MOSGlobals.Drive(drive)), destPath, voidO);
  5157. ⓪0copyFiles (slotPtr, destPath, FALSE);
  5158. ⓪.ELSIF foundWorkfile THEN
  5159. ⓪0setWorkfileName (workfileIdx, currFn)
  5160. ⓪.ELSE                              (*  action  *)
  5161. ⓪0CASE result.obj OF
  5162. ⓪2Trash    : deleteFiles (slotPtr);
  5163. ⓪=updateWdw (slotPtr)|
  5164. ⓪2Edit,
  5165. ⓪2Compile,
  5166. ⓪2Execute,
  5167. ⓪2Link,
  5168. ⓪2Resident,
  5169. ⓪2Scan     : actManager (result.obj, specials,
  5170. ⓪IFALSE, FALSE, FALSE)|
  5171. ⓪0END;
  5172. ⓪.END|
  5173. ⓪.
  5174. ⓪&wdwTOK: IF (result.entry = NIL)
  5175. ⓪1OR NOT (selectedWL IN EntryAttributesWL (result.slotPtr^.wl,
  5176. ⓪Zresult.entry)) THEN
  5177. ⓪.
  5178. ⓪0IF result.slotPtr^.kind = dirWdw  (*  dir. wdw  *)
  5179. ⓪0THEN
  5180. ⓪2destPath := result.slotPtr^.path; (* copy into wdw/folder  *)
  5181. ⓪2IF result.valid THEN
  5182. ⓪4dirEntryPtr := ptrDirEntry (result.entry);
  5183. ⓪4appendPath (dirEntryPtr^.entry.name, destPath, success);
  5184. ⓪2END;
  5185. ⓪2copyFiles (slotPtr, destPath, FALSE);
  5186. ⓪2IF NOT result.valid THEN updateWdw (result.slotPtr) END;
  5187. ⓪2
  5188. ⓪0ELSE                              (*  mod. wdw  *)
  5189. ⓪2loadAndUnload (slotPtr, loadModuls)
  5190. ⓪0END;
  5191. ⓪0
  5192. ⓪.END|
  5193. ⓪0
  5194. ⓪$END;
  5195. ⓪$
  5196. ⓪"END moveFiles;
  5197. ⓪"
  5198. ⓪ PROCEDURE moveModuls (slotPtr: ptrWdwSlot; loc: Point; specials: SpecialKeySet);
  5199. ⓪ 
  5200. ⓪"VAR   result : targetObject;
  5201. ⓪(success: BOOLEAN;
  5202. ⓪(kind   : dragObjectKind;
  5203. ⓪ 
  5204. ⓪"BEGIN
  5205. ⓪$kind := modulDOK;
  5206. ⓪$IF slotPtr^.noSelected > 1 THEN kind := modulsDOK END;
  5207. ⓪$
  5208. ⓪$moveFileModul (slotPtr, kind, loc, result, success);
  5209. ⓪$IF ~ success THEN RETURN END;
  5210. ⓪ 
  5211. ⓪$CASE result.kind OF
  5212. ⓪$
  5213. ⓪&objTOK: CASE result.obj OF
  5214. ⓪&
  5215. ⓪0Execute       : actManager (Execute, specials,
  5216. ⓪LFALSE, FALSE, FALSE)|
  5217. ⓪0Trash         : (* HideSS (FALSE);
  5218. ⓪@action (doUnLd, FALSE, FALSE);
  5219. ⓪@ShowSS (FALSE);
  5220. ⓪A*)
  5221. ⓪@(*scanSlots (updateModWdw, voidSlot, voidO); *)
  5222. ⓪@loadAndUnload (slotPtr, unloadModuls)|
  5223. ⓪0
  5224. ⓪.ELSE doAlert (wrgIcon2Alt) END|
  5225. ⓪.
  5226. ⓪&wdwTOK: doAlert (wrgIcon2Alt)|
  5227. ⓪&
  5228. ⓪$END;
  5229. ⓪*
  5230. ⓪$toggleTarget (result, FALSE);
  5231. ⓪"END moveModuls;
  5232. ⓪ 
  5233. ⓪ 
  5234. ⓪ (*$Z-*)
  5235. ⓪ PROCEDURE butManager (clicks  : CARDINAL;
  5236. ⓪6loc     : Point;
  5237. ⓪6buts    : MButtonSet;
  5238. ⓪6specials: SpecialKeySet): BOOLEAN;
  5239. ⓪ (*$Z=*)
  5240. ⓪ 
  5241. ⓪"VAR     obj, but        : CARDINAL;
  5242. ⓪*on              : BOOLEAN;
  5243. ⓪*str10           : ARRAY[0..10] OF CHAR;
  5244. ⓪*lStr            : Str128;
  5245. ⓪*sc              : SpecialKeySet;
  5246. ⓪*
  5247. ⓪*slot            : wdwSlotIdx;
  5248. ⓪*slotPtr         : ptrWdwSlot;
  5249. ⓪*dirEntryPtr     : ptrDirEntry;
  5250. ⓪*modEntryPtr     : ptrModEntry;
  5251. ⓪*entry           : ADDRESS;
  5252. ⓪*
  5253. ⓪*kindOfName      : nameKind;
  5254. ⓪*
  5255. ⓪*mode            : DetectModeWL;
  5256. ⓪*openCurrDir     : BOOLEAN;
  5257. ⓪*loc2            : Point;
  5258. ⓪*
  5259. ⓪*drive           : Drive;
  5260. ⓪*workfileIdx     : CARDINAL;
  5261. ⓪*foundDrive,
  5262. ⓪*foundWorkfile,
  5263. ⓪*contSearch      : BOOLEAN;
  5264. ⓪*
  5265. ⓪$PROCEDURE selectArea;
  5266. ⓪$
  5267. ⓪&VAR      selMode: LONGCARD;
  5268. ⓪&
  5269. ⓪&BEGIN
  5270. ⓪(RubberBox (Rect (loc.x, loc.y, 0, 0), loc2);
  5271. ⓪2
  5272. ⓪(IF withShift (specials) THEN selMode := multipleSelect
  5273. ⓪(ELSE selMode := onlyOneSelected END;
  5274. ⓪(SelectAreaWL (slotPtr^.wl, Rect (loc.x, loc.y, loc2.x, loc2.y),
  5275. ⓪9selMode, multipleSelect);
  5276. ⓪&END selectArea;
  5277. ⓪$
  5278. ⓪$PROCEDURE withShiftOrRightButton (): BOOLEAN;
  5279. ⓪$
  5280. ⓪&BEGIN
  5281. ⓪(RETURN withShift (specials) OR (msBut2 IN buts)
  5282. ⓪&END withShiftOrRightButton;
  5283. ⓪&
  5284. ⓪"BEGIN (* butManager *)
  5285. ⓪"
  5286. ⓪$MouseKeyState (loc2, buts, sc);  (*  Welche Knöpfe sind noch gedrückt?  *)
  5287. ⓪"
  5288. ⓪*(* Teste Fenster ab *)
  5289. ⓪"
  5290. ⓪$IF withCtrl (specials) THEN mode := scanWL ELSE mode := selectWL END;
  5291. ⓪$detectWdws (loc, mode, clicks, specials, buts, entry, slotPtr, contSearch);
  5292. ⓪$
  5293. ⓪$IF entry # NIL THEN           (*  a window entry is selected  *)
  5294. ⓪$
  5295. ⓪&getSelectedName (currFn, voidSlot, kindOfName);
  5296. ⓪&
  5297. ⓪&CASE slotPtr^.kind OF
  5298. ⓪&
  5299. ⓪(dirWdw : dirEntryPtr := ptrDirEntry (entry);      (*  directory wdws  *)
  5300. ⓪(
  5301. ⓪1IF clicks > 1 THEN       (*  double click  *)
  5302. ⓪1
  5303. ⓪3IF isSubdir (dirEntryPtr^.entry) THEN
  5304. ⓪5AESUpdateWindow (TRUE);
  5305. ⓪5openFolder (slotPtr, dirEntryPtr);
  5306. ⓪5AESUpdateWindow (FALSE);
  5307. ⓪3ELSE
  5308. ⓪5IF IsSourceName (currFn) THEN
  5309. ⓪7actManager (Edit, specials, FALSE, FALSE, FALSE)
  5310. ⓪5ELSE
  5311. ⓪7actManager (Execute, specials, FALSE, FALSE, FALSE)
  5312. ⓪5END
  5313. ⓪3END;
  5314. ⓪3
  5315. ⓪1ELSIF msBut1 IN buts THEN(*  button down  *)
  5316. ⓪1
  5317. ⓪3IF withCtrl (specials) THEN
  5318. ⓪5selectArea
  5319. ⓪3ELSE
  5320. ⓪5moveFiles (slotPtr, loc, specials)
  5321. ⓪3END;
  5322. ⓪1
  5323. ⓪1ELSE                     (*  simple click  *)
  5324. ⓪3IF ~ isSubdir (dirEntryPtr^.entry) THEN
  5325. ⓪5setCurrTextAndCode (currFn)
  5326. ⓪3END;
  5327. ⓪1END|
  5328. ⓪1
  5329. ⓪(modWdw : modEntryPtr := ptrModEntry (entry);      (*  module wdws  *)
  5330. ⓪(
  5331. ⓪1IF clicks > 1 THEN       (*  double click  *)
  5332. ⓪1
  5333. ⓪3(* getSelectedName (currFn, voidSlot, kindOfName); *)
  5334. ⓪3actManager (Execute, specials, FALSE, FALSE, FALSE)
  5335. ⓪(
  5336. ⓪1ELSIF msBut1 IN buts THEN(*  button down  *)
  5337. ⓪1
  5338. ⓪3IF withCtrl (specials) THEN selectArea
  5339. ⓪3ELSE
  5340. ⓪5moveModuls (slotPtr, loc, specials)
  5341. ⓪3END;
  5342. ⓪3
  5343. ⓪1ELSE                     (*  simple click  *)
  5344. ⓪3setCurrTextAndCode (currFn)
  5345. ⓪1END|
  5346. ⓪(
  5347. ⓪&END;
  5348. ⓪$END;
  5349. ⓪"
  5350. ⓪$IF contSearch THEN  (* 'findWind' ergab, daß kein Fenster selektiert wurde *)
  5351. ⓪*
  5352. ⓪*(* Teste Desktop ab *)
  5353. ⓪&
  5354. ⓪&obj := FindObject (desk, Root, MaxDepth, loc);
  5355. ⓪"
  5356. ⓪&IF obj = NoObject THEN
  5357. ⓪&
  5358. ⓪(RETURN TRUE  (* kein eigenes Objekt -> Ende *)
  5359. ⓪(
  5360. ⓪&ELSE
  5361. ⓪(searchDrive (obj, drive, foundDrive);
  5362. ⓪(searchWorkfile (obj, workfileIdx, foundWorkfile);
  5363. ⓪(SetCurrObjTree (desk, FALSE);
  5364. ⓪(
  5365. ⓪(IF clicks > 1 THEN                (*  Doppelklick  *)
  5366. ⓪(
  5367. ⓪*CASE obj OF
  5368. ⓪*
  5369. ⓪,Compile,
  5370. ⓪,Edit,
  5371. ⓪,Execute,
  5372. ⓪,Link,
  5373. ⓪,Resident,
  5374. ⓪,Scan      : actManager (obj, specials, ~ (msBut2 IN buts),
  5375. ⓪DFALSE, FALSE)|
  5376. ⓪,
  5377. ⓪,Cftext,
  5378. ⓪,Cfcode    : doFileBox (noCurrentWorkfile)|
  5379. ⓪,
  5380. ⓪*ELSE
  5381. ⓪,IF foundDrive THEN
  5382. ⓪,
  5383. ⓪.AESUpdateWindow (TRUE);
  5384. ⓪.selectDrive (drive);
  5385. ⓪.openCurrDir := (shellParm.defaultOpenCurrDir
  5386. ⓪>AND ~ withShiftOrRightButton ())
  5387. ⓪=OR (~ shellParm.defaultOpenCurrDir
  5388. ⓪AAND withShiftOrRightButton ());
  5389. ⓪.openDirWdw (slot, drive, openCurrDir);
  5390. ⓪.careOfDeselectDrive;
  5391. ⓪.AESUpdateWindow (FALSE);
  5392. ⓪,
  5393. ⓪,ELSIF foundWorkfile THEN doFileBox (workfileIdx) END;
  5394. ⓪*END;(*CASE -- Doppelklick *)
  5395. ⓪*
  5396. ⓪(ELSIF msBut1 IN buts THEN         (*  Button festgehalten  *)
  5397. ⓪(
  5398. ⓪*CASE obj OF
  5399. ⓪*
  5400. ⓪,Compile,
  5401. ⓪,Edit,
  5402. ⓪,Execute,
  5403. ⓪,Link,
  5404. ⓪,Resident,
  5405. ⓪,Scan,
  5406. ⓪,Trash     : moveDeskPart (obj)|
  5407. ⓪,
  5408. ⓪,Currfile,
  5409. ⓪,Cfhead    : moveDeskPart (Currfile)|
  5410. ⓪,
  5411. ⓪,Cftext,
  5412. ⓪,Cfcode    : (* moveFile (deskObjSpace (Cfname), FALSE,
  5413. ⓪BiconNo,destWind,destElem, moveResult);
  5414. ⓪8IF iconNo # NoObject THEN
  5415. ⓪:CASE iconNo OF
  5416. ⓪:
  5417. ⓪<Compile,
  5418. ⓪<Compexec,
  5419. ⓪<Edit,
  5420. ⓪<Execute,
  5421. ⓪<Link,
  5422. ⓪<Resident,
  5423. ⓪<Scan     : actManager (iconNo, specials,
  5424. ⓪SFALSE, FALSE, FALSE)|
  5425. ⓪<
  5426. ⓪<Trash    : setCurrTextAndCode ('')|
  5427. ⓪:ELSE
  5428. ⓪<(* nix *)
  5429. ⓪:END;
  5430. ⓪8ELSE
  5431. ⓪:(* nix
  5432. ⓪<IF moveResult # noWindMF THEN END;
  5433. ⓪:*)
  5434. ⓪8END*)|
  5435. ⓪,
  5436. ⓪*ELSE
  5437. ⓪,IF foundDrive THEN moveDeskPart (obj)
  5438. ⓪,ELSIF foundWorkfile THEN
  5439. ⓪.moveDeskPart (WorkField.elems[workfileIdx].carrierIdx)
  5440. ⓪,END;
  5441. ⓪*END;(* CASE -- Klick mit festhalten *)
  5442. ⓪*
  5443. ⓪(ELSE                              (*  Einfacher Klick  *)
  5444. ⓪(
  5445. ⓪*careOfDeselectDrive;
  5446. ⓪*careOfDeselectEntries;
  5447. ⓪*IF foundDrive THEN selectDrive (drive)
  5448. ⓪*ELSIF foundWorkfile THEN selectWorkfile (workfileIdx) END;
  5449. ⓪*
  5450. ⓪(END;(*IF -- Klickunterscheidung *)
  5451. ⓪&
  5452. ⓪&END;
  5453. ⓪$END;(*IF contSearch*)
  5454. ⓪$
  5455. ⓪$RETURN FALSE;
  5456. ⓪"END butManager;
  5457. ⓪ 
  5458. ⓪ (*  menuManager -- Bearbeitet alle message events, die durch Anklicken der
  5459. ⓪!*                 Menuzeile entstehen.
  5460. ⓪!*)
  5461. ⓪!
  5462. ⓪ (*$Z-*)
  5463. ⓪ PROCEDURE menuManager (title, item: CARDINAL): BOOLEAN;
  5464. ⓪ (*$Z=*)
  5465. ⓪"
  5466. ⓪"VAR     i       : CARDINAL;
  5467. ⓪*buts    : MButtonSet;
  5468. ⓪*specials: SpecialKeySet;
  5469. ⓪*loc     : Point;
  5470. ⓪*start   : Rectangle;
  5471. ⓪#
  5472. ⓪"BEGIN
  5473. ⓪$MouseKeyState (loc,buts,specials);
  5474. ⓪$CASE item OF
  5475. ⓪&
  5476. ⓪&(*  MShell  *)
  5477. ⓪%
  5478. ⓪&Dinfo     : animateMenuTitle (Mshell, start);
  5479. ⓪2DoSimpleBox (shellBox, start, voidC);
  5480. ⓪2deAnimateMenuTitle (Mshell)|
  5481. ⓪&
  5482. ⓪&(*  Datei  *)
  5483. ⓪&
  5484. ⓪&Mdinfo    : inform|
  5485. ⓪&Mdfolder  : makeFolder|
  5486. ⓪&Mdformat  : doFormatBox|
  5487. ⓪&Mdclose   : closeTopWdw (FALSE)|
  5488. ⓪&Mdclosew  : closeTopWdw (TRUE)|
  5489. ⓪&Mdnwork   : makeNewWorkfile|
  5490. ⓪&Mdkwork   : killWorkfile|
  5491. ⓪&Mdquit    : quitStatus := quit|
  5492. ⓪&
  5493. ⓪&(*  Parameter  *)
  5494. ⓪&
  5495. ⓪&Mpshell   : doShellParameterBox|
  5496. ⓪&Mpeditor  : doEditorParameterBox|
  5497. ⓪&Mpcomp    : doCompilerOptionBox|
  5498. ⓪&Mplink    : doLinkerOptionBox|
  5499. ⓪&Mpsave    : saveParameter|
  5500. ⓪&
  5501. ⓪&(*  Info  *)
  5502. ⓪&
  5503. ⓪&Mienv     : doInfoBox|
  5504. ⓪&Mihelp    : doHelpBox (helpFile)|
  5505. ⓪&Midocu    : editDocu (specials)|
  5506. ⓪&
  5507. ⓪$ELSE
  5508. ⓪&
  5509. ⓪&(*  Tools  *)
  5510. ⓪$
  5511. ⓪&FOR i := 1 TO MaxTool DO
  5512. ⓪(IF item = ToolField[i].index THEN executeTool (i, specials) END
  5513. ⓪&END;
  5514. ⓪&
  5515. ⓪$END;
  5516. ⓪$
  5517. ⓪$NormalTitle (menu,title, TRUE);
  5518. ⓪$
  5519. ⓪$RETURN FALSE;
  5520. ⓪"END menuManager;
  5521. ⓪ 
  5522. ⓪ PROCEDURE TalkWithUser;
  5523. ⓪ 
  5524. ⓪"VAR     worker  : ARRAY [1..3] OF EventProc;
  5525. ⓪*
  5526. ⓪*slot, i : wdwSlotIdx;
  5527. ⓪*success : BOOLEAN;
  5528. ⓪*
  5529. ⓪*firstA3,
  5530. ⓪*newA3   : LONGCARD;
  5531. ⓪*
  5532. ⓪*button  : CARDINAL;
  5533. ⓪"
  5534. ⓪"(*  careOfNewName  -- Falls ein Unterschied zwischen dem in 'str' enthaltenen
  5535. ⓪#*                    Filenamen und dem String des Objektes 'obj' des Desk-
  5536. ⓪#*                    top-Baumes besteht, so wird der Name aus 'str' in das
  5537. ⓪#*                    Objekt geschreiben und neugezeichnet.
  5538. ⓪#*)
  5539. ⓪#
  5540. ⓪"PROCEDURE careOfNewName (VAR str:ARRAY OF CHAR; obj:CARDINAL);
  5541. ⓪ 
  5542. ⓪$VAR   lF, old: ARRAY[0..11] OF CHAR;
  5543. ⓪$
  5544. ⓪$BEGIN
  5545. ⓪&SplitPath (str, void128, lF);
  5546. ⓪&GetTextString (desk, obj, old);
  5547. ⓪&IF NOT StrEqual (old, lF) THEN
  5548. ⓪(SetTextString (desk, obj, lF);
  5549. ⓪(redrawDeskObj (obj);
  5550. ⓪&END;
  5551. ⓪$END careOfNewName;
  5552. ⓪"
  5553. ⓪ 
  5554. ⓪"BEGIN
  5555. ⓪$careOfNewName (lastFn, Cftext);     (* Aktuelles File aktual. *)
  5556. ⓪$careOfNewName (CodeName, Cfcode);
  5557. ⓪"
  5558. ⓪$worker[1].event := keyboard;
  5559. ⓪$worker[1].keyHdler := keyManager;
  5560. ⓪$worker[2].event := mouseButton;
  5561. ⓪$worker[2].butHdler := butManager;
  5562. ⓪$worker[3].event := message;
  5563. ⓪$worker[3].msgType := menuSelected;
  5564. ⓪$worker[3].menuHdler := menuManager;
  5565. ⓪"
  5566. ⓪$STORE (11, firstA3);
  5567. ⓪"
  5568. ⓪$REPEAT
  5569. ⓪"
  5570. ⓪&HandleEvents (2, MButtonSet{msBut1}, MButtonSet{msBut1},
  5571. ⓪4lookForEntry, Rect (0,0,0,0),
  5572. ⓪4lookForEntry, Rect (0,0,0,0),
  5573. ⓪40, worker, 0);
  5574. ⓪"
  5575. ⓪&STORE (11, newA3);
  5576. ⓪&IF newA3 # firstA3 THEN
  5577. ⓪(LOAD (firstA3, 11);
  5578. ⓪(FormAlert (1, '[1][Heap fault][ OK ]', voidC);
  5579. ⓪&END;
  5580. ⓪&
  5581. ⓪&enableAndDisableMenuItems;
  5582. ⓪"
  5583. ⓪&FOR i := MIN (wdwSlotIdx) TO MAX (wdwSlotIdx) DO
  5584. ⓪(wdws[i]^.isTop := FALSE;
  5585. ⓪&END;
  5586. ⓪&scanSlots (isTopWdw, slot, success);
  5587. ⓪&IF success THEN
  5588. ⓪&
  5589. ⓪(wdws[slot]^.isTop := TRUE;
  5590. ⓪(IF wdws[slot]^.kind = dirWdw THEN
  5591. ⓪*SetDefaultPath (wdws[slot]^.path, voidI);
  5592. ⓪(END;
  5593. ⓪(
  5594. ⓪&END;
  5595. ⓪"
  5596. ⓪&currFn := '';         (* Damit 'lastFn' zum Zuge kommen kann *)
  5597. ⓪&
  5598. ⓪&careOfNewName (lastFn, Cftext);     (* Aktuelles File aktual. *)
  5599. ⓪&careOfNewName (CodeName, Cfcode);
  5600. ⓪"
  5601. ⓪&(*  handle a quit shell request
  5602. ⓪'*)
  5603. ⓪&IF quitStatus = quit THEN
  5604. ⓪(FormAlert (1, exitShellAlt^, button);
  5605. ⓪(IF button = 3 THEN quitStatus := noQuit
  5606. ⓪(ELSIF button = 1 THEN SaveParameter END;
  5607. ⓪&END;
  5608. ⓪$
  5609. ⓪$UNTIL quitStatus # noQuit;
  5610. ⓪"END TalkWithUser;
  5611. ⓪ 
  5612. ⓪ (*$Z-*)
  5613. ⓪ PROCEDURE hdlTrap5 (VAR desc: ExcDesc): BOOLEAN;
  5614. ⓪ (*$Z=*)
  5615. ⓪"BEGIN
  5616. ⓪$doAlert (debugAlt);   (*  Fehlermeldung  *)
  5617. ⓪$TermProcess (0);      (*  und ab damit  *)
  5618. ⓪$RETURN FALSE          (* Nur um des Compilers Willen  *)
  5619. ⓪"END hdlTrap5;
  5620. ⓪ 
  5621. ⓪ 
  5622. ⓪ VAR     i       : CARDINAL;
  5623. ⓪(hdl     : ADDRESS;
  5624. ⓪(wsp     : MemArea;
  5625. ⓪ 
  5626. ⓪ BEGIN (* ShellShell *)
  5627. ⓪ 
  5628. ⓪"(*  Vom Modula-System und der Shell benutzte Suffices:
  5629. ⓪#*)
  5630. ⓪"suf[prg] := 'PRG';
  5631. ⓪"suf[app] := 'APP';
  5632. ⓪"suf[tos] := 'TOS';
  5633. ⓪"suf[ttp] := 'TTP';
  5634. ⓪"suf[m2p] := 'M2P';
  5635. ⓪"suf[m2b] := 'M2B';
  5636. ⓪"suf[m2m] := 'M2M';
  5637. ⓪"suf[m2d] := 'M2D';
  5638. ⓪"(*
  5639. ⓪#* Die folgenden Endungen können verändert werden:
  5640. ⓪#* (Shell dann neu linken und alle Dateien mit den neuen Endungen
  5641. ⓪#* versehen - auch diejenigen in der Library "MM2DEF.M2L"!)
  5642. ⓪#*)
  5643. ⓪"suf[mod] := 'MOD';   (* Object-Files, GEM-Application *)
  5644. ⓪"suf[mos] := 'MOS';   (* Object-Files, TOS-Application *)
  5645. ⓪"suf[mtp] := 'MTP';   (* Object-Files, TTP-Application *)
  5646. ⓪"suf[imp] := 'IMP';   (* Object-Files bei Implementationsmodulen *)
  5647. ⓪"suf[def] := 'DEF';   (* Symbol-Files (übersetzte Definitionsmodule *)
  5648. ⓪"DefSrcSfx:= 'D';     (* ModRef: Definitions-Texte *)
  5649. ⓪"ImpSrcSfx:= 'I';     (* ModRef: Implementations-Texte *)
  5650. ⓪"ModSrcSfx:= 'M';     (* ModRef: Hauptmodul-Texte *)
  5651. ⓪ 
  5652. ⓪"(* Für Compiler: Suffices für erzeugte Dateien *)
  5653. ⓪"DefSfx:= suf[def];   (* Extension f. Symboldatei-Codes *)
  5654. ⓪"ImpSfx:= suf[imp];   (* Extension f. Implementations-Codes *)
  5655. ⓪"ModSfx:= suf[mod];   (* Extension f. Hauptmodul-Codes *)
  5656. ⓪ 
  5657. ⓪"(* Suffices für Loader (CallModule, LoadModule) *)
  5658. ⓪"MOSConfig.DftSfx:= suf[mod]; (* Default-Endung bei 'CallModule' *)
  5659. ⓪"MOSConfig.ImpSfx:= suf[imp]; (* Endung der importierten Module *)
  5660. ⓪ 
  5661. ⓪"(*  calc. of the directory window width (including the date)
  5662. ⓪#*)
  5663. ⓪"dirDateLen := Length (StdDateMask);
  5664. ⓪"dirWdwWidth := dirWidthNoDate + dirDateLen;
  5665. ⓪"
  5666. ⓪"(*  some box info vars
  5667. ⓪#*)
  5668. ⓪"LastCodeName := '';
  5669. ⓪"LastCodeSize := 0L;
  5670. ⓪ 
  5671. ⓪"(*  default configuration
  5672. ⓪#*)
  5673. ⓪ 
  5674. ⓪"MakeFileName := '';
  5675. ⓪ 
  5676. ⓪"WITH shellParm DO
  5677. ⓪$breakActive := TRUE;
  5678. ⓪$defaultOpenCurrDir := FALSE;
  5679. ⓪$confirmCopy := TRUE;
  5680. ⓪$confirmDelete := TRUE;
  5681. ⓪$useAllMemForCopy := TRUE;
  5682. ⓪$
  5683. ⓪$batchPath := batchFile;
  5684. ⓪$
  5685. ⓪$ShellRead (ShellName, args); (* Liest Pfad/Name der Shell und Argumentzeile *)
  5686. ⓪$IF args [0] # 0C THEN
  5687. ⓪&(* M2P-Dateiname wurde in Argumentzeile übergeben *)
  5688. ⓪&Assign (args, parameterPath, voidO)
  5689. ⓪$ELSE
  5690. ⓪&(* M2P-Dateiname wird aus Shell-Pfad u. "MM2SHELL.M2P" zusammengesetzt *)
  5691. ⓪&ConcatPath (ShellName, parameterFile, parameterPath)
  5692. ⓪$END;
  5693. ⓪$ConcatName (parameterPath, suf[m2p], parameterPath);
  5694. ⓪$MakeFullPath (parameterPath, voidI);
  5695. ⓪$
  5696. ⓪$sides := 2;
  5697. ⓪$tracks := 80;
  5698. ⓪$sectors := 9;
  5699. ⓪$
  5700. ⓪$waitOnReturn := FALSE;
  5701. ⓪"END;
  5702. ⓪"
  5703. ⓪"(*  no work file.
  5704. ⓪#*)
  5705. ⓪"FOR i := 0 TO maxWorkFiles - 1 DO WorkField.elems[i].used := FALSE END;
  5706. ⓪"WorkField.noUsed := 0;
  5707. ⓪"WorkField.current := noCurrentWorkfile;
  5708. ⓪"
  5709. ⓪"WITH EditorParm DO
  5710. ⓪$name:= 'GME';
  5711. ⓪$searchSources := FALSE;
  5712. ⓪$waitOnError := FALSE;
  5713. ⓪$tempShellFile := FALSE;
  5714. ⓪$tempShellName := '';
  5715. ⓪$tempEditorFile := FALSE;
  5716. ⓪$tempEditorName := '';
  5717. ⓪$passArgument := TRUE;
  5718. ⓪$passName := TRUE;
  5719. ⓪$passErrorText := TRUE;
  5720. ⓪$passErrorPos := TRUE;
  5721. ⓪"END;
  5722. ⓪"
  5723. ⓪"ErrListFile := 'MODULA.ERR';
  5724. ⓪"MainOutputPath := '';
  5725. ⓪"WITH CompilerParm DO          (*  Compiler-Parameter:     *)
  5726. ⓪$name:= 'MM2Comp';
  5727. ⓪$shortMsgs := FALSE;         (*  - keine Kurzausgaben    *)
  5728. ⓪$protocol := FALSE;          (*  - kein Protokoll        *)
  5729. ⓪$protWidth := stdProtWidth;
  5730. ⓪$protName := '';
  5731. ⓪"END;
  5732. ⓪"
  5733. ⓪"WITH LinkerParm DO
  5734. ⓪$name := 'MM2Link';
  5735. ⓪$FOR i := MIN (LLRange) TO MAX (LLRange) DO
  5736. ⓪&linkList[i].valid := FALSE;
  5737. ⓪&linkList[i].name := '';
  5738. ⓪$END;
  5739. ⓪$optimize := fullOptimize; (*  - Vollständige Optimierung  *)
  5740. ⓪$linkStackSize := 0;
  5741. ⓪$maxLinkMod := 100;
  5742. ⓪$fastLoad := TRUE;
  5743. ⓪$fastCode := TRUE;
  5744. ⓪$fastMemory := TRUE;
  5745. ⓪$symbolFile:= FALSE;
  5746. ⓪$symbolArgs:= '';  (* optional: Argumente f. 'MM2LnkIO.OutputSymbols' *)
  5747. ⓪$outputName:= '';  (* optional: Name d. Ausgabedatei *)
  5748. ⓪"END;
  5749. ⓪"
  5750. ⓪"FOR i := 1 TO MaxTool DO ToolField[i].used := FALSE END;  (*  Keine Tools  *)
  5751. ⓪"
  5752. ⓪"msgStr := '';
  5753. ⓪"selectedDrive := defaultDrv;  (*  Kein Laufwerk angewählt  *)
  5754. ⓪"
  5755. ⓪"(* TRAP #5 belegen, um Fehlermeldung auszugeben, wenn in einem Modul $D+
  5756. ⓪#* verwendet wird, ohne 'Debug'-Modul importiert zu haben *)
  5757. ⓪"wsp.bottom := ADR (ExceptsStack);
  5758. ⓪"wsp.length := SIZE (ExceptsStack);
  5759. ⓪"InstallPreExc (ExcSet{TRAP5}, hdlTrap5, TRUE, wsp, hdl);
  5760. ⓪ 
  5761. ⓪"quitStatus := noQuit;
  5762. ⓪ 
  5763. ⓪ END ShellShell;
  5764. ⓪ 
  5765. ⓪ 
  5766. ⓪((***************************)
  5767. ⓪((* Hier endet 'ShellShell' *)
  5768. ⓪((***************************)
  5769. ⓪ 
  5770. ⓪ 
  5771. ⓪ CONST   mspFileMagic    = 10071898L + 00700000000L;
  5772. ⓪(escKey          = 33C;
  5773. ⓪ 
  5774. ⓪ TYPE    PtrStr = POINTER TO String;
  5775. ⓪(AutoCmd = (noCmd, scan, edit, compile, execute, comp_exec, exec_src,
  5776. ⓪3make_exec, dftMake, dftMake_exec, contMake);
  5777. ⓪ 
  5778. ⓪ VAR  ready    : BOOLEAN;
  5779. ⓪%dummy    : INTEGER;
  5780. ⓪%handle   : INTEGER;
  5781. ⓪%strVal   : BOOLEAN;
  5782. ⓪%buttonNum: CARDINAL;
  5783. ⓪%editorsMakeCmd,
  5784. ⓪%autoCmd    : AutoCmd;
  5785. ⓪%shellStart,
  5786. ⓪%makeActive : BOOLEAN;
  5787. ⓪%callRes    : LoaderResults;
  5788. ⓪%callMsg    : String;
  5789. ⓪%exitCode   : INTEGER;
  5790. ⓪%voidO      : BOOLEAN;
  5791. ⓪%voidI      : INTEGER;
  5792. ⓪%voidC      : CARDINAL;
  5793. ⓪ 
  5794. ⓪%withPost1, withPost2: BOOLEAN;
  5795. ⓪%postAmble1, postAmble2, postArgs1, postArgs2: String;
  5796. ⓪ 
  5797. ⓪ 
  5798. ⓪ PROCEDURE FileAlert (errNo: INTEGER);
  5799. ⓪ 
  5800. ⓪"VAR     msg     : ARRAY[0..50] OF CHAR;
  5801. ⓪ 
  5802. ⓪"BEGIN
  5803. ⓪$IF (errNo < fOK) AND (errNo # fDriveNotReady) AND (errNo # fWriteProtected)
  5804. ⓪$THEN
  5805. ⓪&GetStateMsg (errNo, msg);
  5806. ⓪&Concat ('[1][', msg, msg, voidO);
  5807. ⓪&Append ('][  OK  ]', msg, voidO);
  5808. ⓪&FormAlert (1, msg, voidC);
  5809. ⓪$END;
  5810. ⓪"END FileAlert;
  5811. ⓪ 
  5812. ⓪ PROCEDURE SaveParameter;
  5813. ⓪ 
  5814. ⓪"VAR   f      : File;
  5815. ⓪"
  5816. ⓪"PROCEDURE ioErr (): BOOLEAN;
  5817. ⓪"
  5818. ⓪$VAR ioRes: INTEGER;
  5819. ⓪"
  5820. ⓪$BEGIN
  5821. ⓪&ioRes := State (f);
  5822. ⓪&IF ioRes < fOK THEN
  5823. ⓪(ResetState (f);
  5824. ⓪(FileAlert (ioRes);
  5825. ⓪(Remove (f);
  5826. ⓪(ShowArrow;
  5827. ⓪&END;
  5828. ⓪&RETURN ioRes < fOK
  5829. ⓪$END ioErr;
  5830. ⓪$
  5831. ⓪"PROCEDURE wBlock (VAR data: ARRAY OF BYTE): BOOLEAN;
  5832. ⓪"
  5833. ⓪$BEGIN
  5834. ⓪&WriteBlock (f, data);
  5835. ⓪&RETURN ~ ioErr ()
  5836. ⓪$END wBlock;
  5837. ⓪"
  5838. ⓪"VAR   magic: LONGCARD;
  5839. ⓪(ok: BOOLEAN;
  5840. ⓪"BEGIN
  5841. ⓪$ShowBee;
  5842. ⓪$
  5843. ⓪$Create (f, HomeReplaced (shellParm.parameterPath), writeOnly, replaceOld);
  5844. ⓪$IF State (f) # fOK THEN FileAlert (State (f)); RETURN END;
  5845. ⓪$
  5846. ⓪$magic := mspFileMagic;
  5847. ⓪$LOOP (* Ist keine echte Schleife - lediglich f. einfacheres EXIT *)
  5848. ⓪&ok:= FALSE;
  5849. ⓪&IF ~ wBlock (magic) THEN EXIT END;
  5850. ⓪&IF ~ wBlock (shellParm) THEN EXIT END;
  5851. ⓪&IF ~ wBlock (WorkField) THEN EXIT END;
  5852. ⓪&IF ~ wBlock (lastFn) THEN EXIT END;
  5853. ⓪&IF ~ wBlock (CodeName) THEN EXIT END;
  5854. ⓪&IF ~ wBlock (EditorParm) THEN EXIT END;
  5855. ⓪&IF ~ wBlock (CompilerParm) THEN EXIT END;
  5856. ⓪&IF ~ wBlock (LinkerParm) THEN EXIT END;
  5857. ⓪&IF ~ wBlock (DefaultStackSize) THEN EXIT END;
  5858. ⓪&IF ~ wBlock (TemporaryPath) THEN EXIT END;
  5859. ⓪&IF ~ wBlock (MakeFileName) THEN EXIT END;
  5860. ⓪&IF ~ wBlock (DefLibName) THEN EXIT END;
  5861. ⓪&IF ~ wBlock (ErrListFile) THEN EXIT END;
  5862. ⓪&IF ~ wBlock (MainOutputPath) THEN EXIT END;
  5863. ⓪&IF ~ wBlock (CompilerArgs) THEN EXIT END;
  5864. ⓪&SetGetDeskPositions (f, getValue); IF ioErr () THEN EXIT END;
  5865. ⓪&SetGetWindows (f, getValue); IF ioErr () THEN EXIT END;
  5866. ⓪&IF ~ wBlock (fontSetting) THEN EXIT END;
  5867. ⓪&ok:= TRUE;
  5868. ⓪&EXIT
  5869. ⓪$END;
  5870. ⓪$IF NOT ok THEN RETURN END;
  5871. ⓪$
  5872. ⓪$Close (f);
  5873. ⓪$
  5874. ⓪$ShowArrow;
  5875. ⓪"END SaveParameter;
  5876. ⓪ 
  5877. ⓪ PROCEDURE LoadParameter (REF name: ARRAY OF CHAR);
  5878. ⓪ 
  5879. ⓪"VAR   f      : File;
  5880. ⓪(fname  : FileStr;
  5881. ⓪ 
  5882. ⓪"PROCEDURE ioErr (): BOOLEAN;
  5883. ⓪"
  5884. ⓪$VAR ioRes: INTEGER;
  5885. ⓪"
  5886. ⓪$BEGIN
  5887. ⓪&ioRes := State (f);
  5888. ⓪&IF ioRes < fOK THEN
  5889. ⓪(ResetState (f);
  5890. ⓪(FileAlert (ioRes);
  5891. ⓪(Close (f);
  5892. ⓪(ShowArrow;
  5893. ⓪&END;
  5894. ⓪&RETURN ioRes < fOK
  5895. ⓪$END ioErr;
  5896. ⓪$
  5897. ⓪"PROCEDURE rBlock (VAR data: ARRAY OF BYTE): BOOLEAN;
  5898. ⓪"
  5899. ⓪$BEGIN
  5900. ⓪&ReadBlock (f, data);
  5901. ⓪&RETURN ~ ioErr ()
  5902. ⓪$END rBlock;
  5903. ⓪ 
  5904. ⓪"VAR   magic, n: LONGCARD;
  5905. ⓪(ch: CHAR;
  5906. ⓪(ok: BOOLEAN;
  5907. ⓪"
  5908. ⓪"BEGIN
  5909. ⓪$ShowBee;
  5910. ⓪$
  5911. ⓪$Assign (name, fname, voidO);
  5912. ⓪$ReplaceHome (fname);
  5913. ⓪$MakeFullPath (fname, voidI);
  5914. ⓪$Open (f, fname, readOnly);
  5915. ⓪$IF State (f) # fOK THEN FormAlert (1, noParmAlt^, voidC); ShowArrow; RETURN END;
  5916. ⓪$
  5917. ⓪$IF ~ rBlock (magic) THEN ShowArrow; RETURN END;
  5918. ⓪$IF magic = mspFileMagic THEN
  5919. ⓪&LOOP (* Ist keine echte Schleife - lediglich f. einfacheres EXIT *)
  5920. ⓪(ok:= FALSE;
  5921. ⓪(IF ~ rBlock (shellParm) THEN EXIT END;
  5922. ⓪(IF ~ rBlock (WorkField) THEN EXIT END;
  5923. ⓪(IF ~ rBlock (lastFn) THEN EXIT END;
  5924. ⓪(IF ~ rBlock (CodeName) THEN EXIT END;
  5925. ⓪(IF ~ rBlock (EditorParm) THEN EXIT END;
  5926. ⓪(IF ~ rBlock (CompilerParm) THEN EXIT END;
  5927. ⓪(IF ~ rBlock (LinkerParm) THEN EXIT END;
  5928. ⓪(IF ~ rBlock (DefaultStackSize) THEN EXIT END;
  5929. ⓪(IF ~ rBlock (TemporaryPath) THEN EXIT END;
  5930. ⓪(IF ~ rBlock (MakeFileName) THEN EXIT END;
  5931. ⓪(IF ~ rBlock (DefLibName) THEN EXIT END;
  5932. ⓪(IF ~ rBlock (ErrListFile) THEN EXIT END;
  5933. ⓪(IF ~ rBlock (MainOutputPath) THEN EXIT END;
  5934. ⓪(IF ~ rBlock (CompilerArgs) THEN EXIT END;
  5935. ⓪(SetGetDeskPositions (f, setValue); IF ioErr () THEN EXIT END;
  5936. ⓪(SetGetWindows (f, setValue); IF ioErr () THEN EXIT END;
  5937. ⓪(IF ~EOF (f) THEN
  5938. ⓪*IF ~rBlock (fontSetting) THEN EXIT END;
  5939. ⓪(ELSE
  5940. ⓪*fontSetting.name:= '';
  5941. ⓪*fontSetting.size:= 0;
  5942. ⓪(END;
  5943. ⓪(ok:= TRUE;
  5944. ⓪(EXIT
  5945. ⓪&END;
  5946. ⓪&IF NOT ok THEN ShowArrow; RETURN END;
  5947. ⓪ 
  5948. ⓪&InitWorkfile (0, Work0);
  5949. ⓪&InitWorkfile (1, Work1);
  5950. ⓪&InitWorkfile (2, Work2);
  5951. ⓪&InitWorkfile (3, Work3);
  5952. ⓪&InitWorkfile (4, Work4);
  5953. ⓪&InitWorkfile (5, Work5);
  5954. ⓪&InitWorkfile (6, Work6);
  5955. ⓪&InitWorkfile (7, Work7);
  5956. ⓪&InitWorkfile (8, Work8);
  5957. ⓪&InitWorkfile (9, Work9);
  5958. ⓪&Assign (fname, shellParm.parameterPath, voidO);
  5959. ⓪&SetFonts;
  5960. ⓪&SetWindowSizes;
  5961. ⓪$ELSE
  5962. ⓪&FormAlert (1, noParmAlt^, voidC)
  5963. ⓪$END;
  5964. ⓪$Close (f);
  5965. ⓪$
  5966. ⓪$(*  If a batch file is specified, execute it. Don't load modules, if
  5967. ⓪%*  the <ESC>-key is pressed.
  5968. ⓪%*)
  5969. ⓪$BusyRead (ch);
  5970. ⓪$IF NOT Empty (shellParm.batchPath) THEN
  5971. ⓪&ExecuteBatch (shellParm.batchPath, ch # escKey)
  5972. ⓪$END;
  5973. ⓪$
  5974. ⓪$ShowArrow;
  5975. ⓪"END LoadParameter;
  5976. ⓪ 
  5977. ⓪ 
  5978. ⓪ PROCEDURE PrepareScan;
  5979. ⓪ 
  5980. ⓪"BEGIN
  5981. ⓪$ScanAddr := CallingChain [ScanIndex].relAddr;
  5982. ⓪$ScanOpts := CallingChain [ScanIndex].codeOpts;
  5983. ⓪$Assign (CallingChain [ScanIndex].sourceName, TextName, voidO);
  5984. ⓪"END PrepareScan;
  5985. ⓪ 
  5986. ⓪ PROCEDURE readWorkNames;
  5987. ⓪"BEGIN
  5988. ⓪$WITH WorkField DO
  5989. ⓪&IF current >= 0 THEN
  5990. ⓪(workFName := elems[current].sourceName;
  5991. ⓪(workCName := elems[current].codeName;
  5992. ⓪&ELSE
  5993. ⓪(workFName := ''; workCName := '';
  5994. ⓪&END;
  5995. ⓪$END;
  5996. ⓪"END readWorkNames;
  5997. ⓪ 
  5998. ⓪ PROCEDURE writeWorkName (REF source, code: ARRAY OF CHAR);
  5999. ⓪"VAR i : INTEGER;
  6000. ⓪"BEGIN (* richtige Arbeitsdatei suchen und Code speichern *)
  6001. ⓪$WITH WorkField DO
  6002. ⓪&IF current >= 0 THEN
  6003. ⓪(FOR i:= 0 TO maxWorkFiles-1 DO
  6004. ⓪*IF elems[i].used & StrEqual (source, elems[i].sourceName) THEN
  6005. ⓪,Assign (code, elems[i].codeName, voidO);
  6006. ⓪,RETURN
  6007. ⓪*END
  6008. ⓪(END
  6009. ⓪&END;
  6010. ⓪$END;
  6011. ⓪"END writeWorkName;
  6012. ⓪ 
  6013. ⓪ PROCEDURE Bconout ( c: CHAR );
  6014. ⓪"(*$L-*)
  6015. ⓪"BEGIN
  6016. ⓪$ASSEMBLER
  6017. ⓪(SUBQ.L  #1,A3
  6018. ⓪(MOVEQ   #0,D0
  6019. ⓪(MOVE.B  -(A3),D0
  6020. ⓪(MOVE    D0,-(A7)
  6021. ⓪(MOVE    #2,-(A7)
  6022. ⓪(MOVE    #3,-(A7)
  6023. ⓪(TRAP    #13
  6024. ⓪(ADDQ.L  #6,A7
  6025. ⓪$END
  6026. ⓪"END Bconout;
  6027. ⓪"(*$L=*)
  6028. ⓪ 
  6029. ⓪ (*$Z-*)
  6030. ⓪ PROCEDURE Bconin (): CHAR;
  6031. ⓪ (*$Z=*)
  6032. ⓪"(*$L-*)
  6033. ⓪"BEGIN
  6034. ⓪$ASSEMBLER
  6035. ⓪(MOVE    #2,-(A7)
  6036. ⓪(MOVE    #2,-(A7)
  6037. ⓪(TRAP    #13
  6038. ⓪(ADDQ.L  #4,A7
  6039. ⓪(MOVE.B  D0,(A3)+
  6040. ⓪(CLR.B   (A3)+
  6041. ⓪$END
  6042. ⓪"END Bconin;
  6043. ⓪"(*$L=*)
  6044. ⓪ 
  6045. ⓪ (*$Z-*)
  6046. ⓪ PROCEDURE Bconstat (): BOOLEAN;
  6047. ⓪ (*$Z=*)
  6048. ⓪"(*$L-*)
  6049. ⓪"BEGIN
  6050. ⓪$ASSEMBLER
  6051. ⓪(MOVE    #2,-(A7)
  6052. ⓪(MOVE    #1,-(A7)
  6053. ⓪(TRAP    #13
  6054. ⓪(ADDQ.L  #4,A7
  6055. ⓪(TST     D0
  6056. ⓪(SNE     D0
  6057. ⓪(ANDI    #1,D0
  6058. ⓪(MOVE.W  D0,(A3)+
  6059. ⓪$END
  6060. ⓪"END Bconstat;
  6061. ⓪"(*$L=*)
  6062. ⓪ 
  6063. ⓪ PROCEDURE clrscr;
  6064. ⓪"BEGIN
  6065. ⓪$Bconout (33C); Bconout ('E');
  6066. ⓪"END clrscr;
  6067. ⓪ 
  6068. ⓪ PROCEDURE curon;
  6069. ⓪"BEGIN
  6070. ⓪$Bconout (33C); Bconout ('e');
  6071. ⓪"END curon;
  6072. ⓪ 
  6073. ⓪ PROCEDURE curoff;
  6074. ⓪"BEGIN
  6075. ⓪$Bconout (15C); Bconout (33C); Bconout ('f');
  6076. ⓪"END curoff;
  6077. ⓪ 
  6078. ⓪ PROCEDURE bing;
  6079. ⓪"BEGIN
  6080. ⓪$Bconout (7C);
  6081. ⓪"END bing;
  6082. ⓪ 
  6083. ⓪ 
  6084. ⓪ PROCEDURE alert ( REF s1,s2,s3: ARRAY OF CHAR );
  6085. ⓪"VAR msg: ARRAY [0..269] OF CHAR;
  6086. ⓪"BEGIN
  6087. ⓪$Assign (s1, msg, voidO);
  6088. ⓪$WrapAlert (msg, 0);
  6089. ⓪$IF s2[0] # 0C THEN
  6090. ⓪&Append ('|', msg, strVal);
  6091. ⓪&Append (s2, msg, voidO);
  6092. ⓪&WrapAlert (msg, 0);
  6093. ⓪$END;
  6094. ⓪$Insert ('[0][',0,msg,strVal);
  6095. ⓪$Append ('][]',msg,strVal);
  6096. ⓪$Insert (s3,CARDINAL(Length(msg)-1),msg, voidO);
  6097. ⓪$FormAlert (1, msg,buttonNum);
  6098. ⓪"END alert;
  6099. ⓪"
  6100. ⓪ PROCEDURE load;
  6101. ⓪"VAR     r       : LoaderResults;
  6102. ⓪*msg     : ARRAY [0..79] OF CHAR;
  6103. ⓪*name    : FileStr;
  6104. ⓪"BEGIN
  6105. ⓪$IF Empty (currFn) THEN name := CodeName ELSE name := currFn END;
  6106. ⓪$TellLoading (newTellValue, name);
  6107. ⓪$LoadModule (name, StdPaths, name, msg, r);
  6108. ⓪$IF r # noError THEN alert (conc (name, NoLoadStr^), msg, OkStr^) END;
  6109. ⓪"END load;
  6110. ⓪ 
  6111. ⓪ PROCEDURE unload;
  6112. ⓪"VAR     r       : LoaderResults;
  6113. ⓪*name    : FileStr;
  6114. ⓪"BEGIN
  6115. ⓪$IF Empty (currFn) THEN name := CodeName ELSE name := currFn END;
  6116. ⓪$UnLoadModule (name, r);
  6117. ⓪$IF r # noError THEN alert (conc (name, NoUnloadStr^), '', OkStr^) END;
  6118. ⓪"END unload;
  6119. ⓪ 
  6120. ⓪ PROCEDURE closeAllWindows;
  6121. ⓪"VAR w: CARDINAL;
  6122. ⓪"BEGIN
  6123. ⓪$AESUpdateWindow (TRUE);
  6124. ⓪$LOOP
  6125. ⓪&w:= AESWindows.TopWindow ();
  6126. ⓪&IF w = 0 THEN EXIT END;
  6127. ⓪&AESWindows.CloseWindow (w);
  6128. ⓪&AESWindows.DeleteWindow (w);
  6129. ⓪$END;
  6130. ⓪$IF (GEMEnv.GEMVersion() >= $140) THEN
  6131. ⓪&AESWindows.ResetWindows ();
  6132. ⓪$ELSE
  6133. ⓪&AESUpdateWindow (FALSE);
  6134. ⓪$END;
  6135. ⓪"END closeAllWindows;
  6136. ⓪ 
  6137. ⓪ PROCEDURE call ( VAR modname: ARRAY OF CHAR; args: ARRAY OF CHAR;
  6138. ⓪1stackSize: LONGCARD; interactive, checkError, tool:BOOLEAN );
  6139. ⓪ 
  6140. ⓪"TYPE SufSet = SET OF MySuf;
  6141. ⓪"
  6142. ⓪"VAR sufstr            : ARRAY[0..2] OF CHAR;
  6143. ⓪&dummy             : ARRAY[0..12] OF CHAR;
  6144. ⓪&name, path,
  6145. ⓪&oldPath           : PathStr;
  6146. ⓪&getparm           : BOOLEAN;
  6147. ⓪&prgType           : AESMisc.ProgramType;
  6148. ⓪&sufcnt, suffix    : MySuf;
  6149. ⓪&res               : INTEGER;
  6150. ⓪&dummyChar         : CHAR;
  6151. ⓪&hdl               : ADDRESS;
  6152. ⓪&prevStackSize     : LONGCARD;
  6153. ⓪ 
  6154. ⓪"BEGIN
  6155. ⓪$Assign (modname, name, voidO);
  6156. ⓪$Upper (name);
  6157. ⓪ 
  6158. ⓪$SplitPath (name, path, dummy);
  6159. ⓪$SplitName (dummy,dummy,sufstr);
  6160. ⓪$suffix:= mod;
  6161. ⓪$IF sufstr[0] = 0C THEN
  6162. ⓪&ConcatName (name, suf[mod], name)
  6163. ⓪$ELSE
  6164. ⓪&FOR sufcnt:= MIN (MySuf) TO MAX (MySuf) DO
  6165. ⓪(IF StrEqual (sufstr,suf[sufcnt]) THEN
  6166. ⓪*suffix := sufcnt;
  6167. ⓪(END
  6168. ⓪&END;
  6169. ⓪$END;
  6170. ⓪$prgType:= AESMisc.graphicPrgm;
  6171. ⓪$getparm:= FALSE;
  6172. ⓪$IF suffix IN SufSet {ttp,mtp} THEN getparm:= interactive END;
  6173. ⓪$IF suffix IN SufSet {ttp,mtp,tos,mos} THEN prgType:= AESMisc.textPrgm END;
  6174. ⓪ 
  6175. ⓪$IF getparm THEN
  6176. ⓪&RequestArg (args);
  6177. ⓪$END;
  6178. ⓪ 
  6179. ⓪$GetDefaultPath (oldPath);
  6180. ⓪$IF ~noDirChange THEN
  6181. ⓪&IF (path[0] = 0C) AND NOT tool THEN
  6182. ⓪((* Ist kein Pfad angegeben, bleibt bei Tools und
  6183. ⓪)* Systemprgs der akt. Pfad erhalten
  6184. ⓪)*)
  6185. ⓪(SearchFile (name, StdPaths, fromStart, voidO, name);
  6186. ⓪(SplitPath (name, path, dummy);
  6187. ⓪&END;
  6188. ⓪&ReplaceHome (path);
  6189. ⓪&SetDefaultPath (path, voidI)
  6190. ⓪$END;
  6191. ⓪$
  6192. ⓪$(*$? UseExtKeys: IF NOT tool THEN DeInstallKbdEvents END; *)
  6193. ⓪$
  6194. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  6195. ⓪&closeAllWindows; (* alle noch offenen Fenster (von ACCs) schließen *)
  6196. ⓪$END;
  6197. ⓪$
  6198. ⓪$IF prgType = AESMisc.textPrgm THEN
  6199. ⓪&HideMouse;
  6200. ⓪&clrscr;
  6201. ⓪&curon;
  6202. ⓪$END;
  6203. ⓪$
  6204. ⓪$IF DoShellWrite AND (GEMEnv.GEMVersion() >= $140) THEN
  6205. ⓪&IF ~multiTOS THEN
  6206. ⓪(AESMisc.ShellWrite (TRUE, prgType, name, args);
  6207. ⓪&END
  6208. ⓪$END;
  6209. ⓪ 
  6210. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  6211. ⓪&(* AC_CLOSE-Nachricht an alle Accessories schicken *)
  6212. ⓪&appl_exit; (* nach appl_exit kein AES-Aufruf mehr! *)
  6213. ⓪$END;
  6214. ⓪$
  6215. ⓪$(* ---------------------- Programmstart ------------------------ *)
  6216. ⓪$prevStackSize:= DefaultStackSize;
  6217. ⓪$IF stackSize # 0 THEN DefaultStackSize:= stackSize END;
  6218. ⓪$CallModule (name, StdPaths, args, NIL, exitCode, callMsg, callRes);
  6219. ⓪$DefaultStackSize:= prevStackSize;
  6220. ⓪$(* ---------------------- Programmende ------------------------- *)
  6221. ⓪$
  6222. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  6223. ⓪&(* beim GEM wieder anmelden *)
  6224. ⓪&appl_init;  (* erst jetzt wieder AES-Aufrufe erlaubt! *)
  6225. ⓪$END;
  6226. ⓪ 
  6227. ⓪$IF DoShellWrite AND (GEMEnv.GEMVersion() >= $140) THEN
  6228. ⓪&(* Dies alles funktioniert erst ab TOS 1.4 richtig *)
  6229. ⓪&IF ~multiTOS THEN
  6230. ⓪(AESMisc.ShellWrite (FALSE, AESMisc.graphicPrgm, ShellName, '');
  6231. ⓪&END
  6232. ⓪$END;
  6233. ⓪$
  6234. ⓪$IF prgType = AESMisc.textPrgm THEN
  6235. ⓪&(* Nach Programmende bei TOS-Programmen auf Tastendruck warten *)
  6236. ⓪&IF interactive & shellParm.waitOnReturn
  6237. ⓪)& NOT ScanMode & (callRes = noError) THEN
  6238. ⓪(WHILE Bconstat () DO dummyChar:= Bconin () END;
  6239. ⓪(curon;
  6240. ⓪(dummyChar:= Bconin ()
  6241. ⓪&END;
  6242. ⓪&curoff;
  6243. ⓪&ShowMouse
  6244. ⓪$END;
  6245. ⓪ 
  6246. ⓪$GEMEnv.MouseInput (TRUE); (* ...falls Programm die Maus abgeschaltet hat *)
  6247. ⓪$ShowArrow;
  6248. ⓪ 
  6249. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  6250. ⓪&closeAllWindows; (* alle noch offenen Fenster (von ACCs) schließen *)
  6251. ⓪$END;
  6252. ⓪ 
  6253. ⓪$ClearDeskAndShowMsg;
  6254. ⓪$
  6255. ⓪$AESUpdateWindow (TRUE);
  6256. ⓪ 
  6257. ⓪$IF Inconsistent () THEN
  6258. ⓪&alert (memErrorAlt, '', OkStr^)
  6259. ⓪$END;
  6260. ⓪ 
  6261. ⓪$(*$? UseExtKeys: IF NOT tool THEN InstallKbdEvents END; *)
  6262. ⓪ 
  6263. ⓪$SetDefaultPath (oldPath, res);
  6264. ⓪ 
  6265. ⓪$IF checkError THEN
  6266. ⓪&IF callRes # noError THEN
  6267. ⓪(IF callRes = exitFault THEN
  6268. ⓪*alert (callMsg, '', OkStr^)
  6269. ⓪(ELSE
  6270. ⓪*alert (conc (name, NoExecStr^), callMsg, OkStr^)
  6271. ⓪(END
  6272. ⓪&ELSIF ScanMode THEN
  6273. ⓪(PrepareScan;
  6274. ⓪(IF ScanBox (TextName) THEN
  6275. ⓪*autoCmd := scan
  6276. ⓪(ELSE
  6277. ⓪*autoCmd := noCmd
  6278. ⓪(END
  6279. ⓪&ELSIF exitCode # 0 THEN
  6280. ⓪(CASE exitCode OF
  6281. ⓪*fFileNotFound,
  6282. ⓪*fPathNotFound,
  6283. ⓪*fInvalidDrive: FormError (2)|
  6284. ⓪4(* "Diese Anwendung kann Datei oder Ordner nicht finden" *)
  6285. ⓪*fAccessDenied: FormError (5)|
  6286. ⓪6(* "Datei existiert bereits oder ist Schreibgeschützt" *)
  6287. ⓪*fTooManyOpen,
  6288. ⓪*fInsufficientMemory: FormError (8)|
  6289. ⓪-(* "Es steht nicht genug Speicher für diese Anw. zur Verfügung" *)
  6290. ⓪(ELSE
  6291. ⓪*alert (conc (RetStr^, IntToStr (exitCode, 0)), '', OkStr^)
  6292. ⓪(END
  6293. ⓪&END
  6294. ⓪$END;
  6295. ⓪$ScanMode := FALSE;
  6296. ⓪ 
  6297. ⓪$AESUpdateWindow (FALSE);
  6298. ⓪ 
  6299. ⓪"END call;
  6300. ⓪ 
  6301. ⓪ 
  6302. ⓪ PROCEDURE callEdit (VAR s0: ARRAY OF CHAR; errMsg: BOOLEAN);
  6303. ⓪ 
  6304. ⓪"VAR s, voidStr,
  6305. ⓪&tempPath  : ARRAY [0..126] OF CHAR;
  6306. ⓪&f         : File;
  6307. ⓪&lastBreak : BOOLEAN;
  6308. ⓪&zero      : CARDINAL;
  6309. ⓪ 
  6310. ⓪"PROCEDURE writeTempFile;
  6311. ⓪ 
  6312. ⓪$PROCEDURE stateError (): BOOLEAN;
  6313. ⓪ 
  6314. ⓪&BEGIN
  6315. ⓪(IF State (f) # fOK THEN
  6316. ⓪*FileAlert (State (f));
  6317. ⓪*ResetState (f);
  6318. ⓪*Remove (f);
  6319. ⓪*RETURN TRUE
  6320. ⓪(ELSE RETURN FALSE END;
  6321. ⓪&END stateError;
  6322. ⓪$
  6323. ⓪$PROCEDURE writeLn (VAR str: ARRAY OF CHAR): BOOLEAN;
  6324. ⓪$
  6325. ⓪&BEGIN
  6326. ⓪(Text.WriteString (f, str);
  6327. ⓪(IF stateError () THEN RETURN FALSE END;
  6328. ⓪(Text.WriteLn (f);
  6329. ⓪(IF stateError () THEN RETURN FALSE END;
  6330. ⓪(RETURN TRUE
  6331. ⓪&END writeLn;
  6332. ⓪$
  6333. ⓪$VAR s2: Str128;
  6334. ⓪&
  6335. ⓪$BEGIN
  6336. ⓪&ReplaceHome (tempPath);
  6337. ⓪&Create (f, tempPath, writeSeqTxt, replaceOld);
  6338. ⓪&IF stateError () THEN RETURN END;
  6339. ⓪&IF ~ EditorParm.passName THEN
  6340. ⓪(IF ~ writeLn (TextName) THEN RETURN END;
  6341. ⓪&END;
  6342. ⓪&IF ~ EditorParm.passErrorPos AND errMsg THEN
  6343. ⓪(Assign (CardToStr (TextLine, 0), s2, voidO);
  6344. ⓪(Append (' ', s2, voidO);
  6345. ⓪(Append (CardToStr (TextCol - 1, 0), s2, voidO);
  6346. ⓪(IF ~ writeLn (s2) THEN RETURN END;
  6347. ⓪&END;
  6348. ⓪&IF ~ EditorParm.passErrorText AND errMsg THEN
  6349. ⓪(IF ~ writeLn (ErrorMsg) THEN RETURN END;
  6350. ⓪&END;
  6351. ⓪&Close (f);
  6352. ⓪$END writeTempFile;
  6353. ⓪ 
  6354. ⓪"BEGIN
  6355. ⓪$Split (s0, PosLen (' ', s0, 0), TextName, s, voidO);
  6356. ⓪$IF EditorParm.searchSources THEN
  6357. ⓪&SearchFile (TextName, SrcPaths, fromStart, voidO, TextName)
  6358. ⓪$END;
  6359. ⓪$IF EditorParm.passName THEN Insert (TextName, 0, s, voidO) END;
  6360. ⓪ 
  6361. ⓪$(* Zeiger auf akt. Dateinamen dem Editor mit übergeben
  6362. ⓪&IF isToolbox THEN
  6363. ⓪(Append (' ^', s, voidO);
  6364. ⓪(Append (CardToStr (LONGCARD (ADR (TextName)), 0), s, voidO);
  6365. ⓪(Append (' ', s, voidO);
  6366. ⓪&END;
  6367. ⓪$*)
  6368. ⓪ 
  6369. ⓪$IF EditorParm.tempShellFile THEN
  6370. ⓪&SplitPath (EditorParm.name, tempPath, voidStr);
  6371. ⓪&Append (EditorParm.tempShellName, tempPath, voidO);
  6372. ⓪&Append (tempPath, s, strVal);
  6373. ⓪&writeTempFile;
  6374. ⓪$END;
  6375. ⓪$
  6376. ⓪$IF ~ EditorParm.passArgument THEN s := '' END;
  6377. ⓪$
  6378. ⓪$lastBreak:= shellParm.breakActive;
  6379. ⓪$shellParm.breakActive:= FALSE;
  6380. ⓪$call (EditorParm.name, s, EditorStackSize, FALSE, FALSE, TRUE);
  6381. ⓪$shellParm.breakActive:= lastBreak;
  6382. ⓪$
  6383. ⓪$IF EditorParm.tempEditorFile THEN
  6384. ⓪&SplitPath (EditorParm.name, tempPath, voidStr);
  6385. ⓪&Append (EditorParm.tempEditorName, tempPath, voidO);
  6386. ⓪&ReplaceHome (tempPath);
  6387. ⓪&Open (f, tempPath, readSeqTxt);
  6388. ⓪&IF State (f) = fOK THEN
  6389. ⓪(Text.ReadString (f, s);
  6390. ⓪(Close (f);
  6391. ⓪(zero := 0;
  6392. ⓪(exitCode := StrToCard (s, zero, strVal);
  6393. ⓪(IF ~ strVal THEN exitCode := 0 END;
  6394. ⓪&ELSE
  6395. ⓪(exitCode:= 0
  6396. ⓪&END;
  6397. ⓪$END;
  6398. ⓪$
  6399. ⓪$autoCmd := noCmd;
  6400. ⓪$IF callRes # noError THEN
  6401. ⓪&alert (EdStr^, callMsg, OkStr^)
  6402. ⓪$ELSE
  6403. ⓪&CASE exitCode OF
  6404. ⓪(1: autoCmd := compile|
  6405. ⓪(2: autoCmd := exec_src|
  6406. ⓪(3: autoCmd := dftMake|
  6407. ⓪(4: autoCmd := dftMake_exec|
  6408. ⓪&ELSE
  6409. ⓪&END;
  6410. ⓪&IF (autoCmd = dftMake_exec) OR (autoCmd = dftMake) THEN
  6411. ⓪(IF NOT makeActive THEN
  6412. ⓪*editorsMakeCmd:= autoCmd;
  6413. ⓪*makeActive:= TRUE;
  6414. ⓪(END;
  6415. ⓪(autoCmd:= contMake
  6416. ⓪&ELSE
  6417. ⓪(IF makeActive THEN
  6418. ⓪*FormAlert (1, ContMakeAlt^, buttonNum);
  6419. ⓪*IF buttonNum = 1 THEN
  6420. ⓪,autoCmd:= contMake
  6421. ⓪*END
  6422. ⓪(END
  6423. ⓪&END
  6424. ⓪$END;
  6425. ⓪"END callEdit;
  6426. ⓪ 
  6427. ⓪ PROCEDURE hdedit (wrk: BOOLEAN);
  6428. ⓪ 
  6429. ⓪"VAR name1, name2: NameStr;
  6430. ⓪&dummy       : Str128;
  6431. ⓪"
  6432. ⓪"BEGIN
  6433. ⓪$IF wrk THEN
  6434. ⓪&callEdit (workFName, FALSE);
  6435. ⓪$ELSE
  6436. ⓪&callEdit (currFn, FALSE)
  6437. ⓪$END;
  6438. ⓪$Upper (TextName);
  6439. ⓪$SplitPath (TextName, dummy, name1);
  6440. ⓪$SplitPath (workFName, dummy, name2);
  6441. ⓪$IF NOT StrEqual (name1, name2) THEN lastFn := TextName END;
  6442. ⓪"END hdedit;
  6443. ⓪ 
  6444. ⓪ PROCEDURE hdrun (wrk, tool: BOOLEAN);
  6445. ⓪ 
  6446. ⓪"VAR   found,
  6447. ⓪(codeOK  : BOOLEAN;
  6448. ⓪(f       : File;
  6449. ⓪(cDate,
  6450. ⓪(sDate   : Clock.Date;
  6451. ⓪(cTime,
  6452. ⓪(sTime   : Clock.Time;
  6453. ⓪(sname,
  6454. ⓪(cname,
  6455. ⓪(voidStr,
  6456. ⓪(suffix  : FileStr;
  6457. ⓪ 
  6458. ⓪ 
  6459. ⓪"PROCEDURE longTime (d:Clock.Date; t:Clock.Time): LONGCARD;
  6460. ⓪$BEGIN
  6461. ⓪&RETURN LONG (Clock.PackDate (d)) * $10000 + LONG (Clock.PackTime (t))
  6462. ⓪$END longTime;
  6463. ⓪ 
  6464. ⓪"PROCEDURE getCodeDateTime (    suffix: MySuf;
  6465. ⓪Apaths : PathList;
  6466. ⓪=VAR cname : FileStr;
  6467. ⓪=VAR found : BOOLEAN);
  6468. ⓪$VAR testName: FileStr;
  6469. ⓪(testN2: FileStr;
  6470. ⓪(path: ptrString;
  6471. ⓪$BEGIN
  6472. ⓪&found:= FALSE;
  6473. ⓪ 
  6474. ⓪&ConcatName (cname, suf[suffix], testN2);
  6475. ⓪&IF NOT Empty (MainOutputPath) THEN
  6476. ⓪((* Eingestellten Ausgabe-Pfad prüfen *)
  6477. ⓪(Concat (MainOutputPath, testN2, testName, voidO);
  6478. ⓪&ELSE
  6479. ⓪((* Ausgabe-Pfad aus Compiler-Pfaden prüfen *)
  6480. ⓪(IF suffix = imp THEN
  6481. ⓪*Concat (ImpOutPath, testN2, testName, voidO);
  6482. ⓪(ELSE
  6483. ⓪*Concat (ModOutPath, testN2, testName, voidO);
  6484. ⓪(END
  6485. ⓪&END;
  6486. ⓪&ReplaceHome (testName);
  6487. ⓪&Open (f, testName, readOnly);
  6488. ⓪&found:= (State (f) >= fOK);
  6489. ⓪&IF NOT found THEN
  6490. ⓪((* Datei auf Default-Pfaden suchen *)
  6491. ⓪(SearchFile (testN2, paths, fromStart, found, testName);
  6492. ⓪(IF found THEN
  6493. ⓪*Open (f, testName, readOnly);
  6494. ⓪(END
  6495. ⓪&END;
  6496. ⓪&IF found THEN
  6497. ⓪(GetDateTime (f, cDate, cTime);
  6498. ⓪(Close (f);
  6499. ⓪(cname:= testName;
  6500. ⓪&END;
  6501. ⓪$END getCodeDateTime;
  6502. ⓪ 
  6503. ⓪"BEGIN (* hdrun *)
  6504. ⓪$codeOK := FALSE;
  6505. ⓪$(* check, wether code is valid if source is executed *)
  6506. ⓪$IF wrk THEN
  6507. ⓪&SearchFile (workFName, SrcPaths, fromStart, found, sname);
  6508. ⓪$ELSIF IsSourceName (currFn) THEN
  6509. ⓪&SearchFile (currFn, SrcPaths, fromStart, found, sname)
  6510. ⓪$ELSE
  6511. ⓪&(* wir haben einen Code -> sofort ausführen *)
  6512. ⓪&codeOK := TRUE
  6513. ⓪$END;
  6514. ⓪$IF NOT codeOK THEN
  6515. ⓪&IF found THEN
  6516. ⓪((* Source vorhanden *)
  6517. ⓪(IF wrk THEN
  6518. ⓪*workFName:= sname; cname:= workCName
  6519. ⓪(ELSE
  6520. ⓪*currFn:= sname; cname:= ''
  6521. ⓪(END;
  6522. ⓪(IF Empty (cname) THEN
  6523. ⓪*(* Wir müssen den Code suchen *)
  6524. ⓪*SplitPath (sname, voidStr, cname);
  6525. ⓪*SplitName (cname, cname, suffix);
  6526. ⓪*getCodeDateTime (mod, ModPaths, cname, codeOK);
  6527. ⓪*IF NOT codeOK THEN
  6528. ⓪,getCodeDateTime (mos, ModPaths, cname, codeOK) END;
  6529. ⓪*IF NOT codeOK THEN
  6530. ⓪,getCodeDateTime (mtp, ModPaths, cname, codeOK) END;
  6531. ⓪*IF NOT codeOK THEN
  6532. ⓪,getCodeDateTime (imp, ImpPaths, cname, codeOK) END;
  6533. ⓪(ELSE
  6534. ⓪*(* Code schon vorhanden *)
  6535. ⓪*Open (f, cname, readOnly);
  6536. ⓪*codeOK:= (State (f) = fOK);
  6537. ⓪*IF codeOK THEN
  6538. ⓪,GetDateTime (f, cDate, cTime);
  6539. ⓪,Close (f);
  6540. ⓪*END;
  6541. ⓪(END;
  6542. ⓪(IF codeOK THEN
  6543. ⓪*(* Code vorhanden -> Zeit der Source ermitteln und mit Code vergl. *)
  6544. ⓪*Open (f, sname, readOnly);
  6545. ⓪*GetDateTime (f, sDate, sTime);
  6546. ⓪*Close (f);
  6547. ⓪*codeOK:= longTime (cDate,cTime) >= longTime (sDate,sTime);
  6548. ⓪(END;
  6549. ⓪&ELSE
  6550. ⓪((* Source nicht vorhanden -> Fehler melden? *)
  6551. ⓪((* wenn nicht, wird einfach Compiler gestartet... (weil codeOK=FALSE) *)
  6552. ⓪&END;
  6553. ⓪$ELSE
  6554. ⓪&cname:= currFn
  6555. ⓪$END;
  6556. ⓪$IF codeOK THEN
  6557. ⓪&IF wrk THEN workCName := cname
  6558. ⓪&ELSE CodeName := cname END;
  6559. ⓪&call (cname, args, 0, TRUE, TRUE, tool)
  6560. ⓪$ELSE
  6561. ⓪&IF wrk THEN workCName:= '' END;
  6562. ⓪&TextName := sname;
  6563. ⓪&autoCmd := comp_exec
  6564. ⓪$END
  6565. ⓪"END hdrun;
  6566. ⓪ 
  6567. ⓪ 
  6568. ⓪ PROCEDURE DoEditBox (batch, mustShow: BOOLEAN; VAR cont: BOOLEAN);
  6569. ⓪"VAR s: String;
  6570. ⓪&msg: Str128;
  6571. ⓪&buttonNum: CARDINAL;
  6572. ⓪"BEGIN
  6573. ⓪$(* Signalton: *)
  6574. ⓪$bing;
  6575. ⓪$IF mustShow OR EditorParm.waitOnError THEN
  6576. ⓪&msg := '[2][][]';
  6577. ⓪&IF batch THEN
  6578. ⓪(Insert (EditBatStr^, 6, msg, voidO)
  6579. ⓪&ELSE
  6580. ⓪(Insert (EditStr^, 6, msg, voidO)
  6581. ⓪&END;
  6582. ⓪&s:= ErrorMsg;
  6583. ⓪&WrapAlert (s, 0);
  6584. ⓪&Insert (s, 4, msg, voidO);
  6585. ⓪&FormAlert (1, msg, buttonNum);
  6586. ⓪&IF buttonNum = 1 THEN
  6587. ⓪(autoCmd:= edit; cont:= FALSE;
  6588. ⓪&ELSE
  6589. ⓪(autoCmd:= noCmd; cont:= (buttonNum = 2);
  6590. ⓪&END
  6591. ⓪$ELSE
  6592. ⓪&autoCmd:= edit; cont:= FALSE;
  6593. ⓪$END
  6594. ⓪"END DoEditBox;
  6595. ⓪ 
  6596. ⓪ 
  6597. ⓪ (*  callComp -- Calls the compiler to compile the file 'modName'.
  6598. ⓪!*              'work = TRUE' means the workfile is compiled.
  6599. ⓪!*              'batch = TRUE' means the compiler is called while
  6600. ⓪!*              executing a batch file. In that case 'cont' states,
  6601. ⓪!*              if the execution of the batch file has to continue
  6602. ⓪!*              after this proc. returns.
  6603. ⓪!*)
  6604. ⓪ 
  6605. ⓪ PROCEDURE callComp (VAR modname: ARRAY OF CHAR;
  6606. ⓪8work,
  6607. ⓪8batch  : BOOLEAN;
  6608. ⓪4VAR cont   : BOOLEAN);
  6609. ⓪ 
  6610. ⓪"VAR i:INTEGER;
  6611. ⓪&s,msg:Str128;
  6612. ⓪ 
  6613. ⓪"BEGIN
  6614. ⓪$(*  String mit Compileroptionen aufbauen.
  6615. ⓪%*)
  6616. ⓪$WITH CompilerParm DO
  6617. ⓪&IF shortMsgs THEN s:= ' -Q' ELSE s:= ' +Q' END;
  6618. ⓪&Append (' ', s, voidO);
  6619. ⓪&Append (CompilerArgs, s, voidO);
  6620. ⓪&IF ~ Empty (MainOutputPath) THEN
  6621. ⓪(Append (' /O', s, voidO);
  6622. ⓪(Append (MainOutputPath, s, voidO);
  6623. ⓪&END;
  6624. ⓪&IF protocol THEN
  6625. ⓪(Append (' /C', s, voidO);
  6626. ⓪(Append (CardToStr (protWidth, 0), s, voidO);
  6627. ⓪(Append (' /P', s, voidO);
  6628. ⓪(Append (protName, s, voidO);
  6629. ⓪&END;
  6630. ⓪$END;
  6631. ⓪$
  6632. ⓪$CodeName:= '';
  6633. ⓪$IF autoCmd = scan THEN ScanMode:= TRUE END;
  6634. ⓪$call (CompilerParm.name, conc (modname, s),
  6635. ⓪*CompilerStackSize, FALSE, FALSE, TRUE);
  6636. ⓪$
  6637. ⓪$cont:= TRUE;
  6638. ⓪$IF callRes # noError THEN
  6639. ⓪&alert (CompStr^, callMsg, OkStr^);
  6640. ⓪&autoCmd:= noCmd
  6641. ⓪$ELSE
  6642. ⓪&CASE exitCode OF
  6643. ⓪(0:   IF autoCmd = scan THEN
  6644. ⓪/autoCmd:= edit
  6645. ⓪-ELSIF ~ batch THEN
  6646. ⓪-
  6647. ⓪/IF makeActive THEN
  6648. ⓪1CodeName:= LastCodeName;
  6649. ⓪/ELSE
  6650. ⓪1Upper (CodeName);
  6651. ⓪1LastCodeName:= CodeName;
  6652. ⓪1LastCodeSize:= CodeSize;
  6653. ⓪/END;
  6654. ⓪/IF work THEN
  6655. ⓪1workCName:= CodeName;
  6656. ⓪1writeWorkName (TextName, CodeName);
  6657. ⓪/END;
  6658. ⓪/IF autoCmd = comp_exec THEN
  6659. ⓪1autoCmd:= execute
  6660. ⓪/ELSE
  6661. ⓪1autoCmd:= noCmd
  6662. ⓪/END;
  6663. ⓪/
  6664. ⓪-END|
  6665. ⓪(2:   DoEditBox (batch, TRUE, cont)|
  6666. ⓪(3:   DoEditBox (batch, FALSE, cont)
  6667. ⓪&ELSE
  6668. ⓪(autoCmd:= noCmd
  6669. ⓪&END
  6670. ⓪$END
  6671. ⓪"END callComp;
  6672. ⓪ 
  6673. ⓪ 
  6674. ⓪ PROCEDURE callLink (VAR moduleName: ARRAY OF CHAR);
  6675. ⓪ 
  6676. ⓪"VAR s: ARRAY [0..124] OF CHAR;
  6677. ⓪"
  6678. ⓪"BEGIN
  6679. ⓪$Assign (moduleName, s, voidO);
  6680. ⓪$WITH LinkerParm DO
  6681. ⓪&IF optimize = partOptimize THEN
  6682. ⓪(Append (' -H', s, voidO);
  6683. ⓪&ELSIF optimize = nameOptimize THEN
  6684. ⓪(Append (' -M', s, voidO);
  6685. ⓪&ELSIF optimize = fullOptimize THEN
  6686. ⓪(Append (' -F', s, voidO);
  6687. ⓪&END;
  6688. ⓪&IF fastLoad THEN
  6689. ⓪(Append (' -0', s, voidO)
  6690. ⓪&END;
  6691. ⓪&IF fastCode THEN
  6692. ⓪(Append (' -1', s, voidO)
  6693. ⓪&END;
  6694. ⓪&IF fastMemory THEN
  6695. ⓪(Append (' -2', s, voidO)
  6696. ⓪&END;
  6697. ⓪&IF symbolFile THEN
  6698. ⓪(Append (' -S', s, voidO);
  6699. ⓪(Append (symbolArgs, s, voidO)
  6700. ⓪&END;
  6701. ⓪&IF outputName[0] # '' THEN
  6702. ⓪(Append (' -O', s, voidO);
  6703. ⓪(Append (outputName, s, voidO)
  6704. ⓪&END;
  6705. ⓪&call (name, s, LinkerStackSize, FALSE, FALSE, TRUE);
  6706. ⓪$END;
  6707. ⓪$IF callRes # noError THEN
  6708. ⓪&alert (LinkStr^, callMsg, OkStr^)
  6709. ⓪$END
  6710. ⓪"END callLink;
  6711. ⓪ 
  6712. ⓪ 
  6713. ⓪ PROCEDURE callMake (REF name: ARRAY OF CHAR; batch: BOOLEAN; VAR cont: BOOLEAN);
  6714. ⓪ 
  6715. ⓪"BEGIN
  6716. ⓪$call (shellParm.makeName, name, MakeStackSize, FALSE, FALSE, TRUE);
  6717. ⓪$cont:= TRUE;
  6718. ⓪$IF callRes # noError THEN
  6719. ⓪&alert (MakeStr^, callMsg, OkStr^);
  6720. ⓪&autoCmd:= noCmd;
  6721. ⓪$ELSE
  6722. ⓪&CASE exitCode OF
  6723. ⓪(0: LastCodeName:= CodeName;
  6724. ⓪+LastCodeSize:= 0L;
  6725. ⓪+ConcatPath (TemporaryPath, MakeCompFileName, TextName);
  6726. ⓪+ReplaceHome (TextName);
  6727. ⓪+IF autoCmd = make_exec THEN autoCmd:= comp_exec
  6728. ⓪+ELSE autoCmd:= compile END|
  6729. ⓪(1: IF autoCmd = make_exec THEN autoCmd:= execute
  6730. ⓪+ELSE autoCmd:= noCmd END|
  6731. ⓪(2: DoEditBox (batch, FALSE, cont)
  6732. ⓪&ELSE
  6733. ⓪(autoCmd:= noCmd;
  6734. ⓪&END;
  6735. ⓪$END
  6736. ⓪"END callMake;
  6737. ⓪ 
  6738. ⓪ 
  6739. ⓪ PROCEDURE hdscan (wrk: BOOLEAN);
  6740. ⓪ 
  6741. ⓪"BEGIN
  6742. ⓪$ErrorMsg:= '<Scanned>';
  6743. ⓪$autoCmd:= scan;
  6744. ⓪$IF wrk THEN callComp (workFName, TRUE, FALSE, voidO);
  6745. ⓪$ELSIF Empty (currFn) THEN callComp (lastFn, FALSE, FALSE, voidO)
  6746. ⓪$ELSE callComp (currFn, FALSE, FALSE, voidO) END;
  6747. ⓪"END hdscan;
  6748. ⓪ 
  6749. ⓪ PROCEDURE hdcomp (wrk: BOOLEAN);
  6750. ⓪ 
  6751. ⓪"BEGIN
  6752. ⓪$IF wrk THEN callComp (workFName, TRUE, FALSE, voidO);
  6753. ⓪$ELSE callComp (currFn, FALSE, FALSE, voidO); lastFn:= currFn; END;
  6754. ⓪"END hdcomp;
  6755. ⓪ 
  6756. ⓪ PROCEDURE hdlink (wrk: BOOLEAN);
  6757. ⓪ 
  6758. ⓪"BEGIN
  6759. ⓪$IF wrk THEN callLink (workCName)
  6760. ⓪$ELSE callLink (currFn) END;
  6761. ⓪"END hdlink;
  6762. ⓪"
  6763. ⓪ PROCEDURE hdmake (wrk: BOOLEAN);
  6764. ⓪ 
  6765. ⓪"BEGIN
  6766. ⓪$IF wrk THEN callMake (workFName, FALSE, voidO)
  6767. ⓪$ELSE callMake (currFn, FALSE, voidO) END;
  6768. ⓪"END hdmake;
  6769. ⓪ 
  6770. ⓪ PROCEDURE action (what: actionType; wrkFile, tool: BOOLEAN);
  6771. ⓪ 
  6772. ⓪"TYPE aTypeSet = SET OF actionType;
  6773. ⓪"
  6774. ⓪"CONST noHideAction = aTypeSet {doLoad, doUnLd, doCont};
  6775. ⓪"
  6776. ⓪"VAR s       : Str128;
  6777. ⓪&dummy, i: CARDINAL;
  6778. ⓪&n1, n2  : ARRAY [0..11] OF CHAR;
  6779. ⓪&hidden  : BOOLEAN;
  6780. ⓪ 
  6781. ⓪"BEGIN
  6782. ⓪$IF wrkFile THEN readWorkNames END;
  6783. ⓪$
  6784. ⓪$IF what IN noHideAction THEN hidden:= FALSE
  6785. ⓪$ELSE HideSS (TRUE); hidden:= TRUE END;
  6786. ⓪$
  6787. ⓪$editorsMakeCmd:= noCmd;
  6788. ⓪$makeActive:= FALSE;
  6789. ⓪$CASE what OF
  6790. ⓪&doEdit: hdedit (wrkFile)|
  6791. ⓪&doComp: hdcomp (wrkFile)|
  6792. ⓪&doExec: hdrun (wrkFile, tool);
  6793. ⓪.IF wrkFile THEN writeWorkName (workFName, workCName) END|
  6794. ⓪&doLink: hdlink (wrkFile)|
  6795. ⓪&doScan: hdscan (wrkFile)|
  6796. ⓪&doCpEx: autoCmd := comp_exec; hdcomp (wrkFile)|
  6797. ⓪&doLoad: load|
  6798. ⓪&doUnLd: unload|
  6799. ⓪&doCont: InputScan (ErrorMsg, ScanIndex);
  6800. ⓪.PrepareScan;
  6801. ⓪.IF ScanBox (TextName) THEN
  6802. ⓪0HideSS (TRUE); hidden:= TRUE;
  6803. ⓪0autoCmd:= scan;
  6804. ⓪0callComp (TextName, FALSE, FALSE, voidO)
  6805. ⓪.END|
  6806. ⓪&doBtch: IF wrkFile THEN ExecuteBatch (workFName, TRUE)
  6807. ⓪.ELSE ExecuteBatch (currFn, TRUE) END|
  6808. ⓪&doParm: IF wrkFile THEN LoadParameter (workFName)
  6809. ⓪.ELSE LoadParameter (currFn) END|
  6810. ⓪&doMake,
  6811. ⓪&doMkEx,
  6812. ⓪&doDftM: makeActive:= TRUE;
  6813. ⓪.autoCmd:= contMake
  6814. ⓪$ELSE
  6815. ⓪$END;
  6816. ⓪ 
  6817. ⓪$REPEAT
  6818. ⓪&CASE autoCmd OF
  6819. ⓪ 
  6820. ⓪(contMake:  CASE what OF
  6821. ⓪5doMake: autoCmd:= noCmd; hdmake (wrkFile)|
  6822. ⓪5doMkEx: autoCmd:= make_exec; hdmake (wrkFile)|
  6823. ⓪5doDftM: autoCmd:= dftMake
  6824. ⓪3ELSE
  6825. ⓪5autoCmd:= editorsMakeCmd
  6826. ⓪3END|
  6827. ⓪ 
  6828. ⓪(edit     : Concat (TextName, ' ', s, strVal);
  6829. ⓪3IF EditorParm.passErrorPos THEN
  6830. ⓪5Append (CardToStr (TextLine, 0), s, strVal);
  6831. ⓪5Append (' ', s, strVal);
  6832. ⓪5Append (CardToStr (TextCol - 1, 0), s, strVal);
  6833. ⓪5Append (' ', s, strVal);
  6834. ⓪3END;
  6835. ⓪3IF EditorParm.passErrorText THEN
  6836. ⓪5Append ('"', s, strVal);
  6837. ⓪5Append (ErrorMsg, s, voidO);
  6838. ⓪5Append ('" ', s, strVal);
  6839. ⓪3END;
  6840. ⓪3callEdit (s, TRUE)|
  6841. ⓪ 
  6842. ⓪(scan,
  6843. ⓪(compile,
  6844. ⓪(comp_exec: callComp (TextName, wrkFile, FALSE, voidO)|
  6845. ⓪(
  6846. ⓪(exec_src : autoCmd:= noCmd;
  6847. ⓪3workFName:= '';
  6848. ⓪3workCName:= '';
  6849. ⓪3wrkFile:= FALSE;
  6850. ⓪3WITH WorkField DO
  6851. ⓪5IF current >= 0 THEN
  6852. ⓪7i:= 0;
  6853. ⓪7LOOP (* workFile richtig bestimmen *)
  6854. ⓪9WITH elems[i] DO
  6855. ⓪;IF used & StrEqual (TextName, sourceName) THEN
  6856. ⓪=workFName:= sourceName;
  6857. ⓪=workCName:= codeName;
  6858. ⓪=wrkFile:= TRUE;
  6859. ⓪=EXIT
  6860. ⓪;END;
  6861. ⓪9END;
  6862. ⓪9INC (i);
  6863. ⓪9IF i = maxWorkFiles THEN
  6864. ⓪;EXIT
  6865. ⓪9END;
  6866. ⓪7END
  6867. ⓪5END;
  6868. ⓪3END;
  6869. ⓪3IF ~wrkFile THEN currFn:= TextName END;
  6870. ⓪3hdrun (wrkFile, tool);
  6871. ⓪3IF wrkFile THEN writeWorkName (workFName, workCName) END|
  6872. ⓪ 
  6873. ⓪(execute  : autoCmd:= noCmd;
  6874. ⓪3call (CodeName, args, 0, TRUE, TRUE, tool)|
  6875. ⓪ 
  6876. ⓪(dftMake_exec,
  6877. ⓪(dftMake  : IF autoCmd = dftMake_exec THEN autoCmd:= make_exec END;
  6878. ⓪3callMake ('' (* >> Make verw. Default-Namen aus ShellMsg *), FALSE, voidO)|
  6879. ⓪&ELSE
  6880. ⓪&END
  6881. ⓪$UNTIL autoCmd = noCmd;
  6882. ⓪$
  6883. ⓪$Assign (lastFn, TextName, voidO);
  6884. ⓪$
  6885. ⓪$IF hidden THEN ShowSS (TRUE) END;
  6886. ⓪"END action;
  6887. ⓪ 
  6888. ⓪ 
  6889. ⓪ 
  6890. ⓪ TYPE    pathEntry       = RECORD
  6891. ⓪<used: BOOLEAN;
  6892. ⓪<path: PathStr;
  6893. ⓪:END;
  6894. ⓪ 
  6895. ⓪ VAR     pathArray: ARRAY [1..MaxSearchPaths] OF pathEntry;
  6896. ⓪ 
  6897. ⓪ PROCEDURE ExecuteBatch (name: ARRAY OF CHAR; load: BOOLEAN);
  6898. ⓪ 
  6899. ⓪"VAR f                 : File;
  6900. ⓪&s, arg            : ARRAY[0..255] OF CHAR;
  6901. ⓪&gotLine, cont,
  6902. ⓪&doIt              : BOOLEAN;
  6903. ⓪&result            : INTEGER;
  6904. ⓪&oldDrive          : Drive;
  6905. ⓪&oldPath           : PathStr;
  6906. ⓪"
  6907. ⓪"PROCEDURE delSpc (VAR s:ARRAY OF CHAR);
  6908. ⓪$BEGIN
  6909. ⓪&WHILE s[0] = ' ' DO Delete (s,0,1, voidO) END
  6910. ⓪$END delSpc;
  6911. ⓪"
  6912. ⓪"PROCEDURE equ (a,b: ARRAY OF CHAR): BOOLEAN;
  6913. ⓪$BEGIN
  6914. ⓪&Upper (a);
  6915. ⓪&Upper (b);
  6916. ⓪&RETURN Compare (FileName (a), FileName (b)) = equal
  6917. ⓪$END equ;
  6918. ⓪ 
  6919. ⓪"PROCEDURE setLinkName (VAR n:ARRAY OF CHAR);
  6920. ⓪$VAR first: CHAR;
  6921. ⓪(i: CARDINAL;
  6922. ⓪(useEmpty: BOOLEAN;
  6923. ⓪$BEGIN
  6924. ⓪&first:=n[0];
  6925. ⓪&IF (first = '-') OR (first = '+') THEN
  6926. ⓪(Delete (n, 0, 1, voidO);
  6927. ⓪(delSpc (n);
  6928. ⓪&END;
  6929. ⓪&FOR useEmpty:= FALSE TO TRUE DO
  6930. ⓪(FOR i:= MIN (LLRange) TO  MAX (LLRange) DO
  6931. ⓪*IF equ (LinkerParm.linkList[i].name, n)
  6932. ⓪*OR (useEmpty AND Empty (LinkerParm.linkList[i].name)) THEN
  6933. ⓪,LinkerParm.linkList[i].valid:= (first # '-');
  6934. ⓪,Assign (n, LinkerParm.linkList[i].name, voidO);
  6935. ⓪,RETURN
  6936. ⓪*END
  6937. ⓪(END
  6938. ⓪&END
  6939. ⓪$END setLinkName;
  6940. ⓪"
  6941. ⓪"PROCEDURE setToolName (VAR n:ARRAY OF CHAR);
  6942. ⓪$VAR i: CARDINAL;
  6943. ⓪$BEGIN
  6944. ⓪&FOR i:=1 TO MaxTool DO
  6945. ⓪(IF ~ToolField[i].used THEN
  6946. ⓪*ToolField[i].used:= TRUE;
  6947. ⓪*Assign (n,ToolField[i].name, voidO);
  6948. ⓪*RETURN
  6949. ⓪(END
  6950. ⓪&END
  6951. ⓪$END setToolName;
  6952. ⓪"
  6953. ⓪"PROCEDURE getFirstPath (paths: PathList; VAR path: ARRAY OF CHAR);
  6954. ⓪$VAR entry: PathEntry;
  6955. ⓪$BEGIN
  6956. ⓪&Lists.ResetList (paths);
  6957. ⓪&entry:= Lists.NextEntry (paths);
  6958. ⓪&IF entry # NIL THEN
  6959. ⓪(Assign (entry^, path, voidO)
  6960. ⓪&ELSE
  6961. ⓪(path[0]:= ''
  6962. ⓪&END
  6963. ⓪$END getFirstPath;
  6964. ⓪"
  6965. ⓪"PROCEDURE killPaths (VAR paths: PathList);
  6966. ⓪"
  6967. ⓪$VAR entry: ADDRESS;
  6968. ⓪(idx  : CARDINAL;
  6969. ⓪"
  6970. ⓪$BEGIN
  6971. ⓪&Lists.ResetList (paths);
  6972. ⓪&entry:= Lists.PrevEntry (paths);
  6973. ⓪&WHILE entry # NIL DO
  6974. ⓪(idx:= 1;
  6975. ⓪(WHILE (idx <= MaxSearchPaths)
  6976. ⓪.AND (ADR (pathArray[idx].path) # entry) DO INC (idx) END;
  6977. ⓪(IF idx <= MaxSearchPaths THEN pathArray[idx].used:= FALSE END;
  6978. ⓪(Lists.RemoveEntry (paths, voidO);
  6979. ⓪(entry:= Lists.CurrentEntry (paths);
  6980. ⓪&END;
  6981. ⓪$END killPaths;
  6982. ⓪"
  6983. ⓪"PROCEDURE setP ( VAR paths: PathList );
  6984. ⓪$VAR err:BOOLEAN; c:CHAR; idx: CARDINAL;
  6985. ⓪$BEGIN
  6986. ⓪&killPaths (paths);
  6987. ⓪&idx:= 1;
  6988. ⓪&LOOP
  6989. ⓪(IF EOF (f) THEN EXIT END;
  6990. ⓪(Text.ReadString (f,s);
  6991. ⓪(IF s[0] # ' ' THEN EXIT END;
  6992. ⓪(WHILE (idx <= MaxSearchPaths) AND pathArray[idx].used DO INC (idx) END;
  6993. ⓪(IF idx <= MaxSearchPaths THEN
  6994. ⓪*EatSpaces (s);
  6995. ⓪*IF Compare ('.',s) = equal THEN s:= '' END;
  6996. ⓪*ValidatePath (s);
  6997. ⓪*Assign (s,pathArray[idx].path,err);
  6998. ⓪*Lists.AppendEntry (paths,ADR(pathArray[idx].path),err);
  6999. ⓪*pathArray[idx].used:= TRUE;
  7000. ⓪*INC (idx)
  7001. ⓪(ELSE
  7002. ⓪*alert (NoPathsStr^, '', OkStr^)
  7003. ⓪(END
  7004. ⓪&END;
  7005. ⓪&gotLine:= TRUE;
  7006. ⓪$END setP;
  7007. ⓪"
  7008. ⓪"PROCEDURE is (REF s0:ARRAY OF CHAR): BOOLEAN;
  7009. ⓪$BEGIN
  7010. ⓪&RETURN StrEqual (s0,s)
  7011. ⓪$END is;
  7012. ⓪ 
  7013. ⓪"PROCEDURE prep (REF in: ARRAY OF CHAR): BOOLEAN;
  7014. ⓪$BEGIN
  7015. ⓪&Split (in,PosLen (' ',in,0),s,arg,strVal);
  7016. ⓪&delSpc (arg);
  7017. ⓪&Upper (s);
  7018. ⓪&RETURN (s[0] # 0C) AND (s[0] # '*')
  7019. ⓪$END prep;
  7020. ⓪ 
  7021. ⓪"PROCEDURE getLC (VAR l: LONGCARD);
  7022. ⓪$VAR i: CARDINAL;
  7023. ⓪$BEGIN
  7024. ⓪&i:= 0;
  7025. ⓪&l:= StrToLCard (arg, i, strVal);
  7026. ⓪$END getLC;
  7027. ⓪ 
  7028. ⓪"VAR found, tell: BOOLEAN;
  7029. ⓪&i: CARDINAL;
  7030. ⓪&res : INTEGER;
  7031. ⓪ 
  7032. ⓪"PROCEDURE unTell;
  7033. ⓪$BEGIN
  7034. ⓪&IF tell THEN
  7035. ⓪(TellLoading (endTell, '');
  7036. ⓪(tell:= FALSE
  7037. ⓪&END;
  7038. ⓪$END unTell;
  7039. ⓪ 
  7040. ⓪"BEGIN
  7041. ⓪$AESUpdateWindow (TRUE);
  7042. ⓪$ShowBee;
  7043. ⓪$tell:= FALSE;
  7044. ⓪$SearchFile (name, StdPaths, fromStart, found, name);
  7045. ⓪$Open (f, name, readSeqTxt);
  7046. ⓪$IF State (f) < 0 THEN
  7047. ⓪&GetStateMsg (State(f), s);
  7048. ⓪&alert (InfStr^, s, OkStr^);
  7049. ⓪$ELSE
  7050. ⓪&gotLine:= FALSE;
  7051. ⓪&cont:= TRUE;
  7052. ⓪&REPEAT
  7053. ⓪ 
  7054. ⓪(IF NOT gotLine THEN Text.ReadString (f, s) END;
  7055. ⓪(gotLine:= FALSE;
  7056. ⓪(
  7057. ⓪(doIt:= FALSE;
  7058. ⓪(IF prep (s) THEN
  7059. ⓪*IF is ('IF_SHELLSTART') THEN    (*  IF-Clause  *)
  7060. ⓪,IF shellStart THEN
  7061. ⓪.doIt:= prep (arg);
  7062. ⓪,END;
  7063. ⓪*ELSIF is ('IF_EXITCODE') THEN
  7064. ⓪,i:= 0;
  7065. ⓪,IF StrToInt (arg, i, voidO) = exitCode THEN
  7066. ⓪.Copy (arg, i, 200, arg, voidO);
  7067. ⓪.doIt:= prep (arg);
  7068. ⓪,END
  7069. ⓪*ELSE
  7070. ⓪,doIt:= TRUE
  7071. ⓪*END;
  7072. ⓪(END;
  7073. ⓪ 
  7074. ⓪(IF doIt THEN
  7075. ⓪H(*  misc  *)
  7076. ⓪*IF is ('WAIT') THEN
  7077. ⓪,alert (arg,'',ContStr^);
  7078. ⓪*ELSIF is ('STACKSIZE') THEN
  7079. ⓪,getLC (DefaultStackSize);
  7080. ⓪,IF DefaultStackSize < 1024L THEN DefaultStackSize:= 1024 END;
  7081. ⓪ 
  7082. ⓪H(*  tools  *)
  7083. ⓪*ELSIF is ('DELETETOOLS') THEN
  7084. ⓪,FOR i:= 1 TO MaxTool DO ToolField[i].used:= FALSE END;  (*  Keine Tools  *)
  7085. ⓪*ELSIF is ('TOOL') THEN
  7086. ⓪,setToolName (arg)
  7087. ⓪H(*  loader commands  *)
  7088. ⓪*ELSIF is ('EXEC') THEN
  7089. ⓪,Split (arg, PosLen (' ', arg, 0), arg, s, strVal);
  7090. ⓪,delSpc (s);
  7091. ⓪,unTell;
  7092. ⓪,ShowArrow;
  7093. ⓪,AESUpdateWindow (FALSE);
  7094. ⓪,Upper (arg);
  7095. ⓪,IF IsMBTFile (arg) THEN
  7096. ⓪.ExecuteBatch (arg, load)
  7097. ⓪,ELSE
  7098. ⓪.call (arg, s, 0, FALSE, TRUE, FALSE);
  7099. ⓪,END;
  7100. ⓪,AESUpdateWindow (TRUE);
  7101. ⓪,ShowBee;
  7102. ⓪,IF autoCmd # noCmd THEN cont:= FALSE END;
  7103. ⓪*ELSIF is ('POSTAMBLE1') THEN
  7104. ⓪,Split (arg,PosLen (' ',arg,0),postAmble1,postArgs1,strVal);
  7105. ⓪,delSpc (postArgs1);
  7106. ⓪,withPost1:= TRUE;
  7107. ⓪*ELSIF is ('POSTAMBLE2') THEN
  7108. ⓪,Split (arg,PosLen (' ',arg,0),postAmble2,postArgs2,strVal);
  7109. ⓪,delSpc (postArgs2);
  7110. ⓪,withPost2:= TRUE;
  7111. ⓪*ELSIF is ('LOAD') THEN
  7112. ⓪,IF load THEN
  7113. ⓪.IF NOT tell THEN
  7114. ⓪0TellLoading (initTell, ''); tell:= TRUE
  7115. ⓪.END;
  7116. ⓪.TellLoading (newTellValue, arg);
  7117. ⓪.LoadModule (arg, StdPaths, callMsg (* dummy *), callMsg,
  7118. ⓪:callRes);
  7119. ⓪,END
  7120. ⓪*ELSIF is ('UNLOAD') THEN
  7121. ⓪,IF load THEN
  7122. ⓪.UnLoadModule (arg, callRes)
  7123. ⓪,END
  7124. ⓪*
  7125. ⓪*ELSIF is ('LINKSTACKSIZE') THEN
  7126. ⓪,getLC (LinkerParm.linkStackSize);
  7127. ⓪*ELSIF is ('NO_OPTIMIZE') THEN
  7128. ⓪,LinkerParm.optimize:= noOptimize
  7129. ⓪*ELSIF is ('NAME_OPTIMIZE') THEN
  7130. ⓪,LinkerParm.optimize:= nameOptimize
  7131. ⓪*ELSIF is ('PART_OPTIMIZE') THEN
  7132. ⓪,LinkerParm.optimize:= partOptimize
  7133. ⓪*ELSIF is ('FULL_OPTIMIZE') THEN
  7134. ⓪,LinkerParm.optimize:= fullOptimize
  7135. ⓪*ELSIF is ('DRIVER') THEN
  7136. ⓪,setLinkName (arg)
  7137. ⓪*ELSIF is ('DELETEDRIVERS') THEN
  7138. ⓪,SysUtil0.ClearVar (LinkerParm.linkList);
  7139. ⓪ 
  7140. ⓪H(*  comp./link/make  *)
  7141. ⓪*ELSIF is ('COMPILE') THEN
  7142. ⓪,autoCmd:= noCmd;
  7143. ⓪,unTell;
  7144. ⓪,ShowArrow;
  7145. ⓪,AESUpdateWindow (FALSE);
  7146. ⓪,callComp (arg, FALSE, TRUE, cont);
  7147. ⓪,AESUpdateWindow (TRUE);
  7148. ⓪,ShowBee;
  7149. ⓪*ELSIF is ('MAKE') THEN
  7150. ⓪,autoCmd:= noCmd;
  7151. ⓪,unTell;
  7152. ⓪,ShowArrow;
  7153. ⓪,AESUpdateWindow (FALSE);
  7154. ⓪,callMake (arg, TRUE, cont);
  7155. ⓪,AESUpdateWindow (TRUE);
  7156. ⓪,ShowBee;
  7157. ⓪*ELSIF is ('LINK') THEN
  7158. ⓪,autoCmd:= noCmd;
  7159. ⓪,unTell;
  7160. ⓪,ShowArrow;
  7161. ⓪,AESUpdateWindow (FALSE);
  7162. ⓪,callLink (arg);
  7163. ⓪,AESUpdateWindow (TRUE);
  7164. ⓪,ShowBee;
  7165. ⓪*ELSIF is ('EDIT') THEN
  7166. ⓪,autoCmd:= noCmd;
  7167. ⓪,unTell;
  7168. ⓪,ShowArrow;
  7169. ⓪,AESUpdateWindow (FALSE);
  7170. ⓪,callEdit (arg, FALSE);
  7171. ⓪,AESUpdateWindow (TRUE);
  7172. ⓪,ShowBee;
  7173. ⓪H(*  paths  *)
  7174. ⓪*ELSIF is ('SETDIR') THEN
  7175. ⓪,SetCurrentDir (MOSGlobals.defaultDrv, arg, voidI);
  7176. ⓪*ELSIF is ('SETDRIVE') THEN
  7177. ⓪,SetDefaultDrive (StrToDrive (arg))
  7178. ⓪*ELSIF is ('SETPATH') THEN
  7179. ⓪,SetDefaultPath (arg, voidI)
  7180. ⓪ 
  7181. ⓪*ELSIF is ('DEFAULTPATH') THEN
  7182. ⓪,setP ( StdPaths );
  7183. ⓪*ELSIF is ('DEFPATH') THEN
  7184. ⓪,setP ( DefPaths );
  7185. ⓪,getFirstPath (DefPaths, DefOutPath);
  7186. ⓪*ELSIF is ('IMPPATH') THEN
  7187. ⓪,setP ( ImpPaths );
  7188. ⓪,getFirstPath (ImpPaths, ImpOutPath);
  7189. ⓪*ELSIF is ('MODPATH') THEN
  7190. ⓪,setP ( ModPaths );
  7191. ⓪,getFirstPath (ModPaths, ModOutPath);
  7192. ⓪*ELSIF is ('SOURCEPATH') THEN
  7193. ⓪,setP ( SrcPaths )
  7194. ⓪*ELSIF is ('DEFOUT') THEN
  7195. ⓪,Assign (arg, DefOutPath, voidO);
  7196. ⓪,ValidatePath (DefOutPath)
  7197. ⓪*ELSIF is ('IMPOUT') THEN
  7198. ⓪,Assign (arg, ImpOutPath, voidO);
  7199. ⓪,ValidatePath (ImpOutPath)
  7200. ⓪*ELSIF is ('MODOUT') THEN
  7201. ⓪,Assign (arg, ModOutPath, voidO);
  7202. ⓪,ValidatePath (ModOutPath)
  7203. ⓪*ELSIF is ('MAINOUTPUTPATH') THEN
  7204. ⓪,Assign (arg, MainOutputPath, voidO);
  7205. ⓪,ValidatePath (MainOutputPath);
  7206. ⓪*END;
  7207. ⓪(
  7208. ⓪(END;
  7209. ⓪(
  7210. ⓪&UNTIL EOF (f) OR NOT cont;
  7211. ⓪&Close (f);
  7212. ⓪ 
  7213. ⓪&(* getFirstPath-Aufrufe hier weg und oben eingefügt *)
  7214. ⓪ 
  7215. ⓪$END;
  7216. ⓪$unTell;
  7217. ⓪$
  7218. ⓪$ShowArrow;
  7219. ⓪$AESUpdateWindow (FALSE);
  7220. ⓪"END ExecuteBatch;
  7221. ⓪ 
  7222. ⓪ VAR     level   : CARDINAL;
  7223. ⓪ 
  7224. ⓪ PROCEDURE envlpProc (start, inChild:BOOLEAN; VAR i:INTEGER);
  7225. ⓪ 
  7226. ⓪"BEGIN
  7227. ⓪$IF ~inChild THEN
  7228. ⓪&IF start THEN
  7229. ⓪(IF level = 0 THEN
  7230. ⓪*IF shellParm.breakActive THEN voidO:=EnableBreak () END
  7231. ⓪(END;
  7232. ⓪(INC (level);
  7233. ⓪&ELSE
  7234. ⓪(DEC (level);
  7235. ⓪(IF level = 0 THEN
  7236. ⓪*IF shellParm.breakActive THEN DisableBreak END;
  7237. ⓪(END;
  7238. ⓪&END
  7239. ⓪$END;
  7240. ⓪"END envlpProc;
  7241. ⓪"
  7242. ⓪ 
  7243. ⓪ VAR     err     : BOOLEAN;
  7244. ⓪(wsp     : MemArea;
  7245. ⓪(envlpHdl: EnvlpCarrier;
  7246. ⓪(ch      : CHAR;
  7247. ⓪(idx     : CARDINAL;
  7248. ⓪ 
  7249. ⓪ BEGIN (* Main of MShell *)
  7250. ⓪ 
  7251. ⓪"(*  ShellMsg - Variablen initialisieren
  7252. ⓪#*)
  7253. ⓪"Active:= TRUE;
  7254. ⓪"
  7255. ⓪"(*  Pfadlisten anlegen
  7256. ⓪#*)
  7257. ⓪"Lists.CreateList (StdPaths,err);
  7258. ⓪"Lists.CreateList (DefPaths,err);
  7259. ⓪"Lists.CreateList (ImpPaths,err);
  7260. ⓪"Lists.CreateList (ModPaths,err);
  7261. ⓪"Lists.CreateList (SrcPaths,err);
  7262. ⓪"FOR idx:= 1 TO MaxSearchPaths DO pathArray[idx].used:= FALSE END;
  7263. ⓪ 
  7264. ⓪"autoCmd:= noCmd;
  7265. ⓪"
  7266. ⓪"shellStart:= TRUE;
  7267. ⓪"
  7268. ⓪"IF InitSS () THEN
  7269. ⓪"
  7270. ⓪$(*  Kontrolle gestarteter Prozesse zur Ctrl-C - Aktivierung
  7271. ⓪%*)
  7272. ⓪$SetEnvelope (envlpHdl, envlpProc, wsp);
  7273. ⓪$
  7274. ⓪$shellStart:= FALSE;
  7275. ⓪$(*$? UseExtKeys: InstallKbdEvents; *)
  7276. ⓪$TalkWithUser;               (* Hauptschleife der Shell *)
  7277. ⓪$(*$? UseExtKeys: DeInstallKbdEvents; *)
  7278. ⓪ 
  7279. ⓪$IF withPost1 THEN
  7280. ⓪&call (postAmble1, postArgs1, 0L, FALSE, TRUE, FALSE);
  7281. ⓪$END;
  7282. ⓪$IF withPost2 THEN
  7283. ⓪&call (postAmble2, postArgs2, 0L, FALSE, TRUE, FALSE);
  7284. ⓪$END;
  7285. ⓪ 
  7286. ⓪$(* eigenen Namen löschen, damit GEMINI die Shell nicht nochmal startet *)
  7287. ⓪$IF DoShellWrite & (GEMEnv.GEMVersion () >= $140) THEN
  7288. ⓪&IF ~multiTOS THEN
  7289. ⓪(AESMisc.ShellWrite (FALSE, AESMisc.graphicPrgm, '', '');
  7290. ⓪&END
  7291. ⓪$END;
  7292. ⓪$
  7293. ⓪$ExitSS;
  7294. ⓪$
  7295. ⓪"ELSE
  7296. ⓪$TermProcess (fInsufficientMemory)
  7297. ⓪"END
  7298. ⓪"
  7299. ⓪ END MM2Shell.
  7300. ⓪ ə
  7301. (* $FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$000001B9$FFE59909$0002F09F$FFE59909$0002E5B4$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909$FFE59909ü$0002E5AAT.......T.......T.......T.......T...............T....T..T.......T.......T.......$000229C6$000229EE$00022A36$00022A71$00022AEA$0002296C$00022949$00022966$000232F2$0002E5AA$00004BBA$000001B9$0001F739$0001F720$00022941$000229ABãÇé*)
  7302.