home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DIV / MM2TINYS.M < prev    next >
Encoding:
Text File  |  1994-06-03  |  104.7 KB  |  3 lines
  1. ⓪ MODULE MM2TinyShell; (*$Z+,P+,V+,R-*)
  2. ⓪ 
  3. ⓪ (*
  4. ⓪!*----------------------------------------------------------------------------
  5. ⓪!* Copyright Februar 1987 Thomas Tempelmann & Manuel Chakravarty
  6. ⓪!*----------------------------------------------------------------------------
  7. ⓪!* Modul-Beschreibung : GEM-Tiny-Shell für MOS / Megamax Modula-2
  8. ⓪!*----------------------------------------------------------------------------
  9. ⓪!* Version            : 2.3g        /     Interne Version: V#0117
  10. ⓪!*----------------------------------------------------------------------------
  11. ⓪!* MCH: Manuel Chakravarty
  12. ⓪!* TT:  Thomas Tempelmann
  13. ⓪!* MS:  Michael Seyfried, Unterer Mauergarten 17, D-W6520 Worms 24
  14. ⓪!*----------------------------------------------------------------------------
  15. ⓪!* Datum   Version  Autor  Bemerkung (Arbeitsbericht)
  16. ⓪!*----------------------------------------------------------------------------
  17. ⓪!* 01.12.90  2.1p   MCH    Übernahme aller Teile der MM2Shell, die keine 
  18. ⓪!*                         Fenster benutzen
  19. ⓪!* 03.12.90  2.1p   MCH    Neue Workfilebehandlung und neue Resource
  20. ⓪!* 07.12.90  2.2    TT     Anpassung an MM2Shell 2.2
  21. ⓪!* 07.04.91  2.2b   TT     Höhe der Menüzeile korrigiert; ACCs werden vor/nach
  22. ⓪!*                         Start von Programmen geschlossen;
  23. ⓪!*                         Batch-Befehle "POSTAMBLE1/2" zum Starten von Prgs
  24. ⓪!*                         vor Verlassen der Shell; ExitSS-Aufruf am Ende des
  25. ⓪!*                         Moduls _hinter_ den ShellWrite-Aufruf verlegt;
  26. ⓪!*                         Codename von Workfiles wird nun korrekt behalten.
  27. ⓪!* 20.05.91  2.2d   TT     Bei manueller Arbeitsdateieingabe wird die Datei
  28. ⓪!*                         auf den Source-Pfaden gesucht.
  29. ⓪!* 20.10.91  2.3    TT     Linker-Option-Box ermöglicht Symboldatei-Erzeugung.
  30. ⓪!*                  MS     Shell nun MultiGEM-fähig, dazu 'call' überarbeitet.
  31. ⓪!* 14.01.93  2.3e   TT
  32. ⓪!*----------------------------------------------------------------------------
  33. ⓪!*)
  34. ⓪ 
  35. ⓪ 
  36. ⓪ (*  Qualified imports for 'ShellShell'  *)
  37. ⓪ 
  38. ⓪ IMPORT Clock, ModCtrl,
  39. ⓪ 
  40. ⓪'GEMBase, AESMisc,
  41. ⓪'GrafBase, GEMGlobals, GEMEnv,
  42. ⓪'AESForms, AESObjects, AESResources, AESGraphics, AESMenus,
  43. ⓪'AESWindows, AESEvents,
  44. ⓪'ObjHandler, EventHandler, EasyGEM0, EasyGEM1;
  45. ⓪ 
  46. ⓪ 
  47. ⓪ FROM SYSTEM     IMPORT LONGWORD, WORD, ADDRESS, BYTE,
  48. ⓪7ASSEMBLER, ADR, LOAD, STORE;
  49. ⓪ 
  50. ⓪ IMPORT Mm2tinysRsc;  (* RSC-Datei *)
  51. ⓪ 
  52. ⓪ FROM RealCtrl   IMPORT AnyRealFormat, UsedFormat;
  53. ⓪ 
  54. ⓪ FROM StrConv    IMPORT CardToStr, IntToStr, StrToLCard, StrToCard,
  55. ⓪7StrToInt, LHexToStr;
  56. ⓪ 
  57. ⓪ FROM Loader     IMPORT LoaderResults, DefaultStackSize,
  58. ⓪7LoadModule, CallModule, UnLoadModule;
  59. ⓪ 
  60. ⓪ FROM PathEnv    IMPORT HomeReplaced, HomeSymbol, ReplaceHome, HomePath;
  61. ⓪ FROM PathCtrl   IMPORT PathList;
  62. ⓪ FROM Paths      IMPORT SearchFile, ListPos;
  63. ⓪ 
  64. ⓪ FROM Storage    IMPORT ALLOCATE, DEALLOCATE, MemAvail, AllAvail, Inconsistent;
  65. ⓪ 
  66. ⓪ FROM Strings    IMPORT PosLen, String, Relation, Compare, Space, Upper, Empty,
  67. ⓪7EatSpaces, Append, StrEqual, Delete, Concat, Assign,
  68. ⓪7Split, Insert, Length, Copy, Pos;
  69. ⓪ 
  70. ⓪ IMPORT Lists;
  71. ⓪ 
  72. ⓪ IMPORT SysUtil0;
  73. ⓪ 
  74. ⓪ FROM MOSConfig IMPORT StdDateMask;
  75. ⓪ IMPORT MOSConfig;
  76. ⓪ 
  77. ⓪ IMPORT MOSCtrl;
  78. ⓪ 
  79. ⓪ FROM MOSGlobals IMPORT MemArea, BusFault, OddBusAddr, NoValidRETURN,
  80. ⓪7OutOfStack, FileStr, PathStr, NameStr,
  81. ⓪7fOK, fFileNotFound, fDriveNotReady, fWriteProtected,
  82. ⓪7fPathNotFound, fInvalidDrive, fAccessDenied,
  83. ⓪7fTooManyOpen, fInsufficientMemory,
  84. ⓪7Drive, DriveSet, fEOF;
  85. ⓪ 
  86. ⓪ FROM ShellMsg   IMPORT ScanMode, ScanAddr, TextName, ErrorMsg, DefPaths,
  87. ⓪7ModPaths, ErrListFile, ImpPaths, SrcPaths, DefSfx,
  88. ⓪7ImpSfx, ModSfx, CodeName, Active, LinkDesc, 
  89. ⓪7LLRange, ScanIndex, TextLine, TextCol,
  90. ⓪7MakeFileName, TemporaryPath, MainOutputPath,
  91. ⓪7DefLibName, DefOutPath, ImpOutPath, ModOutPath,
  92. ⓪7ShellPath, ImpSrcSfx, ModSrcSfx, DefSrcSfx, CodeSize,
  93. ⓪7StdPaths, CompilerArgs, CompilerParm, ScanOpts,
  94. ⓪7LinkMode, LinkerParm, EditorParm;
  95. ⓪ 
  96. ⓪ IMPORT Directory;
  97. ⓪ FROM Directory  IMPORT FileAttr, FileAttrSet, DirEntry, DirQueryProc,
  98. ⓪7SetCurrentDir, GetCurrentDir, DefaultDrive,
  99. ⓪7DirQuery, SetDefaultDrive, DrivesOnline,
  100. ⓪7CreateDir, GetDefaultPath, SetFileAttr,
  101. ⓪7ForceMediaChange, MakeFullPath, SetDefaultPath,
  102. ⓪7FreeSpace;
  103. ⓪ 
  104. ⓪ FROM FileNames  IMPORT StrToDrive, SplitPath, SplitName, DriveToStr,
  105. ⓪7NameConc, ValidatePath, ConcatPath, ConcatName,
  106. ⓪7FileName, FilePath;
  107. ⓪ 
  108. ⓪ FROM Files      IMPORT File, Access, ReplaceMode,
  109. ⓪7Create, Open, Close, State, ResetState, GetStateMsg,
  110. ⓪7Remove, EOF, SetDateTime, GetDateTime;
  111. ⓪ 
  112. ⓪ FROM Binary     IMPORT ReadBlock, ReadBytes, WriteBlock;
  113. ⓪ 
  114. ⓪ IMPORT Text;
  115. ⓪ 
  116. ⓪ FROM GEMScan    IMPORT InputScan, CallingChain, ChainDepth;
  117. ⓪ 
  118. ⓪ FROM PrgCtrl    IMPORT EnvlpCarrier,
  119. ⓪7SetEnvelope, TermProcess;
  120. ⓪4
  121. ⓪ FROM SysTypes   IMPORT ExcDesc, ExcSet, TRAP5;
  122. ⓪ 
  123. ⓪ FROM Excepts    IMPORT InstallPreExc;
  124. ⓪ 
  125. ⓪ FROM SysBuffers IMPORT ExceptsStack;
  126. ⓪ 
  127. ⓪ FROM EasyGEM0   IMPORT WrapAlert;
  128. ⓪ 
  129. ⓪ FROM UserBreak  IMPORT EnableBreak, DisableBreak;
  130. ⓪ 
  131. ⓪ FROM KbdEvents  IMPORT DeInstallKbdEvents, InstallKbdEvents;
  132. ⓪ 
  133. ⓪ FROM EasyGEM0   IMPORT SetGetMode, ShowArrow, HideMouse, ShowMouse; 
  134. ⓪ 
  135. ⓪ FROM AESForms   IMPORT FormError, FormAlert;
  136. ⓪ 
  137. ⓪ IMPORT InOutBase;
  138. ⓪ 
  139. ⓪ 
  140. ⓪ CONST   (* Versionskennung der Shell.
  141. ⓪)*)
  142. ⓪(ShellRevision           = ' 2.3g ';
  143. ⓪(
  144. ⓪((*
  145. ⓪)* Ist die folg. Konstante TRUE, wird das Modul "KbdEvents"
  146. ⓪)* verwendet, das dafür sorgt, daß Tastendrücke, bei denen
  147. ⓪)* Shift, Control oder Alternate gedrückt werden, immer richtig
  148. ⓪)* erkannt werden.
  149. ⓪)* Andernfalls kann es passieren, daß diese Umschalttasten
  150. ⓪)* ignoriert werden, wenn die gewünschte Aktion erst nach
  151. ⓪)* dem Tastendruck gestartet wird.
  152. ⓪)* Siehe auch Hinweise im Definitions-Text des Moduls
  153. ⓪)*)
  154. ⓪(UseExtKeys = TRUE;
  155. ⓪ 
  156. ⓪((*
  157. ⓪)* Ist die folg. Konstante TRUE, startet die Shell GEM-Programme
  158. ⓪)* korrekt mit der AES-Funktion "ShellWrite", sofern TOS 1.4
  159. ⓪)* oder höher verwendet wird. Dies kann aber zu Problemen führen,
  160. ⓪)* beispielsweise, wenn die Shell von NEODESK gestartet wird,
  161. ⓪)* weshalb sie dazu auf FALSE gesetzt werden kann.
  162. ⓪)*)
  163. ⓪(DoShellWrite = TRUE;
  164. ⓪(
  165. ⓪((*
  166. ⓪)* Stack-Größen für die Systemprogramme. Sie sollten vergrößert
  167. ⓪)* werden, wenn bei einem der Programme ein "Stacküberlauf"
  168. ⓪)* auftritt.
  169. ⓪)*)
  170. ⓪(CompilerStackSize = 16000;
  171. ⓪(LinkerStackSize = 8000;
  172. ⓪(EditorStackSize = 16000;
  173. ⓪(MakeStackSize = 8000;
  174. ⓪ 
  175. ⓪((*
  176. ⓪)* Maximale Anzahl von Suchpfaden, die in einer Batch-Datei
  177. ⓪)* definiert werden können. Ist zu erhöhen, wenn bim Starten
  178. ⓪)* der Shell oder eines Batches eine diesbezügliche Fehler-
  179. ⓪)* meldung erscheint.
  180. ⓪)*)
  181. ⓪(MaxSearchPaths = 40;
  182. ⓪ 
  183. ⓪((*
  184. ⓪)*  Name der Datei in der alle zu compilierenden Module
  185. ⓪)*  vom Make abgelegt werden. Das Verzeichnis (Pfad), in dem
  186. ⓪)*  diese Datei erzeugt wird, ist der "temporäre Pfad", der
  187. ⓪)*  in der Shell-Parameter-Box anzugeben ist!
  188. ⓪)*)
  189. ⓪(MakeCompFileName        = 'MAKE.M2C';
  190. ⓪ 
  191. ⓪ 
  192. ⓪ TYPE    actionType      = (doEdit, doComp, doLink, doExec, doScan, doCpEx,
  193. ⓪;doLoad, doUnLd, doCont, doBtch, doParm, doMake,
  194. ⓪;doMkEx, doDftM);
  195. ⓪(MySuf           = (prg, app, tos, ttp, mos, mtp, mod, def, imp, m2p,
  196. ⓪;m2b, m2m, m2d);
  197. ⓪ 
  198. ⓪(Str128          = ARRAY [0..127] OF CHAR;
  199. ⓪ 
  200. ⓪(ptrString       = POINTER TO String;
  201. ⓪ 
  202. ⓪(PathEntry       = POINTER TO PathStr;
  203. ⓪ 
  204. ⓪ VAR     lastFn, currFn,
  205. ⓪(workFName, workCName       : FileStr;
  206. ⓪(args                       : ARRAY[0..127] OF CHAR;
  207. ⓪ 
  208. ⓪(suf: ARRAY MySuf OF ARRAY [0..2] OF CHAR;
  209. ⓪ 
  210. ⓪ 
  211. ⓪0(*  Konfigurationsvariablen  *)
  212. ⓪0(*  =======================  *)
  213. ⓪ 
  214. ⓪(shellParm       : RECORD
  215. ⓪<breakActive       : BOOLEAN;
  216. ⓪<batchPath         : PathStr;
  217. ⓪<parameterPath     : PathStr;
  218. ⓪<sectors           : CARDINAL;
  219. ⓪<tracks            : CARDINAL;
  220. ⓪<sides             : CARDINAL;
  221. ⓪<makeName          : String;
  222. ⓪<(* TRUE: Nach TOS/TTP-Prgs auf Taste warten *)
  223. ⓪<waitOnReturn      : BOOLEAN;
  224. ⓪:END;
  225. ⓪ 
  226. ⓪(noDirChange: BOOLEAN;
  227. ⓪ 
  228. ⓪ 
  229. ⓪ 
  230. ⓪ PROCEDURE conc ( REF s1,s2: ARRAY OF CHAR ): Str128;
  231. ⓪"VAR s: Str128;
  232. ⓪&voidO: BOOLEAN;
  233. ⓪"BEGIN
  234. ⓪$Concat (s1,s2,s, voidO);
  235. ⓪$RETURN s
  236. ⓪"END conc;
  237. ⓪ 
  238. ⓪ 
  239. ⓪ FORWARD action (what: actionType; workFile, tool: BOOLEAN);
  240. ⓪ 
  241. ⓪ FORWARD FileAlert (errNo: INTEGER);
  242. ⓪ FORWARD SaveParameter;
  243. ⓪ FORWARD LoadParameter (REF name: ARRAY OF CHAR; loadInBatch: BOOLEAN);
  244. ⓪ FORWARD ExecuteBatch (name: ARRAY OF CHAR; load: BOOLEAN);
  245. ⓪ 
  246. ⓪ 
  247. ⓪ MODULE ShellShell;      (* Verwaltet die GEM-Aktionen der Modula-Shell *)
  248. ⓪ 
  249. ⓪ 
  250. ⓪ IMPORT Text, SysUtil0,
  251. ⓪ 
  252. ⓪0(*  resource indices  *)
  253. ⓪ 
  254. ⓪'Menu, Mibox, Mshell, Mdatei, Mworkfil, Mparms,
  255. ⓪'Mwork, Mtools, Dinfo, Mdeditwo, Mdcompwo, Mdexecwo,
  256. ⓪'Mdlinkwo, Mdscanwo, Mdeditot, Mdcompot, Mdexecot,
  257. ⓪'Mdlinkot, Mdscanot, Mdfolder, Mddelete, Mdquit, Wibox, Mwnew,
  258. ⓪'Mwdelete, Mwchange, Mwwork1, Mwwork2, Mwwork3, Mwwork4,
  259. ⓪'Mwwork5, Mwwork6, Mwwork7, Mwwork8, Mwwork9, Mwwork0,
  260. ⓪'Mpshell, Mpeditor, Mpcomp, Mplink, Mpsave, Mienv,
  261. ⓪'Midocu, Mihelp, Tibox, Mtool1, Mtool2, Mtool3,
  262. ⓪'Mtool4, Mtool5, Mtool6, Mtool7, Mtool8, Mtool9,
  263. ⓪'Mtool10, Optbox, Oquite, Opmark, Opwidth, Oppath,
  264. ⓪'Ooutput, Oargs, Olibrary, Oerror, Oname, Oquit,
  265. ⓪'Ook, Shellbox, Version, Scanbox, Sok, Squit,
  266. ⓪'Saddr, Snamebox, Snedit, Snok, Snwork, Snquit,
  267. ⓪'Argbox, Aedit, Aok, Loptbox, Locheck1, Locheck2,
  268. ⓪'Locheck3, Locheck4, Locheck5, Locheck6, Locheck7, Locheck8,
  269. ⓪'Lofname1, Lofname2, Lofname3, Lofname4, Lofname5, Lofname6,
  270. ⓪'Lofname7, Lofname8, Lochecks, Lostack, Lomaxmod, Look,
  271. ⓪'Loquit, Loname, Lonoopt, Lonamopt, Lomiddle, Lofull,
  272. ⓪'Lofastld, Lofastco, Lofastme, Losymfil, Loadbox, Lfname, Sparmbox,
  273. ⓪'Spmake, Spscpath, Spbreak, Spbaname, Sppaname, Spok, Spquit,
  274. ⓪'Msgbar, Mbmsg, Eparmbox, Epname, Epsearch, Epstoper,
  275. ⓪'Epshtemp, Epshname, Epedtemp, Epedname, Eparg, Eparname,
  276. ⓪'Eparpos, Eparerro, Epok, Epquit, Helpbox, Hpnext,
  277. ⓪'Hpprev, Hpquit, Hpmsgs, Hpmsg1, Hpmsg2, Hpmsg3,
  278. ⓪'Hpmsg4, Hpmsg5, Hpmsg6, Hpmsg7, Hpmsg8, Hpmsg9,
  279. ⓪'Hpmsg10, Hpmsg11, Hpmsg12, Hpmsg13, Hpmsg14, Infobox,
  280. ⓪'Inpath, Inmkfile, Instack, Inblock, Inall, Incode,
  281. ⓪'Inlength, Realform, Ihome, Inok, Inquit, Stponrtn,
  282. ⓪'Pathalt, Optalt, Memalt, Debugalt, Noldstr, Okstr,
  283. ⓪'Nouldstr, Noexestr, Retstr, Edstr, Workstr, Compstr,
  284. ⓪'Linkstr, Infstr, Contstr, Parmsalt, Noparalt, Nowrkalt,
  285. ⓪'Exitalt, Nohlpalt, Makestr, Contmalt, Editstr, Editbstr,
  286. ⓪'Npathstr, Chworkti, Neworkti, Editti, Compti, Execti,
  287. ⓪'Coexti, Linkti, Scanti, Foldti, Deleti,
  288. ⓪ 
  289. ⓪%
  290. ⓪0(*  from the library  *)
  291. ⓪ 
  292. ⓪'ADDRESS, BYTE, WORD,
  293. ⓪'ASSEMBLER, ADR, LOAD, STORE,
  294. ⓪'
  295. ⓪'(*  Storage  *)
  296. ⓪'ALLOCATE, DEALLOCATE, MemAvail, AllAvail,
  297. ⓪ 
  298. ⓪'(* RealCtrl *)
  299. ⓪'AnyRealFormat, UsedFormat,
  300. ⓪'
  301. ⓪'(*  Strings  *)
  302. ⓪'String, Relation,
  303. ⓪'Concat, Insert, Split, Assign, Length, Compare, Copy, Space,
  304. ⓪'Upper, Empty, EatSpaces, Append, StrEqual, PosLen, Delete, Pos,
  305. ⓪'
  306. ⓪'MOSConfig,
  307. ⓪'DefSrcSfx, ImpSrcSfx, ModSrcSfx, StdDateMask,
  308. ⓪'
  309. ⓪'(*  StrConv  *)
  310. ⓪'CardToStr, IntToStr, StrToCard, StrToLCard, LHexToStr,
  311. ⓪ 
  312. ⓪'(*  Directory  *)
  313. ⓪'Directory,
  314. ⓪'FileAttr, FileAttrSet, DirEntry, DirQueryProc, Drive, DriveSet,
  315. ⓪'DirQuery, SplitPath, SplitName, SetFileAttr, StrToDrive, FreeSpace,
  316. ⓪'DriveToStr, DefaultDrive, CreateDir, GetCurrentDir, SetDefaultDrive,
  317. ⓪'SetCurrentDir, FileStr, PathStr, NameStr, DrivesOnline, ValidatePath,
  318. ⓪'ForceMediaChange, MakeFullPath, ConcatPath, ConcatName, SetDefaultPath,
  319. ⓪'FileName, GetDefaultPath, FilePath,
  320. ⓪'
  321. ⓪'(*  ShellMsg  *)
  322. ⓪'ScanMode, TextName, CodeName, DefSfx, ImpSfx, ModSfx, ScanAddr,
  323. ⓪'ErrListFile, LinkDesc, TemporaryPath, LLRange,
  324. ⓪'SrcPaths, ShellPath, MakeFileName, DefLibName, MainOutputPath,
  325. ⓪'ScanOpts, DefPaths, EditorParm, CompilerParm, LinkerParm, LinkMode,
  326. ⓪'
  327. ⓪'
  328. ⓪'(*  Loader  *)
  329. ⓪'DefaultStackSize,
  330. ⓪'
  331. ⓪'(*  MOSGlobals  *)
  332. ⓪'fOK, fEOF, fFileNotFound,
  333. ⓪'
  334. ⓪'(*  Files  *)
  335. ⓪'File, Access,
  336. ⓪'State, Open, Close, ResetState,
  337. ⓪'
  338. ⓪'(*  Binary  *)
  339. ⓪'ReadBlock, WriteBlock,
  340. ⓪'
  341. ⓪'(*  GEMScan  *)
  342. ⓪'ChainDepth,
  343. ⓪'
  344. ⓪'(*  MOSGloabls  *)
  345. ⓪'MemArea,
  346. ⓪'
  347. ⓪'(*  Exceptions  *)
  348. ⓪'TRAP5, ExcSet, ExcDesc,
  349. ⓪'ExceptsStack, InstallPreExc,
  350. ⓪'
  351. ⓪'(*  Paths  *)
  352. ⓪'ListPos,
  353. ⓪'ReplaceHome, SearchFile,
  354. ⓪'HomePath, HomeSymbol,
  355. ⓪'
  356. ⓪'(*  PrgCtrl  *)
  357. ⓪'TermProcess,
  358. ⓪'
  359. ⓪'(*  from the outer module  *)
  360. ⓪'CompilerArgs,
  361. ⓪'actionType, Str128,
  362. ⓪'lastFn, currFn, MySuf, ShellRevision,
  363. ⓪'action, suf, args, noDirChange, shellParm, conc,
  364. ⓪'SaveParameter, LoadParameter, FileAlert, ExecuteBatch;
  365. ⓪ 
  366. ⓪ (*  MOS  *)
  367. ⓪ 
  368. ⓪ FROM MOSCtrl            IMPORT RealMode;
  369. ⓪ 
  370. ⓪ FROM Clock              IMPORT Date, Time;
  371. ⓪ 
  372. ⓪ FROM ModCtrl            IMPORT ModQuery;
  373. ⓪ 
  374. ⓪ FROM Lists              IMPORT List, LDir, InitList,
  375. ⓪?CreateList, DeleteList, ResetList, AppendEntry,
  376. ⓪?InsertEntry, NextEntry, PrevEntry, RemoveEntry,
  377. ⓪?CurrentEntry, ListEmpty, ScanEntries,
  378. ⓪?NoOfEntries, EndOfList;
  379. ⓪ 
  380. ⓪ (*  Graphics  *)
  381. ⓪ 
  382. ⓪ FROM GrafBase   IMPORT black, Pnt, Rect, PtrBitPattern, WritingMode,
  383. ⓪7Point, Rectangle, TransRect, MinPoint, ClipRect,
  384. ⓪7FrameRects;
  385. ⓪5
  386. ⓪ (*  General GEM  *)
  387. ⓪ 
  388. ⓪ FROM GEMGlobals IMPORT Root, MaxDepth, NoObject, MaxStr,
  389. ⓪7PtrObjTree, GemChar, MouseButton, MButtonSet,
  390. ⓪7SpecialKeySet, ObjState, OStateSet, ObjFlag,
  391. ⓪7OFlagSet, ObjType, FillType, SpecialKey, PtrMaxStr,
  392. ⓪7LineType;
  393. ⓪ 
  394. ⓪ FROM GEMEnv     IMPORT RC, GemHandle, DeviceHandle, DevParm, PtrDevParm,
  395. ⓪7InitGem, ExitGem, GemActive, CurrGemHandle,
  396. ⓪7SetCurrGemHandle, GemError, MouseInput, DeviceParameter;
  397. ⓪ 
  398. ⓪ (*  AES  *)
  399. ⓪ 
  400. ⓪ FROM AESForms           IMPORT FormDialMode,
  401. ⓪?FormDial, FormDo, FormAlert;
  402. ⓪ 
  403. ⓪ FROM AESObjects         IMPORT FindObject, DrawObject;
  404. ⓪ 
  405. ⓪ FROM AESResources       IMPORT ResourcePart,
  406. ⓪?LoadResource, FreeResource, ResourceAddr;
  407. ⓪ 
  408. ⓪ FROM AESWindows         IMPORT SetNewDesk;
  409. ⓪ 
  410. ⓪ FROM AESGraphics        IMPORT MouseForm,
  411. ⓪?DragBox, MouseKeyState, GrafMouse, RubberBox;
  412. ⓪ 
  413. ⓪ FROM AESMenus           IMPORT MenuBar, NormalTitle, EnableItem, MenuText,
  414. ⓪?CheckItem;
  415. ⓪ 
  416. ⓪ FROM AESEvents          IMPORT menuSelected, Event, RectEnterMode,
  417. ⓪?MessageBuffer, MultiEvent, EventSet;
  418. ⓪ 
  419. ⓪ FROM AESMisc            IMPORT ShellGet, ShellRead;
  420. ⓪ 
  421. ⓪ IMPORT GEMBase;
  422. ⓪ 
  423. ⓪ (*  Beyond GEM  *)
  424. ⓪ 
  425. ⓪ FROM ObjHandler         IMPORT SetPtrChoice,
  426. ⓪?SetCurrObjTree, CurrObjTree,
  427. ⓪?ObjectState, SetObjSpace, ObjectSpace,
  428. ⓪?ObjectFlags, BorderThickness, AssignTextStrings,
  429. ⓪?GetTextStrings, ObjTreeError, LinkTextString,
  430. ⓪?SetObjFlags, CreateSpecification, ObjectType,
  431. ⓪?SetObjType, SetIconForm, GetIconForm,
  432. ⓪?SetIconLook, GetIconLook, GetComplexColor,
  433. ⓪?SetComplexColor, GetIconColor, SetIconColor,
  434. ⓪?SetObjState, GetObjRelatives, RightSister;
  435. ⓪ 
  436. ⓪ FROM EventHandler       IMPORT EventProc, WatchDogCarrier,
  437. ⓪?HandleEvents, ShareTime, DeInstallWatchDog,
  438. ⓪?InstallWatchDog, FlushEvents;
  439. ⓪ 
  440. ⓪ FROM EasyGEM0           IMPORT SetGetMode, ObjEnumRef,
  441. ⓪?ShowArrow, HideMouse, ShowMouse,
  442. ⓪?ObjectSpaceWithAttrs, AbsObjectSpace,
  443. ⓪?GetTextString, SetTextString, SetObjStateElem,
  444. ⓪?ToggleObjState, ObjectStateElem, SetObjFlag,
  445. ⓪?PrepareBox, ReleaseBox, DoSimpleBox,
  446. ⓪?ForceDeskRedraw, DrawObjInWdw, DeskSize,
  447. ⓪?DeselectButton, ToggleCheckBox, ToggleCheckPlus,
  448. ⓪?SetGetBoxLCard, SetGetBoxStr, SetGetBoxEnum,
  449. ⓪?SetGetBoxState, SetGetBoxCard, CharSize,
  450. ⓪?ToggleSelectBox, ObjectFlag, TreeAddress,
  451. ⓪?TextStringAddress;
  452. ⓪ 
  453. ⓪ FROM EasyGEM1           IMPORT SelectFile;
  454. ⓪ 
  455. ⓪ 
  456. ⓪ EXPORT TellMode, MaxTool, ToolField, NoPathsStr, EditBatStr,
  457. ⓪'NoLoadStr, OkStr, NoUnloadStr, NoExecStr, RetStr, EdStr, MakeStr,
  458. ⓪'WorkStr, CompStr, LinkStr, InfStr, ContMakeAlt, noParmAlt, ContStr,
  459. ⓪'InitSS, ExitSS, ShowSS, HideSS, TalkWithUser, RequestArg, ScanBox,
  460. ⓪'TellLoading, ClearDeskAndShowMsg, ShowBee, appl_init, appl_exit,
  461. ⓪'maxWorkFiles, WorkField, IsSourceName, InitWorkFieldMenuIndizies,
  462. ⓪'memErrorAlt, ShellName, LastCodeName, LastCodeSize, EditStr,
  463. ⓪'IsMBTFile, multiGEM, multiTOS;
  464. ⓪'
  465. ⓪ 
  466. ⓪ CONST   minNecessaryMem = 50L * 1024L;  (*  min. 50k Speicher  *)
  467. ⓪ 
  468. ⓪(screenColumns   = 80;           (*  screen width in chars  *)
  469. ⓪ 
  470. ⓪(MaxTool         = 10;
  471. ⓪(maxWorkFiles    = 10;
  472. ⓪ 
  473. ⓪(resourceFile    = 'MM2TINYS.RSC';
  474. ⓪(batchFile       = 'MM2TINYS.M2B';
  475. ⓪(parameterFile   = 'MM2TINYS.M2P';
  476. ⓪(helpFile        = 'MM2TINYS.HLP';
  477. ⓪(fileBoxLength   = 41;           (*  Länge des file box edit strings  *)
  478. ⓪(maxDftPathInfo  = 43;           (*  'infoBox.Inpath' length *)
  479. ⓪(maxCodeFileInfo = 43;           (*  'infoBox.Incode' length  *)
  480. ⓪(maxDefLibName   = 33;           (*  'infoBox.Inmkfile' length *)
  481. ⓪ 
  482. ⓪(msgStrLen       = 70;
  483. ⓪(
  484. ⓪(noRscAlt1       = '[3][Das Resource File kann|nicht geladen werden!]';
  485. ⓪(noRscAlt2       = '[ Bye Bye... ]';
  486. ⓪(
  487. ⓪(noGemAlt1       = '[3][Anmeldung beim GEM|ist nicht gelungen!]';
  488. ⓪(noGemAlt2       = '[ Pech ?! ]';
  489. ⓪(
  490. ⓪(memErrorAlt     = 'Fehler in Speicherverwaltung|Neustart empfohlen!';
  491. ⓪(
  492. ⓪(stdProtWidth    = 80;  (* Standardbreite des Compilerprotokolls *)
  493. ⓪(
  494. ⓪(undoKey         = BYTE (97);
  495. ⓪(
  496. ⓪((*  'actManager' needs these constants, that are normally defined within
  497. ⓪)*  the resource in the large shell.
  498. ⓪)*)
  499. ⓪(Edit            = 0;
  500. ⓪(Compile         = 1;
  501. ⓪(Execute         = 2;
  502. ⓪(Link            = 3;
  503. ⓪(Scan            = 4;
  504. ⓪(Resident        = 5;
  505. ⓪(
  506. ⓪(
  507. ⓪ TYPE    ptrRectangle    = POINTER TO Rectangle;
  508. ⓪(ptrList         = POINTER TO List;
  509. ⓪(ptrString       = POINTER TO String;
  510. ⓪(
  511. ⓪ 
  512. ⓪ CONST   noCurrentWorkfile       = -1;   (*  more info at 'WorkField'  *)
  513. ⓪(
  514. ⓪ VAR
  515. ⓪0(*  globale handles  *)
  516. ⓪ 
  517. ⓪(dev                     : DeviceHandle;
  518. ⓪(gemHdl                  : GemHandle;
  519. ⓪(multiGEM                : BOOLEAN;
  520. ⓪(multiTOS                : BOOLEAN;
  521. ⓪(menu, desk, scanBox,
  522. ⓪(shellBox, optBox,
  523. ⓪(fileInfoBox, fileBox,
  524. ⓪(shellParmBox, editorParmBox,
  525. ⓪(sNameBox, argBox,
  526. ⓪(linkBox, loadBox,
  527. ⓪(fNameBox, formatBox,
  528. ⓪(msgBar, confirmBox,
  529. ⓪(helpBox, infoBox        : PtrObjTree;
  530. ⓪(
  531. ⓪(aesPB                   : GEMBase.AESPB;
  532. ⓪(vdiPB                   : GEMBase.VDIPB;
  533. ⓪(
  534. ⓪(pathToLongAlt,
  535. ⓪(cOptToLongAlt, wrgIcon2Alt,
  536. ⓪(memFullAlt, drvSpaceMsg,
  537. ⓪(debugAlt, 
  538. ⓪(NoLoadStr, OkStr, NoPathsStr,
  539. ⓪(NoUnloadStr, NoExecStr,
  540. ⓪(RetStr, EdStr, WorkStr,
  541. ⓪(CompStr, LinkStr, InfStr,
  542. ⓪(ContMakeAlt, ContStr, EditStr, EditBatStr,
  543. ⓪(parmSaveAlt, noParmAlt,
  544. ⓪(noNewWorkAlt, loadFailedAlt,
  545. ⓪(exitShellAlt, noHelpAlt,
  546. ⓪(MakeStr, changeWorkTitle,
  547. ⓪(newWorkTitle, editTitle,
  548. ⓪(compileTitle, executeTitle,
  549. ⓪(compExecTitle, linkTitle,
  550. ⓪(scanTitle, folderTitle,
  551. ⓪(deleteTitle  : PtrMaxStr;
  552. ⓪(
  553. ⓪(linkBoxIdx  : ARRAY[1..8] OF RECORD
  554. ⓪8check,
  555. ⓪8path        : CARDINAL;
  556. ⓪6END;
  557. ⓪(
  558. ⓪(ToolField   : ARRAY[1..MaxTool] OF RECORD
  559. ⓪8index       : CARDINAL; (*  Menu-Obj.  *)
  560. ⓪8
  561. ⓪8CASE used :BOOLEAN OF
  562. ⓪:TRUE : name : FileStr;
  563. ⓪8END;
  564. ⓪6END;
  565. ⓪ 
  566. ⓪((*  Contains all work files.
  567. ⓪)*)
  568. ⓪(WorkField   : RECORD
  569. ⓪8noUsed           : CARDINAL;
  570. ⓪8current          : INTEGER;
  571. ⓪8elems            : ARRAY[0..maxWorkFiles - 1] OF RECORD
  572. ⓪Mindex       : CARDINAL;
  573. ⓪Mused        : BOOLEAN;
  574. ⓪McodeName    : FileStr;
  575. ⓪MsourceName  : FileStr;
  576. ⓪KEND;
  577. ⓪8baseHeightOfWibox: INTEGER;
  578. ⓪6END;
  579. ⓪(
  580. ⓪(msgStr                  : String;
  581. ⓪ 
  582. ⓪ 
  583. ⓪0(* Variablen, die die aktuellen Shellparameter speichern *)
  584. ⓪ 
  585. ⓪(quitStatus              : (noQuit, quit, quickQuit);
  586. ⓪(LastCodeName            : FileStr;
  587. ⓪(LastCodeSize            : LONGCARD;
  588. ⓪(
  589. ⓪0(* Globale Infovariablen *)
  590. ⓪(
  591. ⓪(deskSize                : Rectangle;
  592. ⓪(charWidth, charHeight   : CARDINAL;
  593. ⓪(
  594. ⓪(tellSpace               : Rectangle;    (*  Darf nur von 'TellLoading'
  595. ⓪Q*  benutzt werden.
  596. ⓪Q*)
  597. ⓪ 
  598. ⓪(lastArgs: ARRAY [0..127] OF CHAR;
  599. ⓪ 
  600. ⓪(ShellName: PathStr;
  601. ⓪ 
  602. ⓪0(* Globale Kurzzeitvariablen *)
  603. ⓪(
  604. ⓪(ok      : BOOLEAN;      (*  Siehe auch 'notOKAlert'  *)
  605. ⓪(but     : CARDINAL;
  606. ⓪(
  607. ⓪0(*  global dummies  *)
  608. ⓪(
  609. ⓪(voidC    : CARDINAL;
  610. ⓪(voidO    : BOOLEAN;
  611. ⓪(voidCh   : CHAR;
  612. ⓪(voidI    : INTEGER;
  613. ⓪(void128  : ARRAY [0..127] OF CHAR;
  614. ⓪(voidADR  : ADDRESS;
  615. ⓪(voidFrame: Rectangle;
  616. ⓪ 
  617. ⓪ 
  618. ⓪8(*  Diverse Hilfsroutinen  *)
  619. ⓪8(*  =====================  *)
  620. ⓪ 
  621. ⓪((*  mouse  *)
  622. ⓪(
  623. ⓪ PROCEDURE mouseImage;
  624. ⓪ 
  625. ⓪"(*$L-*)
  626. ⓪"BEGIN
  627. ⓪$ASSEMBLER
  628. ⓪*DC.W    $0, $0, $1, $0, $1
  629. ⓪*DC.W    $07F0,$07F0,$07F0,$07F0,$0FF8,$1FFC,$3FFE,$3FFF
  630. ⓪*DC.W    $3FFF,$3FFF,$1FFF,$0FFF,$0FFF,$07FF,$03FF,$03FE
  631. ⓪*DC.W    $0000,$03E0,$03E0,$02A0,$07F0,$0E38,$1F7C,$1FFD
  632. ⓪*DC.W    $1FFC,$1FFD,$0FF8,$07F2,$07FD,$03E0,$01CA,$01E8
  633. ⓪$END;
  634. ⓪"END mouseImage;
  635. ⓪"(*$L=*)
  636. ⓪ 
  637. ⓪ PROCEDURE ShowBee;
  638. ⓪ 
  639. ⓪"BEGIN
  640. ⓪$GrafMouse (userCursor, ADDRESS (mouseImage))
  641. ⓪"END ShowBee;
  642. ⓪ 
  643. ⓪ 
  644. ⓪ PROCEDURE appl_init;
  645. ⓪"BEGIN
  646. ⓪$WITH aesPB DO
  647. ⓪&WITH pcontrl^ DO
  648. ⓪(opcode:= 10;
  649. ⓪(sintin:=  0;
  650. ⓪(sintout:= 1;
  651. ⓪(sadrin:=  0;
  652. ⓪(sadrout:= 0;
  653. ⓪&END;
  654. ⓪$END;
  655. ⓪$GEMBase.CallAES( ADR( aesPB));
  656. ⓪"END appl_init;
  657. ⓪ 
  658. ⓪ PROCEDURE appl_exit;
  659. ⓪"BEGIN
  660. ⓪$WITH aesPB DO
  661. ⓪&WITH pcontrl^ DO
  662. ⓪(opcode:= 19;
  663. ⓪(sintin:=  0;
  664. ⓪(sintout:= 1;
  665. ⓪(sadrin:=  0;
  666. ⓪(sadrout:= 0;
  667. ⓪&END;
  668. ⓪$END;
  669. ⓪$GEMBase.CallAES( ADR( aesPB));
  670. ⓪"END appl_exit;
  671. ⓪ 
  672. ⓪ 
  673. ⓪((*  strings  *)
  674. ⓪ 
  675. ⓪ (*  appendSpcTo -- Fügt Spaces an 'str' an, bis 'Length (str) = i'
  676. ⓪!*)
  677. ⓪(
  678. ⓪ PROCEDURE appendSpcTo (i: CARDINAL; VAR str: ARRAY OF CHAR);
  679. ⓪ 
  680. ⓪"VAR   l       : CARDINAL;
  681. ⓪"
  682. ⓪"BEGIN
  683. ⓪$l := HIGH (str);
  684. ⓪$IF i < l THEN l := i END;
  685. ⓪$Append (Space (l - Length (str)), str, voidO);
  686. ⓪"END appendSpcTo;
  687. ⓪ 
  688. ⓪ (*  truncCopyStr -- 'source' wird nach 'dest' kopiert. Es gibt 'maxDestLen'
  689. ⓪!*                  die Größe von 'dest' an, ist 'source' größer, so wird
  690. ⓪!*                  der vordere Teil abgeschnitten und ein '..' vorange-
  691. ⓪!*                  stellt.
  692. ⓪!*)
  693. ⓪!
  694. ⓪ PROCEDURE truncCopyString (    source    : ARRAY OF CHAR;
  695. ⓪?maxDestLen: CARDINAL;
  696. ⓪;VAR dest      : ARRAY OF CHAR);
  697. ⓪ 
  698. ⓪"VAR   sourceLen: CARDINAL;
  699. ⓪ 
  700. ⓪"BEGIN
  701. ⓪$sourceLen := Length (source);
  702. ⓪$IF sourceLen > maxDestLen
  703. ⓪$THEN
  704. ⓪&Copy (source, sourceLen - maxDestLen - 2, sourceLen, dest, voidO);
  705. ⓪&Insert ('..', 0, dest, voidO);
  706. ⓪$ELSE Assign (source, dest, voidO) END;
  707. ⓪"END truncCopyString;
  708. ⓪&
  709. ⓪&
  710. ⓪((*  lists  *)
  711. ⓪ 
  712. ⓪ (*  deleteSimpleList -- Deletes the list 'l' completly. The elements of the
  713. ⓪!*                      list must be dynamical allocated variables and would
  714. ⓪!*                      all be disposed.
  715. ⓪!*                      If 'killCarrier = TRUE' then list-carrier would be
  716. ⓪!*                      deleted.
  717. ⓪!*)
  718. ⓪ 
  719. ⓪ PROCEDURE deleteSimpleList (VAR l: List; killCarrier: BOOLEAN);
  720. ⓪ 
  721. ⓪"VAR   entry: ADDRESS;
  722. ⓪ 
  723. ⓪"BEGIN
  724. ⓪$ResetList (l);
  725. ⓪$entry := PrevEntry (l);
  726. ⓪$WHILE entry # NIL DO
  727. ⓪&RemoveEntry (l, voidO);
  728. ⓪&DEALLOCATE (entry, 0L);
  729. ⓪&entry := CurrentEntry (l);
  730. ⓪$END;
  731. ⓪$IF killCarrier THEN DeleteList (l, voidO) END;
  732. ⓪"END deleteSimpleList;
  733. ⓪ 
  734. ⓪"
  735. ⓪((*  tests  *)
  736. ⓪ 
  737. ⓪ PROCEDURE withShift (VAR s: SpecialKeySet): BOOLEAN;
  738. ⓪ 
  739. ⓪"BEGIN
  740. ⓪$RETURN (leftShiftKey IN s) OR (rightShiftKey IN s)
  741. ⓪"END withShift;
  742. ⓪ 
  743. ⓪ PROCEDURE withBothShifts (VAR s: SpecialKeySet): BOOLEAN;
  744. ⓪ 
  745. ⓪"BEGIN
  746. ⓪$RETURN (leftShiftKey IN s) AND (rightShiftKey IN s)
  747. ⓪"END withBothShifts;
  748. ⓪ 
  749. ⓪ PROCEDURE withCtrl (VAR s: SpecialKeySet): BOOLEAN;
  750. ⓪ 
  751. ⓪"BEGIN
  752. ⓪$RETURN controlKey IN s
  753. ⓪"END withCtrl;
  754. ⓪ 
  755. ⓪ PROCEDURE withAlt (VAR s: SpecialKeySet): BOOLEAN;
  756. ⓪ 
  757. ⓪"BEGIN
  758. ⓪$RETURN alternateKey IN s
  759. ⓪"END withAlt;
  760. ⓪ 
  761. ⓪"
  762. ⓪((*  procs for AES objects  *)
  763. ⓪(
  764. ⓪ (*  formDo -- Is same as 'FormDo', but clears the most significant bit
  765. ⓪!*            of 'exit' (double click).
  766. ⓪!*)
  767. ⓪!
  768. ⓪ PROCEDURE formDo (tree: PtrObjTree; start: CARDINAL; VAR exit: CARDINAL);
  769. ⓪ 
  770. ⓪"BEGIN
  771. ⓪$FormDo (tree, start, exit);
  772. ⓪$exit := exit MOD (MaxCard DIV 2);
  773. ⓪"END formDo;
  774. ⓪"
  775. ⓪ PROCEDURE drawObject (tree: PtrObjTree; obj: CARDINAL);
  776. ⓪ 
  777. ⓪"VAR   space   : Rectangle;
  778. ⓪ 
  779. ⓪"BEGIN
  780. ⓪$space := AbsObjectSpace (tree, obj);
  781. ⓪$DrawObject (tree, Root, MaxDepth, space);
  782. ⓪"END drawObject;
  783. ⓪"
  784. ⓪ PROCEDURE hideObj (obj: CARDINAL; hide: BOOLEAN);
  785. ⓪ 
  786. ⓪"BEGIN
  787. ⓪$SetObjFlag (CurrObjTree (), obj, hideTreeFlg, hide);
  788. ⓪"END hideObj;
  789. ⓪ 
  790. ⓪"
  791. ⓪0(*  Operations on path/file names  *)
  792. ⓪ 
  793. ⓪ (*  IsSourceName -- Is TRUE, if 'path' descibes a source file else FALSE.
  794. ⓪!*)
  795. ⓪ 
  796. ⓪ PROCEDURE IsSourceName (REF path: ARRAY OF CHAR): BOOLEAN;
  797. ⓪ 
  798. ⓪"VAR   name    : NameStr;
  799. ⓪(prefix  : ARRAY[0..64] OF CHAR;
  800. ⓪(suffix  : ARRAY[0..2] OF CHAR;
  801. ⓪(sufcnt  : MySuf;
  802. ⓪(isSource: BOOLEAN;
  803. ⓪(
  804. ⓪"BEGIN
  805. ⓪$SplitPath (path, prefix, name);
  806. ⓪$SplitName (name, name, suffix);
  807. ⓪$isSource := ~ Empty (suffix);
  808. ⓪$IF isSource THEN
  809. ⓪&sufcnt:= MIN (MySuf);
  810. ⓪&LOOP
  811. ⓪(IF StrEqual (suffix, suf[sufcnt]) THEN isSource := FALSE; EXIT
  812. ⓪(ELSIF sufcnt = MAX (MySuf) THEN EXIT
  813. ⓪(ELSE INC (sufcnt) END
  814. ⓪&END;
  815. ⓪$END;
  816. ⓪$RETURN isSource
  817. ⓪"END IsSourceName;
  818. ⓪ 
  819. ⓪ PROCEDURE isMSPFile (REF name: ARRAY OF CHAR): BOOLEAN;
  820. ⓪"VAR n: ARRAY [0..11] OF CHAR;
  821. ⓪"BEGIN
  822. ⓪$SplitPath (name, void128, n);
  823. ⓪$SplitName (n, void128, n);
  824. ⓪$RETURN StrEqual (n, suf[m2p])
  825. ⓪"END isMSPFile;
  826. ⓪"
  827. ⓪ PROCEDURE IsMBTFile (REF name: ARRAY OF CHAR): BOOLEAN;
  828. ⓪"VAR n: ARRAY [0..11] OF CHAR;
  829. ⓪"BEGIN
  830. ⓪$SplitPath (name, void128, n);
  831. ⓪$SplitName (n, void128, n);
  832. ⓪$RETURN StrEqual (n, suf[m2b])
  833. ⓪"END IsMBTFile;
  834. ⓪"
  835. ⓪ PROCEDURE isMakeFile (REF name: ARRAY OF CHAR): BOOLEAN;
  836. ⓪"VAR n: ARRAY [0..11] OF CHAR;
  837. ⓪"BEGIN
  838. ⓪$SplitPath (name, void128, n);
  839. ⓪$SplitName (n, void128, n);
  840. ⓪$RETURN StrEqual (n, suf[m2m])
  841. ⓪"END isMakeFile;
  842. ⓪"
  843. ⓪"
  844. ⓪0(*  Alerts  *)
  845. ⓪0(*  ======  *)
  846. ⓪ 
  847. ⓪ PROCEDURE doAlert (alt: PtrMaxStr);
  848. ⓪ 
  849. ⓪"BEGIN
  850. ⓪$FormAlert (1, alt^, voidC);
  851. ⓪"END doAlert;
  852. ⓪"
  853. ⓪ 
  854. ⓪ (*  multiStringAlert -- Setzt aus den zwei Zeichenketten eine Alarmmeldung
  855. ⓪!*                      zusammen und gibt diese aus.
  856. ⓪!*)
  857. ⓪ 
  858. ⓪ PROCEDURE multiStringAlert (REF str1, str2: ARRAY OF CHAR; VAR but: CARDINAL);
  859. ⓪ 
  860. ⓪"VAR     str     : ARRAY[0..255] OF CHAR;
  861. ⓪"
  862. ⓪"BEGIN
  863. ⓪$Concat (str1, str2, str, voidO);
  864. ⓪$FormAlert (1, str, but);
  865. ⓪"END multiStringAlert;
  866. ⓪ 
  867. ⓪ (*  notOKAlert -- Falls die globale Variable 'ok = FALSE' ist, so wird der
  868. ⓪!*                übergebene FileStr 'str' innerhalb einer Alert-Box ange-
  869. ⓪!*                zeigt.
  870. ⓪!*)
  871. ⓪!
  872. ⓪ PROCEDURE notOKAlert (str: PtrMaxStr);
  873. ⓪ 
  874. ⓪"BEGIN
  875. ⓪$IF ~ ok THEN doAlert (str) END;
  876. ⓪"END notOKAlert;
  877. ⓪ 
  878. ⓪ PROCEDURE flexAlert (default: CARDINAL; REF str1,str2:ARRAY OF CHAR; alt:PtrMaxStr;
  879. ⓪5VAR but:CARDINAL);
  880. ⓪5
  881. ⓪"VAR     str, strx       : ARRAY[0..255] OF CHAR;
  882. ⓪*i, j            : INTEGER;
  883. ⓪7
  884. ⓪"BEGIN
  885. ⓪$i:=Pos ('&',alt^, 0);
  886. ⓪$j:=Pos ('&',alt^, i + 1);
  887. ⓪$Copy (alt^, 0,i, str, voidO);
  888. ⓪$Append (str1, str, voidO);
  889. ⓪$IF j >= 0 THEN
  890. ⓪&Copy (alt^, i + 1,j - i - 1, strx, voidO);
  891. ⓪&Append (strx, str, voidO);
  892. ⓪&Append (str2, str, voidO);
  893. ⓪&i:=j;
  894. ⓪$END;
  895. ⓪$Copy (alt^, i + 1,Length (alt^) - CARDINAL (i) - 1, strx, voidO);
  896. ⓪$Append (strx, str, voidO);
  897. ⓪$FormAlert (default,str, but);
  898. ⓪"END flexAlert;
  899. ⓪"
  900. ⓪ PROCEDURE reportOutOfMemory;
  901. ⓪ 
  902. ⓪"BEGIN
  903. ⓪$doAlert (memFullAlt);
  904. ⓪"END reportOutOfMemory;
  905. ⓪ 
  906. ⓪ 
  907. ⓪8(*  menu procs  *)
  908. ⓪8(*  ===========  *)
  909. ⓪ 
  910. ⓪ PROCEDURE InitWorkFieldMenuIndizies;
  911. ⓪ 
  912. ⓪"BEGIN
  913. ⓪$WorkField.elems[0].index := Mwwork0;
  914. ⓪$WorkField.elems[1].index := Mwwork1;
  915. ⓪$WorkField.elems[2].index := Mwwork2;
  916. ⓪$WorkField.elems[3].index := Mwwork3;
  917. ⓪$WorkField.elems[4].index := Mwwork4;
  918. ⓪$WorkField.elems[5].index := Mwwork5;
  919. ⓪$WorkField.elems[6].index := Mwwork6;
  920. ⓪$WorkField.elems[7].index := Mwwork7;
  921. ⓪$WorkField.elems[8].index := Mwwork8;
  922. ⓪$WorkField.elems[9].index := Mwwork9;
  923. ⓪"END InitWorkFieldMenuIndizies;
  924. ⓪"
  925. ⓪"
  926. ⓪ (*  setTools -- Verändert den Menubaum so, daß nur noch die in 'ToolField'
  927. ⓪!*              vorhandenen Menu-Tool-Einträge sichtbar sind.
  928. ⓪!*)
  929. ⓪ 
  930. ⓪ PROCEDURE setTools;
  931. ⓪ 
  932. ⓪"CONST   toolNameLen = 12;
  933. ⓪ 
  934. ⓪"VAR   f1, f2    : Rectangle;
  935. ⓪(h         : INTEGER;
  936. ⓪(i         : CARDINAL;
  937. ⓪(str, str2 : FileStr;
  938. ⓪"
  939. ⓪"BEGIN
  940. ⓪"
  941. ⓪$SetCurrObjTree (menu, FALSE);
  942. ⓪$h := 0;
  943. ⓪$FOR i := 1 TO MaxTool DO
  944. ⓪&WITH ToolField[i]
  945. ⓪&DO
  946. ⓪(IF used THEN
  947. ⓪(
  948. ⓪*GetTextString (menu, index, str);
  949. ⓪*SplitPath (name, void128, str2);
  950. ⓪*Append (Space (toolNameLen - Length (str2)), str2, voidO);
  951. ⓪*Delete (str, 2, toolNameLen, voidO);
  952. ⓪*Insert (str2, 2, str, voidO);
  953. ⓪*MenuText (menu, index, str);
  954. ⓪*f1 := ObjectSpace (index);
  955. ⓪*h := h + f1.h
  956. ⓪*
  957. ⓪(END;
  958. ⓪(hideObj (index, NOT used);
  959. ⓪&END
  960. ⓪$END;
  961. ⓪$IF h = 0
  962. ⓪$THEN
  963. ⓪&IF NOT ObjectFlag (menu, Mtools, hideTreeFlg)
  964. ⓪&THEN
  965. ⓪(hideObj (Mtools, TRUE);
  966. ⓪(f1 := ObjectSpace (Mibox);
  967. ⓪(f2 := ObjectSpace (Mtools);
  968. ⓪(DEC (f1.w, f2.w);
  969. ⓪(SetObjSpace (Mibox, f1);
  970. ⓪&END;
  971. ⓪$ELSE
  972. ⓪&IF ObjectFlag (menu, Mtools, hideTreeFlg) THEN
  973. ⓪(hideObj (Mtools, FALSE);
  974. ⓪(f1 := ObjectSpace (Mibox);
  975. ⓪(f2 := ObjectSpace (Mtools);
  976. ⓪(INC (f1.w, f2.w);
  977. ⓪(SetObjSpace (Mibox, f1);
  978. ⓪&END;
  979. ⓪&f1 := ObjectSpace (Tibox);
  980. ⓪&f1.h := h;
  981. ⓪&SetObjSpace (Tibox, f1);
  982. ⓪$END;
  983. ⓪$
  984. ⓪$MenuBar (menu, TRUE);
  985. ⓪$
  986. ⓪"END setTools;
  987. ⓪ 
  988. ⓪ 
  989. ⓪ (*  setWorkfiles -- Verändert den Menubaum so, daß nur noch die in 'WorkField'
  990. ⓪!*                  vorhandenen Menu-Workfile-Einträge sichtbar sind.
  991. ⓪!*)
  992. ⓪ 
  993. ⓪ PROCEDURE setWorkfiles;
  994. ⓪ 
  995. ⓪"CONST workNameLen = 12;
  996. ⓪ 
  997. ⓪"VAR   i, lastIdx: INTEGER;
  998. ⓪(str, str2 : FileStr;
  999. ⓪(f1, f2    : Rectangle;
  1000. ⓪"
  1001. ⓪"BEGIN
  1002. ⓪$SetCurrObjTree (menu, FALSE);
  1003. ⓪$lastIdx := 0;
  1004. ⓪$FOR i := 0 TO maxWorkFiles - 1 DO
  1005. ⓪$
  1006. ⓪&WITH WorkField.elems[i]
  1007. ⓪&DO
  1008. ⓪(GetTextString (menu, index, str);
  1009. ⓪(IF used
  1010. ⓪(THEN
  1011. ⓪*lastIdx := i;
  1012. ⓪*SplitPath (sourceName, void128, str2);
  1013. ⓪(ELSE
  1014. ⓪*str2 := '';
  1015. ⓪(END;
  1016. ⓪(Append (Space (workNameLen - Length (str2)), str2, voidO);
  1017. ⓪(Delete (str, 2, workNameLen, voidO);
  1018. ⓪(Insert (str2, 2, str, voidO);
  1019. ⓪(MenuText (menu, index, str);
  1020. ⓪*
  1021. ⓪(SetObjStateElem (menu, index, disableObj, NOT used);
  1022. ⓪(CheckItem (menu, index, FALSE);
  1023. ⓪&END
  1024. ⓪&
  1025. ⓪$END;(*FOR*)
  1026. ⓪$
  1027. ⓪$(*  Cause the work file number zero is the last in the pull down menu.
  1028. ⓪%*)
  1029. ⓪$IF WorkField.elems[0].used THEN lastIdx := 10 END;
  1030. ⓪$
  1031. ⓪$(*  Hide all work file menu entries after the last used one.
  1032. ⓪%*)
  1033. ⓪$FOR i := 1 TO maxWorkFiles - 1
  1034. ⓪$DO
  1035. ⓪&hideObj (WorkField.elems[i].index, i > lastIdx);
  1036. ⓪$END;
  1037. ⓪$hideObj (WorkField.elems[0].index, 10 > lastIdx);
  1038. ⓪$
  1039. ⓪$(*  Adjust size of the ibox, that contains the pull down menu.
  1040. ⓪%*)
  1041. ⓪$f1 := ObjectSpace (Wibox);
  1042. ⓪$f2 := ObjectSpace (Mwwork0);
  1043. ⓪$f1.h := lastIdx * f2.h + WorkField.baseHeightOfWibox;
  1044. ⓪$SetObjSpace (Wibox, f1);
  1045. ⓪$
  1046. ⓪$IF WorkField.current # noCurrentWorkfile
  1047. ⓪$THEN
  1048. ⓪&CheckItem (menu, WorkField.elems[WorkField.current].index, TRUE);
  1049. ⓪$END;
  1050. ⓪"END setWorkfiles;
  1051. ⓪ 
  1052. ⓪ 
  1053. ⓪ PROCEDURE animateMenuTitle (title: CARDINAL; VAR space: Rectangle);
  1054. ⓪ 
  1055. ⓪"BEGIN
  1056. ⓪$NormalTitle (menu, title, FALSE);
  1057. ⓪$space := AbsObjectSpace (menu, title);
  1058. ⓪"END animateMenuTitle;
  1059. ⓪ 
  1060. ⓪ PROCEDURE deAnimateMenuTitle (title: CARDINAL);
  1061. ⓪ 
  1062. ⓪"BEGIN
  1063. ⓪$NormalTitle (menu, title, TRUE);
  1064. ⓪"END deAnimateMenuTitle;
  1065. ⓪"
  1066. ⓪ 
  1067. ⓪0(*  Routinen für das Dialogbox-Managment  *)
  1068. ⓪0(*  ====================================  *)
  1069. ⓪ 
  1070. ⓪((*  misc. box primitives  *)
  1071. ⓪ 
  1072. ⓪ TYPE    arrayOfTwoCards = ARRAY[1..2] OF CARDINAL;
  1073. ⓪ 
  1074. ⓪ PROCEDURE twoCardsInArray (c1, c2: CARDINAL): arrayOfTwoCards;
  1075. ⓪ 
  1076. ⓪"VAR   res: arrayOfTwoCards;
  1077. ⓪"
  1078. ⓪"BEGIN
  1079. ⓪$res[1] := c1;
  1080. ⓪$res[2] := c2;
  1081. ⓪$RETURN res
  1082. ⓪"END twoCardsInArray;
  1083. ⓪"
  1084. ⓪ 
  1085. ⓪((*  box handlers  *)
  1086. ⓪"
  1087. ⓪ PROCEDURE doCompilerOptionBox;
  1088. ⓪ 
  1089. ⓪"PROCEDURE setGetCompOpts (mode: SetGetMode);
  1090. ⓪"
  1091. ⓪$VAR notProtocol,
  1092. ⓪(found      : BOOLEAN;
  1093. ⓪(fname      : FileStr;
  1094. ⓪"
  1095. ⓪$BEGIN
  1096. ⓪&WITH CompilerParm DO
  1097. ⓪(SetGetBoxStr (optBox, Oname, mode, name);
  1098. ⓪(Upper (name);
  1099. ⓪(SetGetBoxState (optBox, Oquite, mode, checkObj, shortMsgs);
  1100. ⓪(SetGetBoxState (optBox, Opmark, mode, checkObj, protocol);
  1101. ⓪(IF mode = setValue THEN
  1102. ⓪*notProtocol := ~ protocol;
  1103. ⓪*SetGetBoxState (optBox, Oppath, setValue, disableObj, notProtocol);
  1104. ⓪*SetGetBoxState (optBox, Opwidth, setValue, disableObj, notProtocol);
  1105. ⓪(END;
  1106. ⓪(SetGetBoxStr (optBox, Oargs, mode, CompilerArgs);
  1107. ⓪(SetGetBoxStr (optBox, Oppath, mode, protName);
  1108. ⓪(SetGetBoxCard (optBox, Opwidth, mode, protWidth);
  1109. ⓪(IF protWidth < 10 THEN protWidth := stdProtWidth END;
  1110. ⓪(
  1111. ⓪(SetGetBoxStr (optBox, Ooutput, mode, MainOutputPath);
  1112. ⓪(ValidatePath (MainOutputPath);
  1113. ⓪(SetGetBoxStr (optBox, Olibrary, mode, DefLibName);
  1114. ⓪(IF mode = getValue THEN
  1115. ⓪*Upper (DefLibName);
  1116. ⓪*IF Length (FilePath (DefLibName)) = 0 THEN
  1117. ⓪,SearchFile (DefLibName, DefPaths, fromStart, found, DefLibName);
  1118. ⓪*END
  1119. ⓪(END;
  1120. ⓪(SetGetBoxStr (optBox, Oerror, mode, ErrListFile);
  1121. ⓪(Upper (ErrListFile);
  1122. ⓪&END;
  1123. ⓪$END setGetCompOpts;
  1124. ⓪$
  1125. ⓪ 
  1126. ⓪"VAR   space, start    : Rectangle;
  1127. ⓪(exit            : CARDINAL;
  1128. ⓪"
  1129. ⓪"BEGIN
  1130. ⓪$animateMenuTitle (Mparms, start);
  1131. ⓪$
  1132. ⓪$setGetCompOpts (setValue);
  1133. ⓪$PrepareBox (optBox, start, space);
  1134. ⓪$
  1135. ⓪$LOOP
  1136. ⓪&formDo (optBox, Ooutput, exit);
  1137. ⓪&
  1138. ⓪&CASE exit OF
  1139. ⓪(Ook, Oquit: DeselectButton (optBox, exit); EXIT|
  1140. ⓪(Oquite    : ToggleCheckBox (optBox, Oquite)|
  1141. ⓪(Opmark    : ToggleCheckPlus (optBox, Opmark,
  1142. ⓪EtwoCardsInArray (Oppath, Opwidth))|
  1143. ⓪&ELSE
  1144. ⓪&END;
  1145. ⓪$END;
  1146. ⓪$
  1147. ⓪$IF exit = Ook THEN setGetCompOpts (getValue) END;
  1148. ⓪$
  1149. ⓪$ReleaseBox(optBox, start, space);
  1150. ⓪$deAnimateMenuTitle (Mparms);
  1151. ⓪"END doCompilerOptionBox;
  1152. ⓪ 
  1153. ⓪ PROCEDURE doLinkerOptionBox;
  1154. ⓪ 
  1155. ⓪"PROCEDURE setGetLinkOpts (mode: SetGetMode);
  1156. ⓪ 
  1157. ⓪$VAR i       : CARDINAL;
  1158. ⓪(valid,
  1159. ⓪(notValid: BOOLEAN;
  1160. ⓪(refs    : ARRAY [1..4] OF ObjEnumRef;
  1161. ⓪$
  1162. ⓪$BEGIN
  1163. ⓪&SetGetBoxStr (linkBox, Loname, mode, LinkerParm.name);
  1164. ⓪&Upper (LinkerParm.name);
  1165. ⓪&FOR i:= 1 TO 8 DO
  1166. ⓪(WITH linkBoxIdx[i] DO
  1167. ⓪*SetGetBoxState (linkBox, check, mode, checkObj, LinkerParm.linkList[i].valid);
  1168. ⓪*IF mode = setValue THEN
  1169. ⓪,notValid := ~ LinkerParm.linkList[i].valid;
  1170. ⓪,SetGetBoxState (linkBox, path, setValue, disableObj, notValid);
  1171. ⓪*END;
  1172. ⓪*SetGetBoxStr (linkBox, path, mode, LinkerParm.linkList[i].name);
  1173. ⓪(END
  1174. ⓪&END;
  1175. ⓪&valid := (LinkerParm.linkStackSize # 0L); notValid := ~ valid;
  1176. ⓪&SetGetBoxState (linkBox, Lochecks, mode, checkObj, valid);
  1177. ⓪&IF mode = setValue THEN
  1178. ⓪(SetGetBoxState (linkBox, Lostack, setValue, disableObj, notValid);
  1179. ⓪&END;
  1180. ⓪&SetGetBoxLCard (linkBox, Lostack, mode, LinkerParm.linkStackSize);
  1181. ⓪&IF ~ valid THEN LinkerParm.linkStackSize := 0L END;
  1182. ⓪&SetGetBoxCard (linkBox, Lomaxmod, mode, LinkerParm.maxLinkMod);
  1183. ⓪&
  1184. ⓪&SetGetBoxState (linkBox, Lofastld, mode, checkObj, LinkerParm.fastLoad);
  1185. ⓪&SetGetBoxState (linkBox, Lofastco, mode, checkObj, LinkerParm.fastCode);
  1186. ⓪&SetGetBoxState (linkBox, Lofastme, mode, checkObj, LinkerParm.fastMemory);
  1187. ⓪&
  1188. ⓪&SetGetBoxState (linkBox, Losymfil, mode, checkObj, LinkerParm.symbolFile);
  1189. ⓪&
  1190. ⓪&refs[1].obj := Lonoopt;
  1191. ⓪&refs[1].value := WORD (noOptimize);
  1192. ⓪&refs[2].obj := Lonamopt;
  1193. ⓪&refs[2].value := WORD (nameOptimize);
  1194. ⓪&refs[3].obj := Lomiddle;
  1195. ⓪&refs[3].value := WORD (partOptimize);
  1196. ⓪&refs[4].obj := Lofull;
  1197. ⓪&refs[4].value := WORD (fullOptimize);
  1198. ⓪&i := ORD (LinkerParm.optimize);
  1199. ⓪&SetGetBoxEnum (linkBox, refs, mode, i);
  1200. ⓪&LinkerParm.optimize := VAL (LinkMode, i);
  1201. ⓪$END setGetLinkOpts;
  1202. ⓪$
  1203. ⓪ 
  1204. ⓪"VAR   space, start    : Rectangle;
  1205. ⓪(exit, i         : CARDINAL;
  1206. ⓪"
  1207. ⓪"BEGIN
  1208. ⓪$animateMenuTitle (Mparms, start);
  1209. ⓪$
  1210. ⓪$setGetLinkOpts (setValue);
  1211. ⓪$PrepareBox (linkBox, start, space);
  1212. ⓪$
  1213. ⓪$LOOP
  1214. ⓪&formDo (linkBox, Root, exit);
  1215. ⓪&
  1216. ⓪&IF (exit = Look) OR (exit = Loquit) THEN
  1217. ⓪(DeselectButton (linkBox, exit); EXIT
  1218. ⓪&ELSIF exit = Lochecks THEN
  1219. ⓪(ToggleCheckPlus (linkBox, Lochecks, Lostack)
  1220. ⓪&ELSIF (exit = Lofastld) OR (exit = Lofastco) OR (exit = Lofastme)
  1221. ⓪&OR (exit = Losymfil) THEN
  1222. ⓪(ToggleCheckBox (linkBox, exit)
  1223. ⓪&ELSE
  1224. ⓪(FOR i := 1 TO 8 DO
  1225. ⓪*IF linkBoxIdx[i].check = exit THEN
  1226. ⓪,ToggleCheckPlus (linkBox, exit, linkBoxIdx[i].path)
  1227. ⓪*END
  1228. ⓪(END;
  1229. ⓪&END;
  1230. ⓪$END;
  1231. ⓪$
  1232. ⓪$IF exit = Look THEN setGetLinkOpts (getValue) END;
  1233. ⓪"
  1234. ⓪$ReleaseBox(linkBox, start,space);
  1235. ⓪$deAnimateMenuTitle (Mparms);
  1236. ⓪"END doLinkerOptionBox;
  1237. ⓪"
  1238. ⓪ PROCEDURE doScanBox (): BOOLEAN;
  1239. ⓪ 
  1240. ⓪"VAR     but : CARDINAL;
  1241. ⓪"
  1242. ⓪"BEGIN
  1243. ⓪$ScanAddr := 0L;
  1244. ⓪$SetTextString (scanBox, Saddr, '');
  1245. ⓪$DoSimpleBox (scanBox, Rect (-1, -1, -1, -1), but);
  1246. ⓪$IF but = Sok THEN SetGetBoxLCard (scanBox, Saddr, getValue, ScanAddr) END;
  1247. ⓪$RETURN ScanAddr # 0L
  1248. ⓪"END doScanBox;
  1249. ⓪ 
  1250. ⓪ FORWARD setWorkfileName (idx: CARDINAL; VAR name: ARRAY OF CHAR);
  1251. ⓪ 
  1252. ⓪ (*  doChangeWork -- Inquires a file name from the user, that becomes the new
  1253. ⓪!*                  work file number 'idx'.
  1254. ⓪!*                  'idx' has to be an active work file.
  1255. ⓪!*)
  1256. ⓪ 
  1257. ⓪ PROCEDURE doChangeWork (idx: INTEGER);
  1258. ⓪ 
  1259. ⓪"VAR     str   : FileStr;
  1260. ⓪*ok    : BOOLEAN;
  1261. ⓪"
  1262. ⓪"BEGIN
  1263. ⓪$animateMenuTitle (Mworkfil, voidFrame);
  1264. ⓪"
  1265. ⓪$str := WorkField.elems[idx].sourceName;
  1266. ⓪$SelectFile (changeWorkTitle^, str, ok);
  1267. ⓪$
  1268. ⓪$IF ok
  1269. ⓪$THEN
  1270. ⓪&Upper (str);
  1271. ⓪&setWorkfileName (idx, str);
  1272. ⓪$END;
  1273. ⓪$
  1274. ⓪$deAnimateMenuTitle (Mworkfil);
  1275. ⓪"END doChangeWork;
  1276. ⓪ 
  1277. ⓪ PROCEDURE doShellParameterBox;
  1278. ⓪ 
  1279. ⓪"PROCEDURE setGetShellParm (mode: SetGetMode);
  1280. ⓪"
  1281. ⓪$BEGIN
  1282. ⓪&WITH shellParm DO
  1283. ⓪(SetGetBoxState (shellParmBox, Spbreak, mode, checkObj, breakActive);
  1284. ⓪(SetGetBoxStr (shellParmBox, Spbaname, mode, batchPath);
  1285. ⓪(Upper (batchPath);
  1286. ⓪(SetGetBoxStr (shellParmBox, Sppaname, mode, parameterPath);
  1287. ⓪(Upper (parameterPath);
  1288. ⓪(SetGetBoxStr (shellParmBox, Spscpath, mode, TemporaryPath);
  1289. ⓪(ValidatePath (TemporaryPath);
  1290. ⓪(IF TemporaryPath[0] # HomeSymbol THEN
  1291. ⓪*MakeFullPath (TemporaryPath, voidI);
  1292. ⓪(END;
  1293. ⓪(SetGetBoxStr (shellParmBox, Spmake, mode, makeName);
  1294. ⓪(Upper (makeName);
  1295. ⓪&END;
  1296. ⓪$END setGetShellParm;
  1297. ⓪$
  1298. ⓪"VAR   space, start    : Rectangle;
  1299. ⓪(exit            : CARDINAL;
  1300. ⓪"
  1301. ⓪"BEGIN
  1302. ⓪$animateMenuTitle (Mparms, start);
  1303. ⓪$
  1304. ⓪$setGetShellParm (setValue);
  1305. ⓪$PrepareBox (shellParmBox, start, space);
  1306. ⓪$
  1307. ⓪$LOOP
  1308. ⓪&formDo (shellParmBox, Root, exit);
  1309. ⓪&
  1310. ⓪&CASE exit OF
  1311. ⓪(Spok, Spquit: DeselectButton (shellParmBox, exit); EXIT|
  1312. ⓪(
  1313. ⓪(Spbreak     : ToggleCheckBox (shellParmBox, exit)|
  1314. ⓪&ELSE
  1315. ⓪&END;
  1316. ⓪$END;
  1317. ⓪$
  1318. ⓪$IF exit = Spok THEN setGetShellParm (getValue) END;
  1319. ⓪$
  1320. ⓪$ReleaseBox(shellParmBox, start, space);
  1321. ⓪$deAnimateMenuTitle (Mparms);
  1322. ⓪"END doShellParameterBox;
  1323. ⓪ 
  1324. ⓪ PROCEDURE doEditorParameterBox;
  1325. ⓪ 
  1326. ⓪"PROCEDURE setGetEditorParm (mode: SetGetMode);
  1327. ⓪"
  1328. ⓪$VAR disable: BOOLEAN;
  1329. ⓪"
  1330. ⓪$BEGIN
  1331. ⓪&WITH EditorParm DO
  1332. ⓪(SetGetBoxStr (editorParmBox, Epname, mode, name);
  1333. ⓪(Upper (name);
  1334. ⓪(SetGetBoxState (editorParmBox, Epsearch, mode,
  1335. ⓪8checkObj, searchSources);
  1336. ⓪(SetGetBoxState (editorParmBox, Epstoper, mode,
  1337. ⓪8checkObj, waitOnError);
  1338. ⓪(SetGetBoxState (editorParmBox, Epshtemp, mode,
  1339. ⓪8checkObj, tempShellFile);
  1340. ⓪(disable := ~ tempShellFile;
  1341. ⓪(SetGetBoxState (editorParmBox, Epshname, mode, disableObj, disable);
  1342. ⓪(SetGetBoxStr (editorParmBox, Epshname, mode, tempShellName);
  1343. ⓪(
  1344. ⓪(SetGetBoxState (editorParmBox, Epedtemp, mode,
  1345. ⓪8checkObj, tempEditorFile);
  1346. ⓪(disable := ~ tempEditorFile;
  1347. ⓪(SetGetBoxState (editorParmBox, Epedname, mode, disableObj, disable);
  1348. ⓪(SetGetBoxStr (editorParmBox, Epedname, mode, tempEditorName);
  1349. ⓪ 
  1350. ⓪(SetGetBoxState (editorParmBox, Eparg, mode,
  1351. ⓪8checkObj, passArgument);
  1352. ⓪(SetGetBoxState (editorParmBox, Eparname, mode,
  1353. ⓪8checkObj, passName);
  1354. ⓪(SetGetBoxState (editorParmBox, Eparerro, mode,
  1355. ⓪8checkObj, passErrorText);
  1356. ⓪(SetGetBoxState (editorParmBox, Eparpos, mode,
  1357. ⓪8checkObj, passErrorPos);
  1358. ⓪&END;
  1359. ⓪$END setGetEditorParm;
  1360. ⓪$
  1361. ⓪"VAR   start, space: Rectangle;
  1362. ⓪(exit        : CARDINAL;
  1363. ⓪ 
  1364. ⓪"BEGIN
  1365. ⓪$animateMenuTitle (Mparms, start);
  1366. ⓪$
  1367. ⓪$setGetEditorParm (setValue);
  1368. ⓪$PrepareBox (editorParmBox, start, space);
  1369. ⓪$
  1370. ⓪$LOOP
  1371. ⓪&formDo (editorParmBox, Root, exit);
  1372. ⓪&
  1373. ⓪&CASE exit OF
  1374. ⓪(Epok, Epquit: DeselectButton (editorParmBox, exit); EXIT|
  1375. ⓪(
  1376. ⓪(Epsearch,
  1377. ⓪(Epstoper,
  1378. ⓪(Eparg,
  1379. ⓪(Eparname,
  1380. ⓪(Eparerro,
  1381. ⓪(Eparpos     : ToggleCheckBox (editorParmBox, exit)|
  1382. ⓪(Epshtemp    : ToggleCheckPlus (editorParmBox, Epshtemp, Epshname)|
  1383. ⓪(Epedtemp    : ToggleCheckPlus (editorParmBox, Epedtemp, Epedname)|
  1384. ⓪&ELSE
  1385. ⓪&END;
  1386. ⓪$END;
  1387. ⓪$
  1388. ⓪$IF exit = Epok THEN setGetEditorParm (getValue) END;
  1389. ⓪"
  1390. ⓪$ReleaseBox(editorParmBox, start, space);
  1391. ⓪$deAnimateMenuTitle (Mparms);
  1392. ⓪"END doEditorParameterBox;
  1393. ⓪"
  1394. ⓪ PROCEDURE doHelpBox (REF fname: ARRAY OF CHAR);
  1395. ⓪ 
  1396. ⓪"CONST noLines = 14;   (*  Anzahl der Zeilen in der Hilfe-Box  *)
  1397. ⓪(noRows  = 65;
  1398. ⓪ 
  1399. ⓪"VAR   start, space    : Rectangle;
  1400. ⓪(but, i,
  1401. ⓪(visibleLines    : CARDINAL;
  1402. ⓪(text            : List;
  1403. ⓪(err, end, first : BOOLEAN;
  1404. ⓪(f               : File;
  1405. ⓪(str             : ptrString;
  1406. ⓪(path            : PathStr;
  1407. ⓪ 
  1408. ⓪"PROCEDURE fileErr (): BOOLEAN;
  1409. ⓪$VAR state: INTEGER;
  1410. ⓪$BEGIN
  1411. ⓪&state := State (f);
  1412. ⓪&IF (state < fOK) OR (state = fEOF) THEN
  1413. ⓪)ResetState (f);
  1414. ⓪)FileAlert (state);
  1415. ⓪)RETURN TRUE
  1416. ⓪&ELSE
  1417. ⓪)RETURN FALSE
  1418. ⓪&END;
  1419. ⓪$END fileErr;
  1420. ⓪$
  1421. ⓪"PROCEDURE addLine (obj: CARDINAL);
  1422. ⓪$BEGIN
  1423. ⓪&IF NOT end THEN
  1424. ⓪(str := NextEntry (text);
  1425. ⓪(IF str = NIL THEN end := TRUE ELSE INC (visibleLines) END;
  1426. ⓪&END;
  1427. ⓪&IF end THEN
  1428. ⓪(SetTextString (helpBox, obj, '')
  1429. ⓪&ELSE
  1430. ⓪(IF Length (str^) > noRows THEN
  1431. ⓪*Delete (str^, noRows, Length (str^) - noRows, voidO);
  1432. ⓪(END;
  1433. ⓪(SetTextString (helpBox, obj, str^);
  1434. ⓪&END;
  1435. ⓪$END addLine;
  1436. ⓪$
  1437. ⓪"BEGIN
  1438. ⓪$animateMenuTitle (Mparms, start);
  1439. ⓪$
  1440. ⓪$(*  Lies Hilfe-Datei ein.
  1441. ⓪%*)
  1442. ⓪ 
  1443. ⓪$Concat (ShellPath, fname, path, voidO);
  1444. ⓪$CreateList (text, err);
  1445. ⓪$IF err THEN reportOutOfMemory; deAnimateMenuTitle (Mparms); RETURN END;
  1446. ⓪$ShowBee;
  1447. ⓪$Open (f, path, readSeqTxt);
  1448. ⓪$IF (State (f)) # fOK
  1449. ⓪$THEN
  1450. ⓪&doAlert (noHelpAlt); 
  1451. ⓪&DeleteList (text, voidO);
  1452. ⓪&deAnimateMenuTitle (Mparms);
  1453. ⓪&ShowArrow;
  1454. ⓪&RETURN
  1455. ⓪$END;
  1456. ⓪$LOOP
  1457. ⓪$
  1458. ⓪&NEW (str);
  1459. ⓪&IF str = NIL THEN reportOutOfMemory; EXIT END;
  1460. ⓪&IF fileErr () THEN DISPOSE (str); EXIT END;
  1461. ⓪&Text.ReadString (f, str^);
  1462. ⓪$  AppendEntry (text, str, err);
  1463. ⓪&IF err THEN reportOutOfMemory; DISPOSE (str); EXIT END;
  1464. ⓪&IF fileErr () THEN EXIT END;
  1465. ⓪&Text.ReadLn (f);
  1466. ⓪$
  1467. ⓪$END;
  1468. ⓪$Close (f);
  1469. ⓪$ShowArrow;
  1470. ⓪$
  1471. ⓪$(*  Zeige Hilfe-Datei an.
  1472. ⓪%*)
  1473. ⓪%
  1474. ⓪$ResetList (text);
  1475. ⓪$but := Hpnext; visibleLines := 0; first := TRUE;
  1476. ⓪$REPEAT
  1477. ⓪$
  1478. ⓪&IF but = Hpprev THEN
  1479. ⓪(IF EndOfList (text) THEN INC (visibleLines) END;
  1480. ⓪(FOR i := 1 TO noLines + visibleLines DO voidADR := PrevEntry (text) END;
  1481. ⓪&END;
  1482. ⓪&SetObjStateElem (helpBox, Hpprev, disableObj, EndOfList (text));
  1483. ⓪&end := FALSE; visibleLines := 0;
  1484. ⓪&addLine (Hpmsg1); addLine (Hpmsg2); addLine (Hpmsg3);
  1485. ⓪&addLine (Hpmsg4); addLine (Hpmsg5); addLine (Hpmsg6);
  1486. ⓪&addLine (Hpmsg7); addLine (Hpmsg8); addLine (Hpmsg9);
  1487. ⓪&addLine (Hpmsg10); addLine (Hpmsg11); addLine (Hpmsg12);
  1488. ⓪&addLine (Hpmsg13); addLine (Hpmsg14);
  1489. ⓪&SetObjStateElem (helpBox, Hpnext, disableObj, EndOfList (text));
  1490. ⓪&SetObjFlag (helpBox, Hpnext, defaultFlg, NOT EndOfList (text));
  1491. ⓪&SetObjFlag (helpBox, Hpquit, defaultFlg, EndOfList (text));
  1492. ⓪&
  1493. ⓪&IF first THEN PrepareBox (helpBox, start, space); first := FALSE
  1494. ⓪&ELSE DrawObject (helpBox, Root, MaxDepth, space) END;
  1495. ⓪&formDo (helpBox, Root, but);
  1496. ⓪&DeselectButton (helpBox, but);
  1497. ⓪&
  1498. ⓪$UNTIL but = Hpquit;
  1499. ⓪$ReleaseBox (helpBox, start, space);
  1500. ⓪$
  1501. ⓪$(*  Lösche Hilfe-Datei.
  1502. ⓪%*)
  1503. ⓪$deleteSimpleList (text, TRUE);
  1504. ⓪$
  1505. ⓪$deAnimateMenuTitle (Mparms);
  1506. ⓪"END doHelpBox;
  1507. ⓪ 
  1508. ⓪ 
  1509. ⓪ PROCEDURE doInfoBox;
  1510. ⓪ 
  1511. ⓪ (*
  1512. ⓪!* Umgebungsinformationen
  1513. ⓪!*)
  1514. ⓪ 
  1515. ⓪"VAR   dftPath,
  1516. ⓪(codeFile        : FileStr;
  1517. ⓪(dftPathEditable : BOOLEAN;
  1518. ⓪(
  1519. ⓪"PROCEDURE setGetInfo (mode: SetGetMode);
  1520. ⓪"
  1521. ⓪$VAR lc: LONGCARD; s: ARRAY [0..13] OF CHAR;
  1522. ⓪"
  1523. ⓪$BEGIN
  1524. ⓪&SetObjFlag (infoBox, Inpath, editFlg, dftPathEditable);
  1525. ⓪&SetGetBoxStr (infoBox, Inpath, mode, dftPath);
  1526. ⓪&SetGetBoxLCard (infoBox, Instack, mode, DefaultStackSize);
  1527. ⓪&SetGetBoxStr (infoBox, Inmkfile, mode, MakeFileName);
  1528. ⓪&SetGetBoxState (infoBox, Stponrtn, mode, checkObj, shellParm.waitOnReturn);
  1529. ⓪&Upper (MakeFileName);
  1530. ⓪&IF mode = setValue THEN
  1531. ⓪(lc := MemAvail ();
  1532. ⓪(SetGetBoxLCard (infoBox, Inblock, setValue, lc);
  1533. ⓪(lc := AllAvail ();
  1534. ⓪(SetGetBoxLCard (infoBox, Inall, setValue, lc);
  1535. ⓪(SetGetBoxStr (infoBox, Ihome, setValue, HomePath);
  1536. ⓪(SetGetBoxStr (infoBox, Incode, setValue, codeFile);
  1537. ⓪(SetGetBoxLCard (infoBox, Inlength, setValue, LastCodeSize);
  1538. ⓪(IF UsedFormat = IEEEReal THEN
  1539. ⓪*IF RealMode = 2 THEN
  1540. ⓪,s:= 'IEEE (ST-FPU)'
  1541. ⓪*ELSE
  1542. ⓪,s:= 'IEEE (TT-FPU)'
  1543. ⓪*END
  1544. ⓪(ELSE
  1545. ⓪*s:= 'Megamax'
  1546. ⓪(END;
  1547. ⓪(SetGetBoxStr (infoBox, Realform, setValue, s);
  1548. ⓪&END;
  1549. ⓪$END setGetInfo;
  1550. ⓪$
  1551. ⓪"VAR   space, start   : Rectangle;
  1552. ⓪(exit     : CARDINAL;
  1553. ⓪(res     : INTEGER;
  1554. ⓪ 
  1555. ⓪"BEGIN
  1556. ⓪$animateMenuTitle (Mparms, start);
  1557. ⓪$
  1558. ⓪$GetDefaultPath (dftPath);
  1559. ⓪$dftPathEditable := (maxDftPathInfo >= Length (dftPath));
  1560. ⓪$truncCopyString (dftPath, maxDftPathInfo, dftPath);
  1561. ⓪$truncCopyString (LastCodeName, maxCodeFileInfo, codeFile);
  1562. ⓪$setGetInfo (setValue);
  1563. ⓪$
  1564. ⓪$PrepareBox (infoBox, start, space);
  1565. ⓪$LOOP
  1566. ⓪&formDo (infoBox, Root, exit);
  1567. ⓪&CASE exit OF
  1568. ⓪(Inok, Inquit: DeselectButton (infoBox, exit); EXIT|
  1569. ⓪(Stponrtn    : ToggleCheckBox (infoBox, exit)|
  1570. ⓪&ELSE
  1571. ⓪&END;
  1572. ⓪$END;
  1573. ⓪$ReleaseBox(infoBox, start, space);
  1574. ⓪$
  1575. ⓪$IF exit = Inok THEN
  1576. ⓪&setGetInfo (getValue);
  1577. ⓪&IF dftPathEditable THEN
  1578. ⓪(ValidatePath (dftPath);
  1579. ⓪(ReplaceHome (dftPath);
  1580. ⓪(SetDefaultPath (dftPath, res);
  1581. ⓪(FileAlert (res);
  1582. ⓪&END;
  1583. ⓪$END;
  1584. ⓪$deAnimateMenuTitle (Mparms);
  1585. ⓪"END doInfoBox;
  1586. ⓪"
  1587. ⓪ 
  1588. ⓪0(*  Exportierte Box-Funktionen  *)
  1589. ⓪ 
  1590. ⓪ PROCEDURE ScanBox (VAR name: ARRAY OF CHAR): BOOLEAN;
  1591. ⓪ 
  1592. ⓪"VAR   but: CARDINAL;
  1593. ⓪ 
  1594. ⓪"BEGIN
  1595. ⓪$SetTextString (sNameBox, Snedit, name);
  1596. ⓪$DoSimpleBox (sNameBox, Rect (-1, -1, -1, -1), but);
  1597. ⓪$CASE but OF
  1598. ⓪&Snok  : GetTextString(sNameBox, Snedit, name); Upper (name)|
  1599. ⓪&Snwork: WITH WorkField DO
  1600. ⓪0IF current >= 0
  1601. ⓪0THEN Assign(elems[current].sourceName, name, voidO)
  1602. ⓪0ELSE Assign ('', name, voidO); END;
  1603. ⓪.END|
  1604. ⓪$ELSE
  1605. ⓪$END;
  1606. ⓪$RETURN but # Snquit
  1607. ⓪"END ScanBox;
  1608. ⓪ 
  1609. ⓪ PROCEDURE RequestArg (VAR name: ARRAY OF CHAR);
  1610. ⓪ 
  1611. ⓪"BEGIN
  1612. ⓪$SetTextString (argBox, Aedit, name);
  1613. ⓪$DoSimpleBox (argBox, Rect (0, 0, 50, 30), voidC);
  1614. ⓪$GetTextString (argBox, Aedit, name);
  1615. ⓪"END RequestArg;
  1616. ⓪ 
  1617. ⓪ TYPE    TellMode        = (initTell, newTellValue, endTell);
  1618. ⓪ 
  1619. ⓪ PROCEDURE TellLoading (mode: TellMode; REF fname: ARRAY OF CHAR);
  1620. ⓪ 
  1621. ⓪"VAR     start   : Rectangle;
  1622. ⓪"
  1623. ⓪"BEGIN
  1624. ⓪$start := Rect (0, 0, 50, 30);
  1625. ⓪$
  1626. ⓪$CASE mode OF
  1627. ⓪&initTell            : SetTextString (loadBox, Lfname, '');
  1628. ⓪<PrepareBox (loadBox, start, tellSpace);
  1629. ⓪<ShowBee|
  1630. ⓪<
  1631. ⓪&newTellValue        : SetTextString (loadBox, Lfname, '            ');
  1632. ⓪<drawObject (loadBox, Lfname);
  1633. ⓪<SetTextString (loadBox, Lfname, FileName (fname));
  1634. ⓪<drawObject (loadBox, Lfname)|
  1635. ⓪<
  1636. ⓪&endTell             : ReleaseBox (loadBox, start, tellSpace);
  1637. ⓪<ShowArrow|
  1638. ⓪$END;
  1639. ⓪"END TellLoading;
  1640. ⓪ 
  1641. ⓪"
  1642. ⓪ 
  1643. ⓪8(*  misc. II  *)
  1644. ⓪8(*  ========  *)
  1645. ⓪ 
  1646. ⓪ PROCEDURE enableAndDisableMenuItems;
  1647. ⓪ 
  1648. ⓪"VAR   workSelected: BOOLEAN;
  1649. ⓪ 
  1650. ⓪"BEGIN
  1651. ⓪$EnableItem (menu, Mwnew, WorkField.noUsed < maxWorkFiles);
  1652. ⓪$workSelected := (WorkField.current # noCurrentWorkfile);
  1653. ⓪$EnableItem (menu, Mwdelete, workSelected);
  1654. ⓪$EnableItem (menu, Mwchange, workSelected);
  1655. ⓪$EnableItem (menu, Mdeditwo, workSelected);
  1656. ⓪$EnableItem (menu, Mdcompwo, workSelected);
  1657. ⓪$EnableItem (menu, Mdexecwo, workSelected);
  1658. ⓪$EnableItem (menu, Mdlinkwo, workSelected);
  1659. ⓪$EnableItem (menu, Mdscanwo, workSelected);
  1660. ⓪"END enableAndDisableMenuItems;
  1661. ⓪ 
  1662. ⓪ 
  1663. ⓪0(*  Arbeitende Routinen  *)
  1664. ⓪0(*  ===================  *)
  1665. ⓪ 
  1666. ⓪ FORWARD HideSS (complete: BOOLEAN);
  1667. ⓪ FORWARD ShowSS (isCompleteHidden: BOOLEAN);
  1668. ⓪ 
  1669. ⓪ 
  1670. ⓪ (*  setWorkfileName -- Assigns the specified workfile a new name.
  1671. ⓪!*)
  1672. ⓪ 
  1673. ⓪ PROCEDURE setWorkfileName (idx: CARDINAL; VAR name: ARRAY OF CHAR);
  1674. ⓪ 
  1675. ⓪"BEGIN
  1676. ⓪$Upper (name);
  1677. ⓪$WITH WorkField.elems[idx]
  1678. ⓪$DO
  1679. ⓪&Assign (name, sourceName, voidO);
  1680. ⓪&codeName := '';
  1681. ⓪$END;
  1682. ⓪$
  1683. ⓪$setWorkfiles;
  1684. ⓪"END setWorkfileName;
  1685. ⓪"
  1686. ⓪"
  1687. ⓪ (*  selectWorkfile -- Selects another work file object. Only used slots would
  1688. ⓪!*                    be selected.
  1689. ⓪!*)
  1690. ⓪!
  1691. ⓪ PROCEDURE selectWorkfile (i: INTEGER);
  1692. ⓪ 
  1693. ⓪"BEGIN
  1694. ⓪$WITH WorkField DO
  1695. ⓪$
  1696. ⓪&(*  Remove check mark at old curr. work file.
  1697. ⓪'*)
  1698. ⓪&IF WorkField.current # noCurrentWorkfile
  1699. ⓪&THEN
  1700. ⓪(CheckItem (menu, elems[current].index, FALSE);
  1701. ⓪&END;
  1702. ⓪&
  1703. ⓪&(*  Set new work file, if it is used.
  1704. ⓪'*)
  1705. ⓪&IF ~ WorkField.elems[i].used THEN i := noCurrentWorkfile END;
  1706. ⓪&WorkField.current := i;
  1707. ⓪&
  1708. ⓪&(*  Set check mark at new curr. work file.
  1709. ⓪'*)
  1710. ⓪&IF WorkField.current # noCurrentWorkfile
  1711. ⓪&THEN
  1712. ⓪(CheckItem (menu, elems[current].index, TRUE);
  1713. ⓪&END;
  1714. ⓪$
  1715. ⓪$END;(*WITH*)
  1716. ⓪"END selectWorkfile;
  1717. ⓪ 
  1718. ⓪ (*  makeNewWorkfile -- Tries to make another work file object.
  1719. ⓪!*)
  1720. ⓪!
  1721. ⓪ PROCEDURE makeNewWorkfile;
  1722. ⓪ 
  1723. ⓪"VAR   i    : CARDINAL;
  1724. ⓪(str  : FileStr;
  1725. ⓪(ok   : BOOLEAN;
  1726. ⓪(
  1727. ⓪"BEGIN
  1728. ⓪$animateMenuTitle (Mworkfil, voidFrame);
  1729. ⓪$
  1730. ⓪$(*  find free slot.
  1731. ⓪%*)
  1732. ⓪$(* wir wollen mit Nr. 1 anfangen, erst nach Nr. 9 soll Nr. 0 kommen *)
  1733. ⓪$i := 1;
  1734. ⓪$WHILE (i <= maxWorkFiles) AND WorkField.elems[i MOD 10].used DO INC (i) END;
  1735. ⓪$IF i = 10 THEN i:= 0 END;
  1736. ⓪$
  1737. ⓪$IF i < maxWorkFiles THEN    (*  if found, then init. slot  *)
  1738. ⓪$
  1739. ⓪&str := '';
  1740. ⓪&SelectFile (newWorkTitle^, str, ok);
  1741. ⓪&
  1742. ⓪&IF ok THEN
  1743. ⓪&
  1744. ⓪(SearchFile (str, SrcPaths, fromStart, voidO, str);
  1745. ⓪(INC (WorkField.noUsed);
  1746. ⓪(WorkField.elems[i].used := TRUE;
  1747. ⓪(setWorkfileName (i, str);
  1748. ⓪(selectWorkfile (i);
  1749. ⓪(
  1750. ⓪&END;
  1751. ⓪&
  1752. ⓪$ELSE
  1753. ⓪&doAlert (noNewWorkAlt)
  1754. ⓪$END;
  1755. ⓪$
  1756. ⓪$deAnimateMenuTitle (Mworkfil);
  1757. ⓪"END makeNewWorkfile;
  1758. ⓪ 
  1759. ⓪ (*  killWorkfile -- Releases the current workfile object.
  1760. ⓪!*)
  1761. ⓪ 
  1762. ⓪ PROCEDURE killWorkfile;
  1763. ⓪ 
  1764. ⓪"BEGIN
  1765. ⓪$animateMenuTitle (Mworkfil, voidFrame);
  1766. ⓪$
  1767. ⓪$WITH WorkField DO
  1768. ⓪&IF current # noCurrentWorkfile THEN
  1769. ⓪&
  1770. ⓪(DEC (noUsed);
  1771. ⓪(elems[current].used := FALSE;
  1772. ⓪(elems[current].sourceName := '';
  1773. ⓪(current := noCurrentWorkfile;
  1774. ⓪(setWorkfiles;                   (*  Correct menu tree  *)
  1775. ⓪(
  1776. ⓪&END;
  1777. ⓪$END;
  1778. ⓪&
  1779. ⓪$deAnimateMenuTitle (Mworkfil);
  1780. ⓪"END killWorkfile;
  1781. ⓪#
  1782. ⓪ PROCEDURE saveParameter;
  1783. ⓪ 
  1784. ⓪"VAR   but: CARDINAL;
  1785. ⓪ 
  1786. ⓪"BEGIN
  1787. ⓪$FormAlert (1, parmSaveAlt^, but);
  1788. ⓪$IF but = 1 THEN SaveParameter END;
  1789. ⓪"END saveParameter;
  1790. ⓪ 
  1791. ⓪ (*  actManager -- Prepares the shell to execute a shell action and then calls
  1792. ⓪!*                the 'action' procedure in the outer module.
  1793. ⓪!*
  1794. ⓪!*                'obj'       -- Desktop object associated with the desired
  1795. ⓪!*                               action.
  1796. ⓪!*                'specials'  -- Special keys pressed at action selection time.
  1797. ⓪!*                'work'      -- Parameter of the action is a work file?
  1798. ⓪!*                'tool'      -- Is a executed file a tool? (to set the correct
  1799. ⓪!*                               path in 'call')
  1800. ⓪!*                'alsoExec'  -- Also excecute code after compilation?
  1801. ⓪!*                'noSelect'  -- Don't call file slector box.
  1802. ⓪!*)
  1803. ⓪"
  1804. ⓪ PROCEDURE actManager (obj     : CARDINAL;
  1805. ⓪6specials: SpecialKeySet;
  1806. ⓪5 work,
  1807. ⓪6tool,
  1808. ⓪6alsoExec,
  1809. ⓪6noSelect: BOOLEAN);
  1810. ⓪ 
  1811. ⓪"PROCEDURE assignMsg (VAR name: ARRAY OF CHAR);
  1812. ⓪"
  1813. ⓪$BEGIN
  1814. ⓪&truncCopyString (name, msgStrLen, msgStr);
  1815. ⓪$END assignMsg;
  1816. ⓪$
  1817. ⓪"PROCEDURE setSourceCurrFnAndMsg;
  1818. ⓪"
  1819. ⓪$BEGIN
  1820. ⓪$
  1821. ⓪&IF ~ work AND Empty (currFn)THEN
  1822. ⓪(currFn := lastFn;
  1823. ⓪&END;
  1824. ⓪&
  1825. ⓪&IF work THEN
  1826. ⓪(WITH WorkField DO
  1827. ⓪*IF current >= 0 THEN assignMsg (elems[current].sourceName)
  1828. ⓪*ELSE msgStr := '' END;
  1829. ⓪(END;
  1830. ⓪&ELSE assignMsg (currFn) END;
  1831. ⓪&
  1832. ⓪$END setSourceCurrFnAndMsg;
  1833. ⓪$
  1834. ⓪"PROCEDURE setCodeCurrFnAndMsg;
  1835. ⓪"
  1836. ⓪$BEGIN
  1837. ⓪$
  1838. ⓪&IF ~ work AND Empty (currFn) THEN
  1839. ⓪(currFn := CodeName;
  1840. ⓪&END;
  1841. ⓪&
  1842. ⓪&IF work THEN
  1843. ⓪(WITH WorkField DO
  1844. ⓪*IF current # noCurrentWorkfile THEN
  1845. ⓪,assignMsg (elems[current].codeName)
  1846. ⓪*ELSE msgStr := '' END;
  1847. ⓪(END;
  1848. ⓪&ELSE assignMsg (currFn) END;
  1849. ⓪&
  1850. ⓪$END setCodeCurrFnAndMsg;
  1851. ⓪"
  1852. ⓪"TYPE  testProc        = PROCEDURE (REF (* name: *) ARRAY OF CHAR): BOOLEAN;
  1853. ⓪$
  1854. ⓪"PROCEDURE testWorkAndCurrFn ((*$Z-*)test: testProc(*$Z=*)): BOOLEAN;
  1855. ⓪"
  1856. ⓪$BEGIN
  1857. ⓪&WITH WorkField DO
  1858. ⓪(IF work AND (current = noCurrentWorkfile) THEN RETURN FALSE
  1859. ⓪(ELSE
  1860. ⓪*RETURN (work AND test (elems[current].sourceName)) OR test (currFn)
  1861. ⓪(END;
  1862. ⓪&END;
  1863. ⓪$END testWorkAndCurrFn;
  1864. ⓪"
  1865. ⓪"
  1866. ⓪"VAR ok: BOOLEAN;
  1867. ⓪"
  1868. ⓪"PROCEDURE ifNotWorkThenSelectFile (title: PtrMaxStr; source: BOOLEAN);
  1869. ⓪"
  1870. ⓪$BEGIN
  1871. ⓪&ok := TRUE;
  1872. ⓪&IF NOT work AND NOT noSelect
  1873. ⓪&THEN
  1874. ⓪(IF source THEN currFn := lastFn ELSE currFn := CodeName END;
  1875. ⓪(SelectFile (title^, currFn, ok);
  1876. ⓪&END;
  1877. ⓪$END ifNotWorkThenSelectFile;
  1878. ⓪$
  1879. ⓪$
  1880. ⓪"BEGIN
  1881. ⓪$CASE obj OF
  1882. ⓪&Compile  : IF alsoExec THEN ifNotWorkThenSelectFile (compExecTitle, TRUE);
  1883. ⓪1ELSE ifNotWorkThenSelectFile (compileTitle, TRUE) END;
  1884. ⓪1IF NOT ok THEN RETURN END;
  1885. ⓪1setSourceCurrFnAndMsg;
  1886. ⓪1IF testWorkAndCurrFn (isMakeFile) THEN
  1887. ⓪3IF alsoExec THEN action (doMkEx, work, tool)
  1888. ⓪3ELSE action (doMake, work, tool) END;
  1889. ⓪1ELSE
  1890. ⓪3IF alsoExec THEN action (doCpEx, work, tool)
  1891. ⓪3ELSE action (doComp, work, tool) END;
  1892. ⓪1END|
  1893. ⓪&Edit     : ifNotWorkThenSelectFile (editTitle, TRUE);
  1894. ⓪1IF NOT ok THEN RETURN END;
  1895. ⓪1setSourceCurrFnAndMsg; action (doEdit, work, tool)|
  1896. ⓪&Execute  : ifNotWorkThenSelectFile (executeTitle, FALSE);
  1897. ⓪1IF NOT ok THEN RETURN END;
  1898. ⓪1setCodeCurrFnAndMsg;
  1899. ⓪1Assign (lastFn, TextName, voidO);
  1900. ⓪1IF NOT work AND IsSourceName (currFn) THEN
  1901. ⓪3assignMsg (currFn);
  1902. ⓪3action (doExec, work, tool);
  1903. ⓪1ELSE
  1904. ⓪3IF testWorkAndCurrFn (IsMBTFile)    (*  exec. Batch-File  *) THEN
  1905. ⓪5action (doBtch, work, tool);
  1906. ⓪3ELSIF testWorkAndCurrFn (isMSPFile) (*  exec. Parm.-File  *) THEN
  1907. ⓪5action (doParm, work, tool);
  1908. ⓪3ELSIF testWorkAndCurrFn (isMakeFile)(*  exec. Make-File  *) THEN
  1909. ⓪5action (doMkEx, work, tool);
  1910. ⓪3ELSE                                (*  exec. norm. code  *)
  1911. ⓪5IF withShift (specials) THEN
  1912. ⓪7RequestArg (lastArgs);
  1913. ⓪7args := lastArgs;
  1914. ⓪5ELSE
  1915. ⓪7args := '';
  1916. ⓪5END;
  1917. ⓪5noDirChange := withAlt (specials);
  1918. ⓪5action (doExec, work, tool);
  1919. ⓪5noDirChange := FALSE;
  1920. ⓪3END;
  1921. ⓪1END;
  1922. ⓪1Assign (TextName, lastFn, voidO)|
  1923. ⓪&Link     : ifNotWorkThenSelectFile (linkTitle, FALSE);
  1924. ⓪1IF NOT ok THEN RETURN END;
  1925. ⓪1setCodeCurrFnAndMsg; action (doLink, work, tool)|
  1926. ⓪&
  1927. ⓪&Scan     : ifNotWorkThenSelectFile (scanTitle, TRUE);
  1928. ⓪1IF NOT ok THEN RETURN END;
  1929. ⓪1setSourceCurrFnAndMsg;
  1930. ⓪1IF (ChainDepth < 0) OR ~ withShift (specials)
  1931. ⓪1THEN
  1932. ⓪3IF doScanBox () THEN
  1933. ⓪5action (doScan, work, tool);
  1934. ⓪3END;
  1935. ⓪1ELSE msgStr := ''; action (doCont, TRUE, tool) END|
  1936. ⓪ (*
  1937. ⓪&Resident : setCodeCurrFnAndMsg;
  1938. ⓪1HideSS (FALSE);
  1939. ⓪1TellLoading (initTell, '');
  1940. ⓪1action (doLoad, FALSE, tool);
  1941. ⓪1TellLoading (endTell, '');
  1942. ⓪1ShowSS (FALSE)|
  1943. ⓪ *)
  1944. ⓪$ELSE
  1945. ⓪$END;
  1946. ⓪"END actManager;
  1947. ⓪9
  1948. ⓪ PROCEDURE executeTool (i: CARDINAL; specials: SpecialKeySet);
  1949. ⓪ 
  1950. ⓪"VAR   code: FileStr;
  1951. ⓪ 
  1952. ⓪"BEGIN
  1953. ⓪$IF ToolField[i].used AND NOT Empty (ToolField[i].name) THEN
  1954. ⓪&currFn := ToolField[i].name;
  1955. ⓪&code := CodeName;           (* Akt. Code-Datei retten *)
  1956. ⓪&actManager (Execute, specials, FALSE, TRUE, FALSE, TRUE);
  1957. ⓪&CodeName := code;           (* Akt. Code-Datei wiederherstellen *)
  1958. ⓪$END;
  1959. ⓪"END executeTool;
  1960. ⓪ 
  1961. ⓪ PROCEDURE editDocu (specials: SpecialKeySet);
  1962. ⓪ 
  1963. ⓪"VAR   oldText, oldLast: FileStr;
  1964. ⓪"
  1965. ⓪"BEGIN
  1966. ⓪$animateMenuTitle (Mparms, voidFrame);
  1967. ⓪$
  1968. ⓪$ConcatName (shellParm.parameterPath, suf[m2d], currFn);
  1969. ⓪$oldText := TextName;
  1970. ⓪$oldLast := lastFn;
  1971. ⓪$actManager (Edit, specials, FALSE, FALSE, FALSE, TRUE);
  1972. ⓪$TextName := oldText;
  1973. ⓪$lastFn := oldLast;
  1974. ⓪$
  1975. ⓪$deAnimateMenuTitle (Mparms);
  1976. ⓪"END editDocu;
  1977. ⓪ 
  1978. ⓪ PROCEDURE makeFolder;
  1979. ⓪ 
  1980. ⓪"VAR   ok     : BOOLEAN;
  1981. ⓪(name   : FileStr;
  1982. ⓪(result : INTEGER;
  1983. ⓪ 
  1984. ⓪"BEGIN
  1985. ⓪$name:= '';
  1986. ⓪$SelectFile (folderTitle^, name, ok);
  1987. ⓪$IF ok & NOT Empty (FileName (name)) THEN
  1988. ⓪&CreateDir (name, result); FileAlert (result);
  1989. ⓪$END;
  1990. ⓪"END makeFolder;
  1991. ⓪ 
  1992. ⓪ PROCEDURE deleteFile;
  1993. ⓪ 
  1994. ⓪"VAR   ok     : BOOLEAN;
  1995. ⓪(name   : FileStr;
  1996. ⓪(result : INTEGER;
  1997. ⓪ 
  1998. ⓪"BEGIN
  1999. ⓪$name:= '';
  2000. ⓪$SelectFile (deleteTitle^, name, ok);
  2001. ⓪$IF ok & NOT Empty (FileName (name)) THEN
  2002. ⓪&Directory.Delete (name, result); FileAlert (result);
  2003. ⓪$END;
  2004. ⓪"END deleteFile;
  2005. ⓪ 
  2006. ⓪ 
  2007. ⓪0(*  Routinen zur De-/Aktivierung der ShellShell  *)
  2008. ⓪0(*  ===========================================  *)
  2009. ⓪"
  2010. ⓪ PROCEDURE ClearDeskAndShowMsg;
  2011. ⓪ 
  2012. ⓪"BEGIN
  2013. ⓪$MenuBar (NIL, FALSE);
  2014. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  2015. ⓪&(* unter MultiGEM nichts in Menüleise zeichnen *)
  2016. ⓪&DrawObject (msgBar, Root, MaxDepth, ObjectSpaceWithAttrs (msgBar, Root));
  2017. ⓪$END;
  2018. ⓪$FormDial (freeForm, Rect (0, 0, 0, 0), deskSize);
  2019. ⓪"END ClearDeskAndShowMsg;
  2020. ⓪ 
  2021. ⓪ PROCEDURE ShowSS (isCompleteHidden: BOOLEAN);
  2022. ⓪ 
  2023. ⓪"VAR   i   : INTEGER;
  2024. ⓪(name: NameStr;
  2025. ⓪ 
  2026. ⓪"BEGIN
  2027. ⓪$IF isCompleteHidden THEN
  2028. ⓪$
  2029. ⓪&SetCurrGemHandle (gemHdl, ok);
  2030. ⓪&IF ~ ok THEN HALT; TermProcess (-1) END;
  2031. ⓪&
  2032. ⓪&setTools;
  2033. ⓪&setWorkfiles;
  2034. ⓪&MouseInput (TRUE);
  2035. ⓪&
  2036. ⓪&ShowArrow;
  2037. ⓪&IF ~multiTOS THEN SetNewDesk (NIL, Root); END;
  2038. ⓪&MenuBar (menu, TRUE);
  2039. ⓪&
  2040. ⓪&FormDial (freeForm, Rect (0, 0, 0, 0), deskSize);
  2041. ⓪&
  2042. ⓪$END;
  2043. ⓪"END ShowSS;
  2044. ⓪"
  2045. ⓪ 
  2046. ⓪ PROCEDURE InitSS (): BOOLEAN;
  2047. ⓪ 
  2048. ⓪"VAR     mayLoad, success : BOOLEAN;
  2049. ⓪*devParm : PtrDevParm;
  2050. ⓪*space, f: Rectangle;
  2051. ⓪*x, w    : INTEGER;
  2052. ⓪*eventmsg: MessageBuffer;
  2053. ⓪*mouseloc: Point;
  2054. ⓪*buttons: MButtonSet;
  2055. ⓪*keystate: SpecialKeySet;
  2056. ⓪*key: GemChar;
  2057. ⓪*clicks: CARDINAL;
  2058. ⓪*events: EventSet;
  2059. ⓪ 
  2060. ⓪"BEGIN
  2061. ⓪$IF MemAvail () < minNecessaryMem THEN RETURN FALSE END;
  2062. ⓪$
  2063. ⓪$InitGem (RC,dev, success);
  2064. ⓪$IF ~ success THEN
  2065. ⓪&IF GemActive () THEN
  2066. ⓪(multiStringAlert (noGemAlt1,noGemAlt2, voidC);
  2067. ⓪&END;
  2068. ⓪&RETURN FALSE
  2069. ⓪$ELSE
  2070. ⓪&gemHdl:=CurrGemHandle ();
  2071. ⓪$END;
  2072. ⓪$ShellPath:= HomePath;
  2073. ⓪$
  2074. ⓪$GEMBase.GetPBs (gemHdl, vdiPB, aesPB);
  2075. ⓪$multiGEM:= aesPB.pglobal^.count > 1;
  2076. ⓪$multiTOS:= aesPB.pglobal^.count = -1;
  2077. ⓪$
  2078. ⓪$deskSize := DeskSize ();
  2079. ⓪$CharSize (dev, charWidth, charHeight);
  2080. ⓪$
  2081. ⓪2(*  Resource laden und Baumadressen ermitteln  *)
  2082. ⓪2
  2083. ⓪$LoadResource (resourceFile);
  2084. ⓪$IF GemError () THEN
  2085. ⓪&multiStringAlert (noRscAlt1,noRscAlt2, voidC);
  2086. ⓪&ExitGem (gemHdl);
  2087. ⓪&TermProcess (0)
  2088. ⓪$END;
  2089. ⓪$
  2090. ⓪$menu          := TreeAddress (Menu);
  2091. ⓪$msgBar        := TreeAddress (Msgbar);
  2092. ⓪$scanBox       := TreeAddress (Scanbox);
  2093. ⓪$shellBox      := TreeAddress (Shellbox);
  2094. ⓪$optBox        := TreeAddress (Optbox);
  2095. ⓪$sNameBox      := TreeAddress (Snamebox);
  2096. ⓪$argBox        := TreeAddress (Argbox);
  2097. ⓪$linkBox       := TreeAddress (Loptbox);
  2098. ⓪$loadBox       := TreeAddress (Loadbox);
  2099. ⓪$shellParmBox  := TreeAddress (Sparmbox);
  2100. ⓪$editorParmBox := TreeAddress (Eparmbox);
  2101. ⓪$helpBox       := TreeAddress (Helpbox);
  2102. ⓪$infoBox       := TreeAddress (Infobox);
  2103. ⓪$
  2104. ⓪$pathToLongAlt := TextStringAddress (Pathalt);
  2105. ⓪$cOptToLongAlt := TextStringAddress (Optalt);
  2106. ⓪$memFullAlt    := TextStringAddress (Memalt);
  2107. ⓪$debugAlt      := TextStringAddress (Debugalt);
  2108. ⓪$parmSaveAlt   := TextStringAddress (Parmsalt);
  2109. ⓪$noParmAlt     := TextStringAddress (Noparalt);
  2110. ⓪$ContMakeAlt   := TextStringAddress (Contmalt);
  2111. ⓪$noNewWorkAlt  := TextStringAddress (Nowrkalt);
  2112. ⓪$exitShellAlt  := TextStringAddress (Exitalt);
  2113. ⓪$noHelpAlt     := TextStringAddress (Nohlpalt);
  2114. ⓪$
  2115. ⓪$NoLoadStr     := TextStringAddress (Noldstr);
  2116. ⓪$OkStr         := TextStringAddress (Okstr);
  2117. ⓪$EditStr       := TextStringAddress (Editstr);
  2118. ⓪$EditBatStr    := TextStringAddress (Editbstr);
  2119. ⓪$NoPathsStr    := TextStringAddress (Npathstr);
  2120. ⓪$NoUnloadStr   := TextStringAddress (Nouldstr);
  2121. ⓪$NoExecStr     := TextStringAddress (Noexestr);
  2122. ⓪$RetStr        := TextStringAddress (Retstr);
  2123. ⓪$EdStr         := TextStringAddress (Edstr);
  2124. ⓪$WorkStr       := TextStringAddress (Workstr);
  2125. ⓪$CompStr       := TextStringAddress (Compstr);
  2126. ⓪$LinkStr       := TextStringAddress (Linkstr);
  2127. ⓪$InfStr        := TextStringAddress (Infstr);
  2128. ⓪$ContStr       := TextStringAddress (Contstr);
  2129. ⓪$MakeStr       := TextStringAddress (Makestr);
  2130. ⓪$
  2131. ⓪$changeWorkTitle := TextStringAddress (Chworkti);
  2132. ⓪$newWorkTitle    := TextStringAddress (Neworkti);
  2133. ⓪$editTitle       := TextStringAddress (Editti);
  2134. ⓪$compileTitle    := TextStringAddress (Compti);
  2135. ⓪$executeTitle    := TextStringAddress (Execti);
  2136. ⓪$compExecTitle   := TextStringAddress (Coexti);
  2137. ⓪$linkTitle       := TextStringAddress (Linkti);
  2138. ⓪$scanTitle       := TextStringAddress (Scanti);
  2139. ⓪$folderTitle     := TextStringAddress (Foldti);
  2140. ⓪$deleteTitle     := TextStringAddress (Deleti);
  2141. ⓪$
  2142. ⓪$
  2143. ⓪2(*  'msgBar'-Ausmaße der Größe
  2144. ⓪3*   des Ausgabegeräts anpassen
  2145. ⓪3*)
  2146. ⓪"
  2147. ⓪$devParm := DeviceParameter (dev);
  2148. ⓪$
  2149. ⓪$space.x := 0;
  2150. ⓪$space.y := 0;
  2151. ⓪$space.w := devParm^.rasterWidth + 1;
  2152. ⓪$space.h := deskSize.y-1;
  2153. ⓪$SetCurrObjTree (msgBar, FALSE);
  2154. ⓪$SetObjSpace (Root, space);
  2155. ⓪$SetObjSpace (Mbmsg, space);
  2156. ⓪$
  2157. ⓪$LinkTextString (Mbmsg, ADR (msgStr));
  2158. ⓪*
  2159. ⓪2(* Indizies ermitteln *)
  2160. ⓪2
  2161. ⓪$linkBoxIdx[1].check := Locheck1;
  2162. ⓪$linkBoxIdx[1].path  := Lofname1;
  2163. ⓪$linkBoxIdx[2].check := Locheck2;
  2164. ⓪$linkBoxIdx[2].path  := Lofname2;
  2165. ⓪$linkBoxIdx[3].check := Locheck3;
  2166. ⓪$linkBoxIdx[3].path  := Lofname3;
  2167. ⓪$linkBoxIdx[4].check := Locheck4;
  2168. ⓪$linkBoxIdx[4].path  := Lofname4;
  2169. ⓪$linkBoxIdx[5].check := Locheck5;
  2170. ⓪$linkBoxIdx[5].path  := Lofname5;
  2171. ⓪$linkBoxIdx[6].check := Locheck6;
  2172. ⓪$linkBoxIdx[6].path  := Lofname6;
  2173. ⓪$linkBoxIdx[7].check := Locheck7;
  2174. ⓪$linkBoxIdx[7].path  := Lofname7;
  2175. ⓪$linkBoxIdx[8].check := Locheck8;
  2176. ⓪$linkBoxIdx[8].path  := Lofname8;
  2177. ⓪$
  2178. ⓪$InitWorkFieldMenuIndizies;
  2179. ⓪$SetCurrObjTree (menu, FALSE);
  2180. ⓪$f := ObjectSpace (Wibox);
  2181. ⓪$WorkField.baseHeightOfWibox := f.h;
  2182. ⓪$f := ObjectSpace (Mwwork0);
  2183. ⓪$DEC (WorkField.baseHeightOfWibox, f.h * 10);
  2184. ⓪$
  2185. ⓪$SetTextString (shellBox, Version, ShellRevision);
  2186. ⓪$
  2187. ⓪$
  2188. ⓪2(*  Initalisiere 'Tools'-Indizies  *)
  2189. ⓪2
  2190. ⓪$ToolField[1].index := Mtool1;
  2191. ⓪$ToolField[2].index := Mtool2;
  2192. ⓪$ToolField[3].index := Mtool3;
  2193. ⓪$ToolField[4].index := Mtool4;
  2194. ⓪$ToolField[5].index := Mtool5;
  2195. ⓪$ToolField[6].index := Mtool6;
  2196. ⓪$ToolField[7].index := Mtool7;
  2197. ⓪$ToolField[8].index := Mtool8;
  2198. ⓪$ToolField[9].index := Mtool9;
  2199. ⓪$ToolField[10].index := Mtool10;
  2200. ⓪$
  2201. ⓪$TemporaryPath:= ShellPath;
  2202. ⓪$
  2203. ⓪$(*
  2204. ⓪%* Prüfen, ob ESC gedrückt wurde, weil dann beim Batch-Ausführen keine
  2205. ⓪%* Module geladen werden sollen.
  2206. ⓪%*)
  2207. ⓪$mayLoad:= TRUE;
  2208. ⓪$MultiEvent (EventSet {keyboard, timer}, 0, MButtonSet{}, MButtonSet{},
  2209. ⓪0lookForEntry, Rect (0,0,0,0), lookForEntry, Rect (0,0,0,0),
  2210. ⓪0eventmsg, 0, mouseloc, buttons, keystate, key, clicks, events);
  2211. ⓪$IF keyboard IN events THEN
  2212. ⓪&mayLoad:= key.ascii # 33C; (* ESC-Code *)
  2213. ⓪$END;
  2214. ⓪$LoadParameter (shellParm.parameterPath, mayLoad);
  2215. ⓪$
  2216. ⓪$ShowSS (TRUE);
  2217. ⓪$
  2218. ⓪$RETURN TRUE;
  2219. ⓪"END InitSS;
  2220. ⓪ 
  2221. ⓪ PROCEDURE HideSS (complete: BOOLEAN);
  2222. ⓪ 
  2223. ⓪"BEGIN
  2224. ⓪$IF complete THEN ClearDeskAndShowMsg END;
  2225. ⓪$ShowBee;
  2226. ⓪"END HideSS;
  2227. ⓪ 
  2228. ⓪ PROCEDURE ExitSS;
  2229. ⓪ 
  2230. ⓪"BEGIN
  2231. ⓪$msgStr := '';
  2232. ⓪$HideSS (TRUE);
  2233. ⓪$
  2234. ⓪$FreeResource;
  2235. ⓪$(* ExitGem (gemHdl); *)
  2236. ⓪"END ExitSS;
  2237. ⓪ 
  2238. ⓪*
  2239. ⓪0(*  Routinen zur Event-Verarbeitung  *)
  2240. ⓪0(*  ===============================  *)
  2241. ⓪ 
  2242. ⓪ (*  keyManager -- Bearbeitet alle keyboard events
  2243. ⓪!*)
  2244. ⓪ 
  2245. ⓪ (*$Z-*)
  2246. ⓪ PROCEDURE keyManager (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;
  2247. ⓪ (*$Z=*)
  2248. ⓪ 
  2249. ⓪"CONST   aCode   = BYTE (30);    (*  Buchstabentasten  *)
  2250. ⓪*cCode   = BYTE (46);
  2251. ⓪*eCode   = BYTE (18);
  2252. ⓪*fCode   = BYTE (33);
  2253. ⓪*iCode   = BYTE (23);
  2254. ⓪*lCode   = BYTE (38);
  2255. ⓪*nCode   = BYTE (49);
  2256. ⓪*mCode   = BYTE (50);
  2257. ⓪*oCode   = BYTE (24);
  2258. ⓪*pCode   = BYTE (25);
  2259. ⓪*qCode   = BYTE (16);
  2260. ⓪*rCode   = BYTE (19);
  2261. ⓪*sCode   = BYTE (31);
  2262. ⓪*uCode   = BYTE (22);
  2263. ⓪*xCode   = BYTE (45);
  2264. ⓪*
  2265. ⓪*code1A  = BYTE (2);     (*  Ziffern  *)
  2266. ⓪*code0A  = BYTE (11);
  2267. ⓪*code7N  = BYTE (103);
  2268. ⓪*code0N  = BYTE (112);
  2269. ⓪*
  2270. ⓪*plusCode= BYTE (27);    (*  <+>  *)
  2271. ⓪*
  2272. ⓪*clrHome = BYTE (71);    (*  <Clr>-Taste  *)
  2273. ⓪*delete  = BYTE (83);    (*  <Delete>-Taste  *)
  2274. ⓪*help    = BYTE (98);    (*  <Help>-Taste  *)
  2275. ⓪*escape  = BYTE (1);     (*  <Esc>-Taste  *)
  2276. ⓪*f1      = BYTE (59);    (*  <F1>  *)
  2277. ⓪*f10     = BYTE (68);    (*  <F10>  *)
  2278. ⓪*shiftF1 = BYTE (84);    (*  Shift + <F1>  *)
  2279. ⓪*shiftF10= BYTE (93);    (*  Shift + <F10>  *)
  2280. ⓪"
  2281. ⓪"VAR     buts    : MButtonSet;
  2282. ⓪*loc     : Point;
  2283. ⓪*
  2284. ⓪*success : BOOLEAN;
  2285. ⓪*msg     : String;
  2286. ⓪*
  2287. ⓪$PROCEDURE withoutCtrl () :BOOLEAN;
  2288. ⓪$BEGIN
  2289. ⓪&RETURN ~ (controlKey IN specials)
  2290. ⓪$END withoutCtrl;
  2291. ⓪"
  2292. ⓪"BEGIN
  2293. ⓪"
  2294. ⓪$CASE ch.scan OF
  2295. ⓪$
  2296. ⓪&(*  Commands  *)
  2297. ⓪&
  2298. ⓪&aCode    : actManager (Execute, specials, withoutCtrl (), FALSE, FALSE,
  2299. ⓪=FALSE)|
  2300. ⓪&cCode    : IF withAlt (specials) THEN doCompilerOptionBox
  2301. ⓪1ELSE 
  2302. ⓪3actManager (Compile, specials, withoutCtrl (), FALSE, FALSE,
  2303. ⓪?FALSE)
  2304. ⓪1END|
  2305. ⓪&eCode    : IF withAlt (specials) THEN doEditorParameterBox
  2306. ⓪1ELSE 
  2307. ⓪3actManager (Edit, specials, withoutCtrl (), FALSE, FALSE,
  2308. ⓪?FALSE)
  2309. ⓪1END|
  2310. ⓪&lCode    : IF withAlt (specials) THEN doLinkerOptionBox
  2311. ⓪1ELSE 
  2312. ⓪3actManager (Link, specials, withoutCtrl (), FALSE, FALSE,
  2313. ⓪?FALSE)
  2314. ⓪1END|
  2315. ⓪&sCode    : actManager (Scan, specials, withoutCtrl (), FALSE, FALSE,
  2316. ⓪=FALSE)|
  2317. ⓪&(*
  2318. ⓪&rCode    : actManager (Resident, specials, withoutCtrl (), FALSE, FALSE,
  2319. ⓪=FALSE)|
  2320. ⓪'*)
  2321. ⓪&plusCode : actManager (Compile, specials, withoutCtrl (), FALSE, TRUE,
  2322. ⓪=FALSE)|
  2323. ⓪&
  2324. ⓪&oCode    : makeFolder|
  2325. ⓪&
  2326. ⓪&pCode    : IF NOT withCtrl (specials)
  2327. ⓪1AND (WorkField.current # noCurrentWorkfile) THEN
  2328. ⓪3doChangeWork (WorkField.current);
  2329. ⓪1END|
  2330. ⓪&
  2331. ⓪&mCode    : Concat ('Making: ', MakeFileName, msg, voidO);
  2332. ⓪1truncCopyString (msg, msgStrLen, msgStr);
  2333. ⓪1action (doDftM, FALSE, FALSE)|
  2334. ⓪ 
  2335. ⓪&(*  Menu: Datei  *)
  2336. ⓪&
  2337. ⓪&nCode    : makeNewWorkfile|
  2338. ⓪&delete   : killWorkfile|
  2339. ⓪&qCode    : IF withCtrl (specials) THEN quitStatus := quickQuit
  2340. ⓪1ELSE quitStatus := quit END|
  2341. ⓪&
  2342. ⓪&(*  Menu: Parameter / Info *)
  2343. ⓪&
  2344. ⓪&xCode    : IF withCtrl (specials) THEN saveParameter
  2345. ⓪1ELSE doShellParameterBox END|
  2346. ⓪&uCode    : doInfoBox|
  2347. ⓪&help     : IF withShift (specials) THEN editDocu (specials)
  2348. ⓪1ELSE doHelpBox (helpFile) END|
  2349. ⓪&
  2350. ⓪&(*  Menu: Tools  *)
  2351. ⓪&
  2352. ⓪&f1..f10  : executeTool (ORD (ch.scan) - ORD (f1) + 1, specials)|
  2353. ⓪&shiftF1..shiftF10
  2354. ⓪/: INCL (specials, leftShiftKey);
  2355. ⓪1executeTool (ORD (ch.scan) - ORD (shiftF1) + 1, specials)|
  2356. ⓪&
  2357. ⓪&(*  work files  *)
  2358. ⓪&
  2359. ⓪&code1A..code0A,
  2360. ⓪&code7N..code0N
  2361. ⓪/: selectWorkfile (ORD (ch.ascii) - ORD ('0'))|
  2362. ⓪1
  2363. ⓪$ELSE RETURN TRUE END;
  2364. ⓪$
  2365. ⓪$RETURN FALSE;
  2366. ⓪"END keyManager;
  2367. ⓪ 
  2368. ⓪ (*  menuManager -- Bearbeitet alle message events, die durch Anklicken der
  2369. ⓪!*                 Menuzeile entstehen.
  2370. ⓪!*)
  2371. ⓪!
  2372. ⓪ (*$Z-*)
  2373. ⓪ PROCEDURE menuManager (title, item: CARDINAL): BOOLEAN;
  2374. ⓪ (*$Z=*)
  2375. ⓪"
  2376. ⓪"VAR     i       : CARDINAL;
  2377. ⓪*buts    : MButtonSet;
  2378. ⓪*specials: SpecialKeySet;
  2379. ⓪*loc     : Point;
  2380. ⓪*start   : Rectangle;
  2381. ⓪#
  2382. ⓪"BEGIN
  2383. ⓪$MouseKeyState (loc,buts,specials);
  2384. ⓪$CASE item OF
  2385. ⓪&
  2386. ⓪&(*  MShell  *)
  2387. ⓪%
  2388. ⓪&Dinfo     : animateMenuTitle (Mshell, start);
  2389. ⓪2DoSimpleBox (shellBox, start, voidC);
  2390. ⓪2deAnimateMenuTitle (Mshell)|
  2391. ⓪&
  2392. ⓪&(*  Datei  *)
  2393. ⓪&
  2394. ⓪&Mdfolder  : makeFolder|
  2395. ⓪&Mddelete  : deleteFile|
  2396. ⓪&Mdquit    : quitStatus := quit|
  2397. ⓪&
  2398. ⓪&(*  Bearbeiten  *)
  2399. ⓪&
  2400. ⓪&Mdeditwo  : actManager (Edit, specials, TRUE, FALSE, FALSE, FALSE)|
  2401. ⓪&Mdcompwo  : actManager (Compile, specials, TRUE, FALSE, FALSE, FALSE)|
  2402. ⓪&Mdexecwo  : actManager (Execute, specials, TRUE, FALSE, FALSE, FALSE)|
  2403. ⓪&Mdlinkwo  : actManager (Link, specials, TRUE, FALSE, FALSE, FALSE)|
  2404. ⓪&Mdscanwo  : actManager (Scan, specials, TRUE, FALSE, FALSE, FALSE)|
  2405. ⓪&Mdeditot  : actManager (Edit, specials, FALSE, FALSE, FALSE, FALSE)|
  2406. ⓪&Mdcompot  : actManager (Compile, specials, FALSE, FALSE, FALSE, FALSE)|
  2407. ⓪&Mdexecot  : actManager (Execute, specials, FALSE, FALSE, FALSE, FALSE)|
  2408. ⓪&Mdlinkot  : actManager (Link, specials, FALSE, FALSE, FALSE, FALSE)|
  2409. ⓪&Mdscanot  : actManager (Scan, specials, FALSE, FALSE, FALSE, FALSE)|
  2410. ⓪&
  2411. ⓪&(*  Arbeitsdatei  *)
  2412. ⓪&
  2413. ⓪&Mwnew     : makeNewWorkfile|
  2414. ⓪&Mwdelete  : killWorkfile|
  2415. ⓪&Mwchange  : IF WorkField.current # noCurrentWorkfile THEN
  2416. ⓪4doChangeWork (WorkField.current);
  2417. ⓪2END|
  2418. ⓪&Mwwork0   : selectWorkfile (0)|
  2419. ⓪&Mwwork1   : selectWorkfile (1)|
  2420. ⓪&Mwwork2   : selectWorkfile (2)|
  2421. ⓪&Mwwork3   : selectWorkfile (3)|
  2422. ⓪&Mwwork4   : selectWorkfile (4)|
  2423. ⓪&Mwwork5   : selectWorkfile (5)|
  2424. ⓪&Mwwork6   : selectWorkfile (6)|
  2425. ⓪&Mwwork7   : selectWorkfile (7)|
  2426. ⓪&Mwwork8   : selectWorkfile (8)|
  2427. ⓪&Mwwork9   : selectWorkfile (9)|
  2428. ⓪&
  2429. ⓪&(*  Parameter / Info *)
  2430. ⓪&
  2431. ⓪&Mpshell   : doShellParameterBox|
  2432. ⓪&Mpeditor  : doEditorParameterBox|
  2433. ⓪&Mpcomp    : doCompilerOptionBox|
  2434. ⓪&Mplink    : doLinkerOptionBox|
  2435. ⓪&Mpsave    : saveParameter|
  2436. ⓪&Mienv     : doInfoBox|
  2437. ⓪&Mihelp    : doHelpBox (helpFile)|
  2438. ⓪&Midocu    : editDocu (specials)|
  2439. ⓪&
  2440. ⓪$ELSE
  2441. ⓪&
  2442. ⓪&(*  Tools  *)
  2443. ⓪$
  2444. ⓪&FOR i := 1 TO MaxTool DO
  2445. ⓪(IF item = ToolField[i].index THEN executeTool (i, specials) END
  2446. ⓪&END;
  2447. ⓪&
  2448. ⓪$END;
  2449. ⓪$
  2450. ⓪$NormalTitle (menu,title, TRUE);
  2451. ⓪$
  2452. ⓪$RETURN FALSE;
  2453. ⓪"END menuManager;
  2454. ⓪ 
  2455. ⓪ PROCEDURE TalkWithUser;
  2456. ⓪ 
  2457. ⓪"VAR     worker  : ARRAY [1..2] OF EventProc;
  2458. ⓪*
  2459. ⓪*success : BOOLEAN;
  2460. ⓪*
  2461. ⓪*firstA3,
  2462. ⓪*newA3   : LONGCARD;
  2463. ⓪*
  2464. ⓪*button  : CARDINAL;
  2465. ⓪"
  2466. ⓪"BEGIN
  2467. ⓪$enableAndDisableMenuItems;
  2468. ⓪"
  2469. ⓪$worker[1].event := keyboard;
  2470. ⓪$worker[1].keyHdler := keyManager;
  2471. ⓪$worker[2].event := message;
  2472. ⓪$worker[2].msgType := menuSelected;
  2473. ⓪$worker[2].menuHdler := menuManager;
  2474. ⓪ 
  2475. ⓪$STORE (11, firstA3);
  2476. ⓪"
  2477. ⓪$REPEAT
  2478. ⓪"
  2479. ⓪&HandleEvents (0, MButtonSet{}, MButtonSet{},
  2480. ⓪4lookForEntry, Rect (0,0,0,0),
  2481. ⓪4lookForEntry, Rect (0,0,0,0),
  2482. ⓪40L,
  2483. ⓪4worker, 0);
  2484. ⓪"
  2485. ⓪&STORE (11, newA3);
  2486. ⓪&IF newA3 # firstA3 THEN
  2487. ⓪(LOAD (firstA3, 11);
  2488. ⓪(FormAlert (1, '[1][Heap fault][ OK ]', voidC);
  2489. ⓪&END;
  2490. ⓪&
  2491. ⓪&enableAndDisableMenuItems;
  2492. ⓪"
  2493. ⓪&currFn := '';         (* Damit 'lastFn' zum Zuge kommen kann *)
  2494. ⓪&
  2495. ⓪&(*  handle a quit shell request
  2496. ⓪'*)
  2497. ⓪&IF quitStatus = quit THEN
  2498. ⓪(FormAlert (1, exitShellAlt^, button);
  2499. ⓪(IF button = 3 THEN quitStatus := noQuit
  2500. ⓪(ELSIF button = 1 THEN SaveParameter END;
  2501. ⓪&END;
  2502. ⓪$
  2503. ⓪$UNTIL quitStatus # noQuit;
  2504. ⓪"END TalkWithUser;
  2505. ⓪ 
  2506. ⓪ (*$Z-*) 
  2507. ⓪ PROCEDURE hdlTrap5 (VAR desc: ExcDesc): BOOLEAN;
  2508. ⓪ (*$Z=*)
  2509. ⓪"BEGIN
  2510. ⓪$doAlert (debugAlt);   (*  Fehlermeldung  *)
  2511. ⓪$TermProcess (0);      (*  und ab damit  *)
  2512. ⓪$RETURN FALSE          (* Nur um des Compilers Willen  *)
  2513. ⓪"END hdlTrap5;
  2514. ⓪ 
  2515. ⓪ 
  2516. ⓪ VAR     i       : CARDINAL;
  2517. ⓪(hdl     : ADDRESS;
  2518. ⓪(wsp     : MemArea;
  2519. ⓪ 
  2520. ⓪ BEGIN (* ShellShell *)
  2521. ⓪ 
  2522. ⓪"(*  Vom Modula-System und der Shell benutzte Suffices:
  2523. ⓪#*)
  2524. ⓪"suf[prg] := 'PRG';
  2525. ⓪"suf[app] := 'APP';
  2526. ⓪"suf[tos] := 'TOS';
  2527. ⓪"suf[ttp] := 'TTP';
  2528. ⓪"suf[m2p] := 'M2P';
  2529. ⓪"suf[m2b] := 'M2B';
  2530. ⓪"suf[m2m] := 'M2M';
  2531. ⓪"suf[m2d] := 'M2D';
  2532. ⓪"(*
  2533. ⓪#* Die folgenden Endungen können verändert werden:
  2534. ⓪#* (Shell dann neu linken und alle Dateien mit den neuen Endungen
  2535. ⓪#* versehen - auch diejenigen in der Library "MM2DEF.M2L"!)
  2536. ⓪#*)
  2537. ⓪"suf[mod] := 'MOD';   (* Object-Files, GEM-Application *)
  2538. ⓪"suf[mos] := 'MOS';   (* Object-Files, TOS-Application *)
  2539. ⓪"suf[mtp] := 'MTP';   (* Object-Files, TTP-Application *)
  2540. ⓪"suf[imp] := 'IMP';   (* Object-Files bei Implementationsmodulen *)
  2541. ⓪"suf[def] := 'DEF';   (* Symbol-Files (übersetzte Definitionsmodule *)
  2542. ⓪"DefSrcSfx:= 'D';     (* ModRef: Definitions-Texte *)
  2543. ⓪"ImpSrcSfx:= 'I';     (* ModRef: Implementations-Texte *)
  2544. ⓪"ModSrcSfx:= 'M';     (* ModRef: Hauptmodul-Texte *)
  2545. ⓪ 
  2546. ⓪"(* Für Compiler: Suffices für erzeugte Dateien *)
  2547. ⓪"DefSfx:= suf[def];   (* Extension f. Symboldatei-Codes *)
  2548. ⓪"ImpSfx:= suf[imp];   (* Extension f. Implementations-Codes *)
  2549. ⓪"ModSfx:= suf[mod];   (* Extension f. Hauptmodul-Codes *)
  2550. ⓪ 
  2551. ⓪"(* Suffices für Loader (CallModule, LoadModule) *)
  2552. ⓪"MOSConfig.DftSfx:= suf[mod]; (* Default-Endung bei 'CallModule' *)
  2553. ⓪"MOSConfig.ImpSfx:= suf[imp]; (* Endung der importierten Module *)
  2554. ⓪ 
  2555. ⓪"(*  some box info vars
  2556. ⓪#*)
  2557. ⓪"LastCodeName := '';
  2558. ⓪"LastCodeSize := 0L;
  2559. ⓪ 
  2560. ⓪"(*  default configuration
  2561. ⓪#*)
  2562. ⓪ 
  2563. ⓪"MakeFileName := '';
  2564. ⓪ 
  2565. ⓪"WITH shellParm DO
  2566. ⓪$breakActive := TRUE;
  2567. ⓪$batchPath := batchFile;
  2568. ⓪$
  2569. ⓪$ShellRead (ShellName, args); (* Liest Pfad/Name der Shell und Argumentzeile *)
  2570. ⓪$IF args [0] # 0C THEN
  2571. ⓪&(* M2P-Dateiname wurde in Argumentzeile übergeben *)
  2572. ⓪&Assign (args, parameterPath, voidO)
  2573. ⓪$ELSE
  2574. ⓪&(* M2P-Dateiname wird aus Shell-Pfad u. "MM2SHELL.M2P" zusammengesetzt *)
  2575. ⓪&ConcatPath (ShellName, parameterFile, parameterPath)
  2576. ⓪$END;
  2577. ⓪$ConcatName (parameterPath, suf[m2p], parameterPath);
  2578. ⓪$MakeFullPath (parameterPath, voidI);
  2579. ⓪$
  2580. ⓪$waitOnReturn := FALSE;
  2581. ⓪"END;
  2582. ⓪"
  2583. ⓪"(*  no work file.
  2584. ⓪#*)
  2585. ⓪"FOR i := 0 TO maxWorkFiles - 1 DO WorkField.elems[i].used := FALSE END;
  2586. ⓪"WorkField.noUsed := 0;
  2587. ⓪"WorkField.current := noCurrentWorkfile;
  2588. ⓪"
  2589. ⓪"WITH EditorParm DO
  2590. ⓪$name:= 'GME';
  2591. ⓪$searchSources := FALSE;
  2592. ⓪$waitOnError := FALSE;
  2593. ⓪$tempShellFile := FALSE;
  2594. ⓪$tempShellName := '';
  2595. ⓪$tempEditorFile := FALSE;
  2596. ⓪$tempEditorName := '';
  2597. ⓪$passArgument := TRUE;
  2598. ⓪$passName := TRUE;
  2599. ⓪$passErrorText := TRUE;
  2600. ⓪$passErrorPos := TRUE;
  2601. ⓪"END;
  2602. ⓪"
  2603. ⓪"ErrListFile := 'MODULA.ERR';
  2604. ⓪"MainOutputPath := '';
  2605. ⓪"WITH CompilerParm DO          (*  Compiler-Parameter:     *)
  2606. ⓪$name:= 'MM2Comp';
  2607. ⓪$shortMsgs := FALSE;         (*  - keine Kurzausgaben    *)
  2608. ⓪$protocol := FALSE;          (*  - kein Protokoll        *)
  2609. ⓪$protWidth := stdProtWidth;
  2610. ⓪$protName := '';
  2611. ⓪"END;
  2612. ⓪"
  2613. ⓪"WITH LinkerParm DO
  2614. ⓪$name := 'MM2Link';
  2615. ⓪$FOR i := MIN (LLRange) TO MAX (LLRange) DO
  2616. ⓪&linkList[i].valid := FALSE;
  2617. ⓪&linkList[i].name := '';
  2618. ⓪$END;
  2619. ⓪$optimize := fullOptimize; (*  - Vollständige Optimierung  *)
  2620. ⓪$linkStackSize := 0;
  2621. ⓪$maxLinkMod := 100;
  2622. ⓪$fastLoad := TRUE;
  2623. ⓪$fastCode := TRUE;
  2624. ⓪$fastMemory:= TRUE;
  2625. ⓪$symbolFile:= FALSE;
  2626. ⓪$symbolArgs:= '';  (* optional: Argumente f. 'MM2LnkIO.OutputSymbols' *)
  2627. ⓪$outputName:= '';  (* optional: Name d. Ausgabedatei *)
  2628. ⓪"END;
  2629. ⓪"
  2630. ⓪"FOR i := 1 TO MaxTool DO ToolField[i].used := FALSE END;  (*  Keine Tools  *)
  2631. ⓪"
  2632. ⓪"msgStr := '';
  2633. ⓪"
  2634. ⓪"(* TRAP #5 belegen, um Fehlermeldung auszugeben, wenn in einem Modul $D+
  2635. ⓪#* verwendet wird, ohne 'Debug'-Modul importiert zu haben *)
  2636. ⓪"wsp.bottom := ADR (ExceptsStack);
  2637. ⓪"wsp.length := SIZE (ExceptsStack);
  2638. ⓪"InstallPreExc (ExcSet{TRAP5}, hdlTrap5, TRUE, wsp, hdl);
  2639. ⓪ 
  2640. ⓪"quitStatus := noQuit;
  2641. ⓪ 
  2642. ⓪ END ShellShell;
  2643. ⓪ 
  2644. ⓪ 
  2645. ⓪((***************************)
  2646. ⓪((* Hier endet 'ShellShell' *)
  2647. ⓪((***************************)
  2648. ⓪ 
  2649. ⓪ 
  2650. ⓪ CONST   mspFileMagic    = 10071898L + 02700000000L;    (*  ab 20: TinyShell  *)
  2651. ⓪(escKey          = 33C;
  2652. ⓪ 
  2653. ⓪ TYPE    PtrStr = POINTER TO String;
  2654. ⓪(AutoCmd = (noCmd, scan, edit, compile, execute, comp_exec, exec_src,
  2655. ⓪3make_exec, dftMake, dftMake_exec, contMake);
  2656. ⓪ 
  2657. ⓪ VAR  ready    : BOOLEAN;
  2658. ⓪%dummy    : INTEGER;
  2659. ⓪%handle   : INTEGER;
  2660. ⓪%strVal   : BOOLEAN;
  2661. ⓪%buttonNum: CARDINAL;
  2662. ⓪%editorsMakeCmd,
  2663. ⓪%autoCmd    : AutoCmd;
  2664. ⓪%shellStart,
  2665. ⓪%makeActive : BOOLEAN;
  2666. ⓪%callRes    : LoaderResults;
  2667. ⓪%callMsg    : String;
  2668. ⓪%exitCode   : INTEGER;
  2669. ⓪%voidO      : BOOLEAN;
  2670. ⓪%voidI      : INTEGER;
  2671. ⓪%voidC      : CARDINAL;
  2672. ⓪ 
  2673. ⓪%withPost1, withPost2: BOOLEAN;
  2674. ⓪%postAmble1, postAmble2, postArgs1, postArgs2: String;
  2675. ⓪ 
  2676. ⓪ 
  2677. ⓪ PROCEDURE FileAlert (errNo: INTEGER);
  2678. ⓪ 
  2679. ⓪"VAR     msg     : ARRAY[0..50] OF CHAR;
  2680. ⓪ 
  2681. ⓪"BEGIN
  2682. ⓪$IF (errNo < fOK) AND (errNo # fDriveNotReady) AND (errNo # fWriteProtected)
  2683. ⓪$THEN
  2684. ⓪&GetStateMsg (errNo, msg);
  2685. ⓪&Concat ('[1][', msg, msg, voidO);
  2686. ⓪&Append ('][  OK  ]', msg, voidO);
  2687. ⓪&FormAlert (1, msg, voidC);
  2688. ⓪$END;
  2689. ⓪"END FileAlert;
  2690. ⓪ 
  2691. ⓪ PROCEDURE SaveParameter;
  2692. ⓪ 
  2693. ⓪"VAR   f      : File;
  2694. ⓪"
  2695. ⓪"PROCEDURE ioErr (): BOOLEAN;
  2696. ⓪"
  2697. ⓪$VAR ioRes: INTEGER;
  2698. ⓪"
  2699. ⓪$BEGIN
  2700. ⓪&ioRes := State (f);
  2701. ⓪&IF ioRes < fOK THEN
  2702. ⓪(ResetState (f);
  2703. ⓪(FileAlert (ioRes);
  2704. ⓪(Remove (f);
  2705. ⓪(ShowArrow;
  2706. ⓪&END;
  2707. ⓪&RETURN ioRes < fOK
  2708. ⓪$END ioErr;
  2709. ⓪$
  2710. ⓪"PROCEDURE wBlock (VAR data: ARRAY OF BYTE): BOOLEAN;
  2711. ⓪"
  2712. ⓪$BEGIN
  2713. ⓪&WriteBlock (f, data);
  2714. ⓪&RETURN ~ ioErr ()
  2715. ⓪$END wBlock;
  2716. ⓪"
  2717. ⓪"VAR   magic: LONGCARD;
  2718. ⓪(ok: BOOLEAN;
  2719. ⓪"BEGIN
  2720. ⓪$ShowBee;
  2721. ⓪$
  2722. ⓪$Create (f, HomeReplaced (shellParm.parameterPath), writeOnly, replaceOld);
  2723. ⓪$IF State (f) # fOK THEN FileAlert (State (f)); RETURN END;
  2724. ⓪$
  2725. ⓪$magic := mspFileMagic;
  2726. ⓪$LOOP (* Ist keine echte Schleife - lediglich f. einfacheres EXIT *)
  2727. ⓪&ok:= FALSE;
  2728. ⓪&IF ~ wBlock (magic) THEN EXIT END;
  2729. ⓪&IF ~ wBlock (shellParm) THEN EXIT END;
  2730. ⓪&IF ~ wBlock (WorkField) THEN EXIT END;
  2731. ⓪&IF ~ wBlock (lastFn) THEN EXIT END;
  2732. ⓪&IF ~ wBlock (CodeName) THEN EXIT END;
  2733. ⓪&IF ~ wBlock (EditorParm) THEN EXIT END;
  2734. ⓪&IF ~ wBlock (CompilerParm) THEN EXIT END;
  2735. ⓪&IF ~ wBlock (LinkerParm) THEN EXIT END;
  2736. ⓪&IF ~ wBlock (DefaultStackSize) THEN EXIT END;
  2737. ⓪&IF ~ wBlock (TemporaryPath) THEN EXIT END;
  2738. ⓪&IF ~ wBlock (MakeFileName) THEN EXIT END;
  2739. ⓪&IF ~ wBlock (DefLibName) THEN EXIT END;
  2740. ⓪&IF ~ wBlock (ErrListFile) THEN EXIT END;
  2741. ⓪&IF ~ wBlock (MainOutputPath) THEN EXIT END;
  2742. ⓪&IF ~ wBlock (CompilerArgs) THEN EXIT END;
  2743. ⓪&ok:= TRUE;
  2744. ⓪&EXIT
  2745. ⓪$END;
  2746. ⓪$IF NOT ok THEN RETURN END;
  2747. ⓪$
  2748. ⓪$Close (f);
  2749. ⓪$
  2750. ⓪$ShowArrow;
  2751. ⓪"END SaveParameter;
  2752. ⓪ 
  2753. ⓪ PROCEDURE LoadParameter (REF name: ARRAY OF CHAR; loadInBatch: BOOLEAN);
  2754. ⓪ 
  2755. ⓪"VAR   f      : File;
  2756. ⓪(fname  : FileStr;
  2757. ⓪ 
  2758. ⓪"PROCEDURE ioErr (): BOOLEAN;
  2759. ⓪"
  2760. ⓪$VAR ioRes: INTEGER;
  2761. ⓪"
  2762. ⓪$BEGIN
  2763. ⓪&ioRes := State (f);
  2764. ⓪&IF ioRes < fOK THEN
  2765. ⓪(ResetState (f);
  2766. ⓪(FileAlert (ioRes);
  2767. ⓪(Close (f);
  2768. ⓪(ShowArrow;
  2769. ⓪&END;
  2770. ⓪&RETURN ioRes < fOK
  2771. ⓪$END ioErr;
  2772. ⓪$
  2773. ⓪"PROCEDURE rBlock (VAR data: ARRAY OF BYTE): BOOLEAN;
  2774. ⓪"
  2775. ⓪$BEGIN
  2776. ⓪&ReadBlock (f, data);
  2777. ⓪&RETURN ~ ioErr ()
  2778. ⓪$END rBlock;
  2779. ⓪ 
  2780. ⓪"VAR   magic, n: LONGCARD;
  2781. ⓪(ch: CHAR;
  2782. ⓪(ok: BOOLEAN;
  2783. ⓪"
  2784. ⓪"BEGIN
  2785. ⓪$ShowBee;
  2786. ⓪$
  2787. ⓪$Assign (name, fname, voidO);
  2788. ⓪$ReplaceHome (fname);
  2789. ⓪$MakeFullPath (fname, voidI);
  2790. ⓪$Open (f, fname, readOnly);
  2791. ⓪$IF State (f) # fOK THEN FormAlert (1, noParmAlt^, voidC); RETURN END;
  2792. ⓪$
  2793. ⓪$IF ~ rBlock (magic) THEN RETURN END;
  2794. ⓪$IF magic = mspFileMagic THEN
  2795. ⓪&LOOP (* Ist keine echte Schleife - lediglich f. einfacheres EXIT *)
  2796. ⓪(ok:= FALSE;
  2797. ⓪(IF ~ rBlock (shellParm) THEN EXIT END;
  2798. ⓪(IF ~ rBlock (WorkField) THEN EXIT END;
  2799. ⓪(IF ~ rBlock (lastFn) THEN EXIT END;
  2800. ⓪(IF ~ rBlock (CodeName) THEN EXIT END;
  2801. ⓪(IF ~ rBlock (EditorParm) THEN EXIT END;
  2802. ⓪(IF ~ rBlock (CompilerParm) THEN EXIT END;
  2803. ⓪(IF ~ rBlock (LinkerParm) THEN EXIT END;
  2804. ⓪(IF ~ rBlock (DefaultStackSize) THEN EXIT END;
  2805. ⓪(IF ~ rBlock (TemporaryPath) THEN EXIT END;
  2806. ⓪(IF ~ rBlock (MakeFileName) THEN EXIT END;
  2807. ⓪(IF ~ rBlock (DefLibName) THEN EXIT END;
  2808. ⓪(IF ~ rBlock (ErrListFile) THEN EXIT END;
  2809. ⓪(IF ~ rBlock (MainOutputPath) THEN EXIT END;
  2810. ⓪(IF ~ rBlock (CompilerArgs) THEN EXIT END;
  2811. ⓪(ok:= TRUE;
  2812. ⓪(EXIT
  2813. ⓪&END;
  2814. ⓪&IF NOT ok THEN RETURN END;
  2815. ⓪ 
  2816. ⓪&Assign (fname, shellParm.parameterPath, voidO);
  2817. ⓪ 
  2818. ⓪$ELSE
  2819. ⓪&FormAlert (1, noParmAlt^, voidC)
  2820. ⓪$END;
  2821. ⓪$Close (f);
  2822. ⓪$
  2823. ⓪$InitWorkFieldMenuIndizies;
  2824. ⓪$
  2825. ⓪$(*  If a batch file is specified, execute it. *)
  2826. ⓪$IF NOT Empty (shellParm.batchPath) THEN
  2827. ⓪&ExecuteBatch (shellParm.batchPath, loadInBatch)
  2828. ⓪$END;
  2829. ⓪$
  2830. ⓪$ShowArrow;
  2831. ⓪"END LoadParameter;
  2832. ⓪ 
  2833. ⓪ 
  2834. ⓪ PROCEDURE PrepareScan;
  2835. ⓪ 
  2836. ⓪"BEGIN
  2837. ⓪$ScanAddr := CallingChain [ScanIndex].relAddr;
  2838. ⓪$ScanOpts := CallingChain [ScanIndex].codeOpts;
  2839. ⓪$Assign (CallingChain [ScanIndex].sourceName, TextName, voidO);
  2840. ⓪"END PrepareScan;
  2841. ⓪ 
  2842. ⓪ PROCEDURE readWorkNames;
  2843. ⓪ 
  2844. ⓪"BEGIN
  2845. ⓪$WITH WorkField DO
  2846. ⓪&IF current >= 0 THEN
  2847. ⓪(workFName := elems[current].sourceName;
  2848. ⓪(workCName := elems[current].codeName;
  2849. ⓪&ELSE
  2850. ⓪(workFName := ''; workCName := '';
  2851. ⓪&END;
  2852. ⓪$END;
  2853. ⓪"END readWorkNames;
  2854. ⓪ 
  2855. ⓪ PROCEDURE writeWorkName (REF source, code: ARRAY OF CHAR);
  2856. ⓪"VAR i : INTEGER;
  2857. ⓪"BEGIN (* richtige Arbeitsdatei suchen und Code speichern *)
  2858. ⓪$WITH WorkField DO
  2859. ⓪&IF current >= 0 THEN
  2860. ⓪(FOR i:= 0 TO maxWorkFiles-1 DO
  2861. ⓪*IF elems[i].used & StrEqual (source, elems[i].sourceName) THEN
  2862. ⓪,Assign (code, elems[i].codeName, voidO);
  2863. ⓪,RETURN
  2864. ⓪*END
  2865. ⓪(END
  2866. ⓪&END;
  2867. ⓪$END;
  2868. ⓪"END writeWorkName;
  2869. ⓪ 
  2870. ⓪ PROCEDURE Bconout ( c: CHAR );
  2871. ⓪"(*$L-*)
  2872. ⓪"BEGIN
  2873. ⓪$ASSEMBLER
  2874. ⓪(SUBQ.L  #1,A3
  2875. ⓪(MOVEQ   #0,D0
  2876. ⓪(MOVE.B  -(A3),D0
  2877. ⓪(MOVE    D0,-(A7)
  2878. ⓪(MOVE    #2,-(A7)
  2879. ⓪(MOVE    #3,-(A7)
  2880. ⓪(TRAP    #13
  2881. ⓪(ADDQ.L  #6,A7
  2882. ⓪$END
  2883. ⓪"END Bconout;
  2884. ⓪"(*$L=*)
  2885. ⓪ 
  2886. ⓪ (*$Z-*)
  2887. ⓪ PROCEDURE Bconin (): CHAR;
  2888. ⓪ (*$Z=*)
  2889. ⓪"(*$L-*)
  2890. ⓪"BEGIN
  2891. ⓪$ASSEMBLER
  2892. ⓪(MOVE    #2,-(A7)
  2893. ⓪(MOVE    #2,-(A7)
  2894. ⓪(TRAP    #13
  2895. ⓪(ADDQ.L  #4,A7
  2896. ⓪(MOVE.B  D0,(A3)+
  2897. ⓪(CLR.B   (A3)+
  2898. ⓪$END
  2899. ⓪"END Bconin;
  2900. ⓪"(*$L=*)
  2901. ⓪ 
  2902. ⓪ (*$Z-*)
  2903. ⓪ PROCEDURE Bconstat (): BOOLEAN;
  2904. ⓪ (*$Z=*)
  2905. ⓪"(*$L-*)
  2906. ⓪"BEGIN
  2907. ⓪$ASSEMBLER
  2908. ⓪(MOVE    #2,-(A7)
  2909. ⓪(MOVE    #1,-(A7)
  2910. ⓪(TRAP    #13
  2911. ⓪(ADDQ.L  #4,A7
  2912. ⓪(TST     D0
  2913. ⓪(SNE     D0
  2914. ⓪(ANDI    #1,D0
  2915. ⓪(MOVE.W  D0,(A3)+
  2916. ⓪$END
  2917. ⓪"END Bconstat;
  2918. ⓪"(*$L=*)
  2919. ⓪ 
  2920. ⓪ PROCEDURE clrscr;
  2921. ⓪"BEGIN
  2922. ⓪$Bconout (33C); Bconout ('E');
  2923. ⓪"END clrscr;
  2924. ⓪ 
  2925. ⓪ PROCEDURE curon;
  2926. ⓪"BEGIN
  2927. ⓪$Bconout (33C); Bconout ('e');
  2928. ⓪"END curon;
  2929. ⓪ 
  2930. ⓪ PROCEDURE curoff;
  2931. ⓪"BEGIN
  2932. ⓪$Bconout (15C); Bconout (33C); Bconout ('f');
  2933. ⓪"END curoff;
  2934. ⓪ 
  2935. ⓪ PROCEDURE bing;
  2936. ⓪"BEGIN
  2937. ⓪$Bconout (7C);
  2938. ⓪"END bing;
  2939. ⓪ 
  2940. ⓪ 
  2941. ⓪ PROCEDURE alert ( REF s1,s2,s3: ARRAY OF CHAR );
  2942. ⓪"VAR msg: ARRAY [0..269] OF CHAR;
  2943. ⓪"BEGIN
  2944. ⓪$Assign (s1, msg, voidO);
  2945. ⓪$WrapAlert (msg, 0);
  2946. ⓪$IF s2[0] # 0C THEN
  2947. ⓪&Append ('|', msg, strVal);
  2948. ⓪&Append (s2, msg, voidO);
  2949. ⓪&WrapAlert (msg, 0);
  2950. ⓪$END;
  2951. ⓪$Insert ('[0][',0,msg,strVal);
  2952. ⓪$Append ('][]',msg,strVal);
  2953. ⓪$Insert (s3,CARDINAL(Length(msg)-1),msg, voidO);
  2954. ⓪$FormAlert (1, msg,buttonNum);
  2955. ⓪"END alert;
  2956. ⓪"
  2957. ⓪ PROCEDURE load;
  2958. ⓪ 
  2959. ⓪"VAR     r       : LoaderResults;
  2960. ⓪*msg     : ARRAY [0..79] OF CHAR;
  2961. ⓪*name    : FileStr;
  2962. ⓪"
  2963. ⓪"BEGIN
  2964. ⓪$IF Empty (currFn) THEN name := CodeName ELSE name := currFn END;
  2965. ⓪$TellLoading (newTellValue, name);
  2966. ⓪$LoadModule (name, StdPaths, name, msg, r);
  2967. ⓪$IF r # noError THEN alert (conc (name, NoLoadStr^), msg, OkStr^) END;
  2968. ⓪"END load;
  2969. ⓪ 
  2970. ⓪ PROCEDURE unload;
  2971. ⓪ 
  2972. ⓪"VAR     r       : LoaderResults;
  2973. ⓪*name    : FileStr;
  2974. ⓪"
  2975. ⓪"BEGIN
  2976. ⓪$IF Empty (currFn) THEN name := CodeName ELSE name := currFn END;
  2977. ⓪$UnLoadModule (name, r);
  2978. ⓪$IF r # noError THEN alert (conc (name, NoUnloadStr^), '', OkStr^) END;
  2979. ⓪"END unload;
  2980. ⓪ 
  2981. ⓪ PROCEDURE closeAllWindows;
  2982. ⓪"VAR w: CARDINAL;
  2983. ⓪"BEGIN
  2984. ⓪$AESWindows.UpdateWindow (TRUE);
  2985. ⓪$LOOP
  2986. ⓪&w:= AESWindows.TopWindow ();
  2987. ⓪&IF w = 0 THEN EXIT END;
  2988. ⓪&AESWindows.CloseWindow (w);
  2989. ⓪&AESWindows.DeleteWindow (w);
  2990. ⓪$END;
  2991. ⓪$IF (GEMEnv.GEMVersion() >= $140) THEN
  2992. ⓪&(* UpdateWindow(FALSE) hier unnötig - siehe ST-Magazin 3/91 Seite 92. *)
  2993. ⓪&AESWindows.ResetWindows ();
  2994. ⓪$ELSE
  2995. ⓪&AESWindows.UpdateWindow (FALSE);
  2996. ⓪$END;
  2997. ⓪"END closeAllWindows;
  2998. ⓪ 
  2999. ⓪ VAR callSwitchedToTextMode: BOOLEAN;
  3000. ⓪ 
  3001. ⓪ PROCEDURE call ( VAR modname: ARRAY OF CHAR; args: ARRAY OF CHAR;
  3002. ⓪1stackSize: LONGCARD; interactive, checkError, tool:BOOLEAN );
  3003. ⓪ 
  3004. ⓪"TYPE SufSet = SET OF MySuf;
  3005. ⓪"
  3006. ⓪"VAR sufstr            : ARRAY[0..2] OF CHAR;
  3007. ⓪&dummy             : ARRAY[0..12] OF CHAR;
  3008. ⓪&name, path,
  3009. ⓪&oldPath           : PathStr;
  3010. ⓪&getparm           : BOOLEAN;
  3011. ⓪&prgType           : AESMisc.ProgramType;
  3012. ⓪&sufcnt, suffix    : MySuf;
  3013. ⓪&res               : INTEGER;
  3014. ⓪&dummyChar         : CHAR;
  3015. ⓪&hdl               : ADDRESS;
  3016. ⓪&prevStackSize     : LONGCARD;
  3017. ⓪ 
  3018. ⓪"BEGIN
  3019. ⓪$Assign (modname, name, voidO);
  3020. ⓪$Upper (name);
  3021. ⓪ 
  3022. ⓪$SplitPath (name, path, dummy);
  3023. ⓪$SplitName (dummy,dummy,sufstr);
  3024. ⓪$suffix:= mod;
  3025. ⓪$IF sufstr[0] = 0C THEN
  3026. ⓪&ConcatName (name, suf[mod], name)
  3027. ⓪$ELSE
  3028. ⓪&FOR sufcnt:= MIN (MySuf) TO MAX (MySuf) DO
  3029. ⓪(IF StrEqual (sufstr,suf[sufcnt]) THEN
  3030. ⓪*suffix := sufcnt;
  3031. ⓪(END
  3032. ⓪&END;
  3033. ⓪$END;
  3034. ⓪$prgType:= AESMisc.graphicPrgm;
  3035. ⓪$getparm:= FALSE;
  3036. ⓪$IF suffix IN SufSet {ttp,mtp} THEN getparm:= interactive END;
  3037. ⓪$IF suffix IN SufSet {ttp,mtp,tos,mos} THEN prgType:= AESMisc.textPrgm END;
  3038. ⓪ 
  3039. ⓪$IF getparm THEN
  3040. ⓪&RequestArg (args);
  3041. ⓪$END;
  3042. ⓪ 
  3043. ⓪$GetDefaultPath (oldPath);
  3044. ⓪$IF ~noDirChange THEN
  3045. ⓪&IF (path[0] = 0C) AND NOT tool THEN
  3046. ⓪((* Ist kein Pfad angegeben, bleibt bei Tools und
  3047. ⓪)* Systemprgs der akt. Pfad erhalten
  3048. ⓪)*)
  3049. ⓪(SearchFile (name, StdPaths, fromStart, voidO, name);
  3050. ⓪(SplitPath (name, path, dummy);
  3051. ⓪&END;
  3052. ⓪&ReplaceHome (path);
  3053. ⓪&SetDefaultPath (path, voidI)
  3054. ⓪$END;
  3055. ⓪ 
  3056. ⓪$callSwitchedToTextMode := (prgType = AESMisc.textPrgm);
  3057. ⓪ 
  3058. ⓪$(*$? UseExtKeys: IF NOT tool THEN DeInstallKbdEvents END; *)
  3059. ⓪$
  3060. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  3061. ⓪&closeAllWindows; (* alle noch offenen Fenster (von ACCs) schließen *)
  3062. ⓪$END;
  3063. ⓪ 
  3064. ⓪$IF prgType = AESMisc.textPrgm THEN
  3065. ⓪&HideMouse;
  3066. ⓪&clrscr;
  3067. ⓪&curon;
  3068. ⓪$END;
  3069. ⓪$
  3070. ⓪$IF DoShellWrite AND (GEMEnv.GEMVersion() >= $140) THEN
  3071. ⓪&IF NOT multiTOS THEN
  3072. ⓪(AESMisc.ShellWrite (TRUE, prgType, name, args);
  3073. ⓪&END
  3074. ⓪$END;
  3075. ⓪ 
  3076. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  3077. ⓪&(* AC_CLOSE-Nachricht an alle Accessories schicken *)
  3078. ⓪&appl_exit; (* nach appl_exit kein AES-Aufruf mehr! *)
  3079. ⓪$END;
  3080. ⓪$
  3081. ⓪$prevStackSize:= DefaultStackSize;
  3082. ⓪$IF stackSize # 0 THEN DefaultStackSize:= stackSize END;
  3083. ⓪$CallModule (name, StdPaths, args, NIL, exitCode, callMsg, callRes);
  3084. ⓪$DefaultStackSize:= prevStackSize;
  3085. ⓪ 
  3086. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  3087. ⓪&(* beim GEM wieder anmelden *)
  3088. ⓪&appl_init;  (* erst jetzt wieder AES-Aufrufe erlaubt! *)
  3089. ⓪$END;
  3090. ⓪(
  3091. ⓪$IF DoShellWrite AND (GEMEnv.GEMVersion() >= $140) THEN
  3092. ⓪&IF NOT multiTOS THEN
  3093. ⓪((* Dies alles funktioniert erst ab TOS 1.4 richtig *)
  3094. ⓪(AESMisc.ShellWrite (FALSE, AESMisc.graphicPrgm, ShellName, '');
  3095. ⓪&END
  3096. ⓪$END;
  3097. ⓪$
  3098. ⓪$IF prgType = AESMisc.textPrgm THEN
  3099. ⓪&(* Nach Programmende bei TOS-Programmen auf Tastendruck warten *)
  3100. ⓪&IF interactive & shellParm.waitOnReturn
  3101. ⓪)& NOT ScanMode & (callRes = noError) THEN
  3102. ⓪(WHILE Bconstat () DO dummyChar:= Bconin () END;
  3103. ⓪(curon;
  3104. ⓪(dummyChar:= Bconin ()
  3105. ⓪&END;
  3106. ⓪&curoff;
  3107. ⓪&ShowMouse
  3108. ⓪$END;
  3109. ⓪ 
  3110. ⓪$IF NOT multiGEM & NOT multiTOS THEN
  3111. ⓪&closeAllWindows; (* alle noch offenen Fenster (von ACCs) schließen *)
  3112. ⓪$END;
  3113. ⓪ 
  3114. ⓪$ClearDeskAndShowMsg;
  3115. ⓪$
  3116. ⓪$IF Inconsistent () THEN
  3117. ⓪&alert (memErrorAlt, '', OkStr^)
  3118. ⓪$END;
  3119. ⓪ 
  3120. ⓪$(*$? UseExtKeys: IF NOT tool THEN InstallKbdEvents END; *)
  3121. ⓪ 
  3122. ⓪$SetDefaultPath (oldPath, res);
  3123. ⓪ 
  3124. ⓪$IF checkError THEN
  3125. ⓪&IF callRes # noError THEN
  3126. ⓪(IF callRes = exitFault THEN
  3127. ⓪*alert (callMsg, '', OkStr^)
  3128. ⓪(ELSE
  3129. ⓪*alert (conc (name, NoExecStr^), callMsg, OkStr^)
  3130. ⓪(END
  3131. ⓪&ELSIF ScanMode THEN
  3132. ⓪(PrepareScan;
  3133. ⓪(IF ScanBox (TextName) THEN
  3134. ⓪*autoCmd := scan
  3135. ⓪(ELSE
  3136. ⓪*autoCmd := noCmd
  3137. ⓪(END
  3138. ⓪&ELSIF exitCode # 0 THEN
  3139. ⓪(CASE exitCode OF
  3140. ⓪*fFileNotFound,
  3141. ⓪*fPathNotFound,
  3142. ⓪*fInvalidDrive: FormError (2)|
  3143. ⓪4(* "Diese Anwendung kann Datei oder Ordner nicht finden" *)
  3144. ⓪*fAccessDenied: FormError (5)|
  3145. ⓪6(* "Datei existiert bereits oder ist Schreibgeschützt" *)
  3146. ⓪*fTooManyOpen,
  3147. ⓪*fInsufficientMemory: FormError (8)|
  3148. ⓪-(* "Es steht nicht genug Speicher für diese Anw. zur Verfügung" *)
  3149. ⓪(ELSE
  3150. ⓪*alert (conc (RetStr^, IntToStr (exitCode, 0)), '', OkStr^)
  3151. ⓪(END
  3152. ⓪&END
  3153. ⓪$END;
  3154. ⓪$ScanMode := FALSE
  3155. ⓪"END call;
  3156. ⓪ 
  3157. ⓪ 
  3158. ⓪ PROCEDURE callEdit (VAR s0: ARRAY OF CHAR; errMsg: BOOLEAN);
  3159. ⓪ 
  3160. ⓪"VAR s, voidStr,
  3161. ⓪&tempPath  : ARRAY [0..126] OF CHAR;
  3162. ⓪&f         : File;
  3163. ⓪&lastBreak : BOOLEAN;
  3164. ⓪&zero      : CARDINAL;
  3165. ⓪ 
  3166. ⓪"PROCEDURE writeTempFile;
  3167. ⓪ 
  3168. ⓪$PROCEDURE stateError (): BOOLEAN;
  3169. ⓪ 
  3170. ⓪&BEGIN
  3171. ⓪(IF State (f) # fOK THEN
  3172. ⓪*FileAlert (State (f));
  3173. ⓪*ResetState (f);
  3174. ⓪*Remove (f);
  3175. ⓪*RETURN TRUE
  3176. ⓪(ELSE RETURN FALSE END;
  3177. ⓪&END stateError;
  3178. ⓪$
  3179. ⓪$PROCEDURE writeLn (VAR str: ARRAY OF CHAR): BOOLEAN;
  3180. ⓪$
  3181. ⓪&BEGIN
  3182. ⓪(Text.WriteString (f, str);
  3183. ⓪(IF stateError () THEN RETURN FALSE END;
  3184. ⓪(Text.WriteLn (f);
  3185. ⓪(IF stateError () THEN RETURN FALSE END;
  3186. ⓪(RETURN TRUE
  3187. ⓪&END writeLn;
  3188. ⓪$
  3189. ⓪$VAR s2: Str128;
  3190. ⓪&
  3191. ⓪$BEGIN
  3192. ⓪&ReplaceHome (tempPath);
  3193. ⓪&Create (f, tempPath, writeSeqTxt, replaceOld);
  3194. ⓪&IF stateError () THEN RETURN END;
  3195. ⓪&IF ~ EditorParm.passName THEN
  3196. ⓪(IF ~ writeLn (TextName) THEN RETURN END;
  3197. ⓪&END;
  3198. ⓪&IF ~ EditorParm.passErrorPos AND errMsg THEN
  3199. ⓪(Assign (CardToStr (TextLine, 0), s2, voidO);
  3200. ⓪(Append (' ', s2, voidO);
  3201. ⓪(Append (CardToStr (TextCol - 1, 0), s2, voidO);
  3202. ⓪(IF ~ writeLn (s2) THEN RETURN END;
  3203. ⓪&END;
  3204. ⓪&IF ~ EditorParm.passErrorText AND errMsg THEN
  3205. ⓪(IF ~ writeLn (ErrorMsg) THEN RETURN END;
  3206. ⓪&END;
  3207. ⓪&Close (f);
  3208. ⓪$END writeTempFile;
  3209. ⓪ 
  3210. ⓪"BEGIN
  3211. ⓪$Split (s0, PosLen (' ', s0, 0), TextName, s, voidO);
  3212. ⓪$IF EditorParm.searchSources THEN
  3213. ⓪&SearchFile (TextName, SrcPaths, fromStart, voidO, TextName)
  3214. ⓪$END;
  3215. ⓪$IF EditorParm.passName THEN Insert (TextName, 0, s, voidO) END;
  3216. ⓪ 
  3217. ⓪$(* Zeiger auf akt. Dateinamen dem Editor mit übergeben
  3218. ⓪&IF isToolbox THEN
  3219. ⓪(Append (' ^', s, voidO);
  3220. ⓪(Append (CardToStr (LONGCARD (ADR (TextName)), 0), s, voidO);
  3221. ⓪(Append (' ', s, voidO);
  3222. ⓪&END;
  3223. ⓪$*)
  3224. ⓪ 
  3225. ⓪$IF EditorParm.tempShellFile THEN
  3226. ⓪&SplitPath (EditorParm.name, tempPath, voidStr);
  3227. ⓪&Append (EditorParm.tempShellName, tempPath, voidO);
  3228. ⓪&Append (tempPath, s, strVal);
  3229. ⓪&writeTempFile;
  3230. ⓪$END;
  3231. ⓪$
  3232. ⓪$IF ~ EditorParm.passArgument THEN s := '' END;
  3233. ⓪$
  3234. ⓪$lastBreak:= shellParm.breakActive;
  3235. ⓪$shellParm.breakActive:= FALSE;
  3236. ⓪$call (EditorParm.name, s, EditorStackSize, FALSE, FALSE, TRUE);
  3237. ⓪$shellParm.breakActive:= lastBreak;
  3238. ⓪$
  3239. ⓪$IF EditorParm.tempEditorFile THEN
  3240. ⓪&SplitPath (EditorParm.name, tempPath, voidStr);
  3241. ⓪&Append (EditorParm.tempEditorName, tempPath, voidO);
  3242. ⓪&ReplaceHome (tempPath);
  3243. ⓪&Open (f, tempPath, readSeqTxt);
  3244. ⓪&IF State (f) = fOK THEN
  3245. ⓪(Text.ReadString (f, s);
  3246. ⓪(Close (f);
  3247. ⓪(zero := 0;
  3248. ⓪(exitCode := StrToCard (s, zero, strVal);
  3249. ⓪(IF ~ strVal THEN exitCode := 0 END;
  3250. ⓪&ELSE
  3251. ⓪(exitCode:= 0
  3252. ⓪&END;
  3253. ⓪$END;
  3254. ⓪$
  3255. ⓪$autoCmd := noCmd;
  3256. ⓪$IF callRes # noError THEN
  3257. ⓪&alert (EdStr^, callMsg, OkStr^)
  3258. ⓪$ELSE
  3259. ⓪&CASE exitCode OF
  3260. ⓪(1: autoCmd := compile|
  3261. ⓪(2: autoCmd := exec_src|
  3262. ⓪(3: autoCmd := dftMake|
  3263. ⓪(4: autoCmd := dftMake_exec|
  3264. ⓪&ELSE
  3265. ⓪&END;
  3266. ⓪&IF (autoCmd = dftMake_exec) OR (autoCmd = dftMake) THEN
  3267. ⓪(IF NOT makeActive THEN
  3268. ⓪*editorsMakeCmd:= autoCmd;
  3269. ⓪*makeActive:= TRUE;
  3270. ⓪(END;
  3271. ⓪(autoCmd:= contMake
  3272. ⓪&ELSE
  3273. ⓪(IF makeActive THEN
  3274. ⓪*FormAlert (1, ContMakeAlt^, buttonNum);
  3275. ⓪*IF buttonNum = 1 THEN
  3276. ⓪,autoCmd:= contMake
  3277. ⓪*END
  3278. ⓪(END
  3279. ⓪&END
  3280. ⓪$END;
  3281. ⓪"END callEdit;
  3282. ⓪ 
  3283. ⓪ PROCEDURE hdedit (wrk: BOOLEAN);
  3284. ⓪ 
  3285. ⓪"VAR name1, name2: NameStr;
  3286. ⓪&dummy       : Str128;
  3287. ⓪"
  3288. ⓪"BEGIN
  3289. ⓪$IF wrk THEN
  3290. ⓪&callEdit (workFName, FALSE);
  3291. ⓪$ELSE
  3292. ⓪&callEdit (currFn, FALSE)
  3293. ⓪$END;
  3294. ⓪$Upper (TextName);
  3295. ⓪$SplitPath (TextName, dummy, name1);
  3296. ⓪$SplitPath (workFName, dummy, name2);
  3297. ⓪$IF NOT StrEqual (name1, name2) THEN lastFn := TextName END;
  3298. ⓪"END hdedit;
  3299. ⓪ 
  3300. ⓪ PROCEDURE hdrun (wrk, tool: BOOLEAN);
  3301. ⓪ 
  3302. ⓪"VAR   found,
  3303. ⓪(codeOK  : BOOLEAN;
  3304. ⓪(f       : File;
  3305. ⓪(cDate,
  3306. ⓪(sDate   : Clock.Date;
  3307. ⓪(cTime,
  3308. ⓪(sTime   : Clock.Time;
  3309. ⓪(sname,
  3310. ⓪(cname,
  3311. ⓪(voidStr,
  3312. ⓪(suffix  : FileStr;
  3313. ⓪ 
  3314. ⓪ 
  3315. ⓪"PROCEDURE longTime (d:Clock.Date; t:Clock.Time): LONGCARD;
  3316. ⓪$BEGIN
  3317. ⓪&RETURN LONG (Clock.PackDate (d)) * $10000 + LONG (Clock.PackTime (t))
  3318. ⓪$END longTime;
  3319. ⓪ 
  3320. ⓪"PROCEDURE getCodeDateTime (    suffix: MySuf;
  3321. ⓪Apaths : PathList;
  3322. ⓪=VAR cname : FileStr;
  3323. ⓪=VAR found : BOOLEAN);
  3324. ⓪$VAR testName: FileStr;
  3325. ⓪(testN2: FileStr;
  3326. ⓪(path: ptrString;
  3327. ⓪$BEGIN
  3328. ⓪&found:= FALSE;
  3329. ⓪ 
  3330. ⓪&ConcatName (cname, suf[suffix], testN2);
  3331. ⓪&IF NOT Empty (MainOutputPath) THEN
  3332. ⓪((* Eingestellten Ausgabe-Pfad prüfen *)
  3333. ⓪(Concat (MainOutputPath, testN2, testName, voidO);
  3334. ⓪&ELSE
  3335. ⓪((* Ausgabe-Pfad aus Compiler-Pfaden prüfen *)
  3336. ⓪(IF suffix = imp THEN
  3337. ⓪*Concat (ImpOutPath, testN2, testName, voidO);
  3338. ⓪(ELSE
  3339. ⓪*Concat (ModOutPath, testN2, testName, voidO);
  3340. ⓪(END
  3341. ⓪&END;
  3342. ⓪&ReplaceHome (testName);
  3343. ⓪&Open (f, testName, readOnly);
  3344. ⓪&found:= (State (f) >= fOK);
  3345. ⓪&IF NOT found THEN
  3346. ⓪((* Datei auf Default-Pfaden suchen *)
  3347. ⓪(SearchFile (testN2, paths, fromStart, found, testName);
  3348. ⓪(IF found THEN
  3349. ⓪*Open (f, testName, readOnly);
  3350. ⓪(END
  3351. ⓪&END;
  3352. ⓪&IF found THEN
  3353. ⓪(GetDateTime (f, cDate, cTime);
  3354. ⓪(Close (f);
  3355. ⓪(cname:= testName;
  3356. ⓪&END;
  3357. ⓪$END getCodeDateTime;
  3358. ⓪ 
  3359. ⓪"BEGIN (* hdrun *)
  3360. ⓪$codeOK := FALSE;
  3361. ⓪$(* check, wether code is valid if source is executed *)
  3362. ⓪$IF wrk THEN
  3363. ⓪&SearchFile (workFName, SrcPaths, fromStart, found, sname);
  3364. ⓪$ELSIF IsSourceName (currFn) THEN
  3365. ⓪&SearchFile (currFn, SrcPaths, fromStart, found, sname)
  3366. ⓪$ELSE
  3367. ⓪&(* wir haben einen Code -> sofort ausführen *)
  3368. ⓪&codeOK := TRUE
  3369. ⓪$END;
  3370. ⓪$IF NOT codeOK THEN
  3371. ⓪&IF found THEN
  3372. ⓪((* Source vorhanden *)
  3373. ⓪(IF wrk THEN
  3374. ⓪*workFName:= sname; cname:= workCName
  3375. ⓪(ELSE
  3376. ⓪*currFn:= sname; cname:= ''
  3377. ⓪(END;
  3378. ⓪(IF Empty (cname) THEN
  3379. ⓪*(* Wir müssen den Code suchen *)
  3380. ⓪*SplitPath (sname, voidStr, cname);
  3381. ⓪*SplitName (cname, cname, suffix);
  3382. ⓪*getCodeDateTime (mod, ModPaths, cname, codeOK);
  3383. ⓪*IF NOT codeOK THEN
  3384. ⓪,getCodeDateTime (mos, ModPaths, cname, codeOK) END;
  3385. ⓪*IF NOT codeOK THEN
  3386. ⓪,getCodeDateTime (mtp, ModPaths, cname, codeOK) END;
  3387. ⓪*IF NOT codeOK THEN
  3388. ⓪,getCodeDateTime (imp, ImpPaths, cname, codeOK) END;
  3389. ⓪(ELSE
  3390. ⓪*(* Code schon vorhanden *)
  3391. ⓪*Open (f, cname, readOnly);
  3392. ⓪*codeOK:= (State (f) = fOK);
  3393. ⓪*IF codeOK THEN
  3394. ⓪,GetDateTime (f, cDate, cTime);
  3395. ⓪,Close (f);
  3396. ⓪*END;
  3397. ⓪(END;
  3398. ⓪(IF codeOK THEN
  3399. ⓪*(* Code vorhanden -> Zeit der Source ermitteln und mit Code vergl. *)
  3400. ⓪*Open (f, sname, readOnly);
  3401. ⓪*GetDateTime (f, sDate, sTime);
  3402. ⓪*Close (f);
  3403. ⓪*codeOK:= longTime (cDate,cTime) >= longTime (sDate,sTime);
  3404. ⓪(END;
  3405. ⓪&ELSE
  3406. ⓪((* Source nicht vorhanden -> Fehler melden? *)
  3407. ⓪((* wenn nicht, wird einfach Compiler gestartet... (weil codeOK=FALSE) *)
  3408. ⓪&END;
  3409. ⓪&
  3410. ⓪$ELSE
  3411. ⓪&cname:= currFn
  3412. ⓪$END;
  3413. ⓪$
  3414. ⓪$IF codeOK THEN
  3415. ⓪&IF wrk THEN workCName := cname
  3416. ⓪&ELSE CodeName := cname END;
  3417. ⓪&call (cname, args, 0, TRUE, TRUE, tool)
  3418. ⓪$ELSE
  3419. ⓪&IF wrk THEN workCName:= '' END;
  3420. ⓪&TextName := sname;
  3421. ⓪&autoCmd := comp_exec
  3422. ⓪$END
  3423. ⓪$
  3424. ⓪"END hdrun;
  3425. ⓪ 
  3426. ⓪ 
  3427. ⓪ PROCEDURE DoEditBox (batch, mustShow: BOOLEAN; VAR cont: BOOLEAN);
  3428. ⓪"VAR s: String;
  3429. ⓪&msg: Str128;
  3430. ⓪&buttonNum: CARDINAL;
  3431. ⓪"BEGIN
  3432. ⓪$(* Signalton: *)
  3433. ⓪$bing;
  3434. ⓪$IF mustShow OR EditorParm.waitOnError THEN
  3435. ⓪&msg := '[2][][]';
  3436. ⓪&IF batch THEN
  3437. ⓪(Insert (EditBatStr^, 6, msg, voidO)
  3438. ⓪&ELSE
  3439. ⓪(Insert (EditStr^, 6, msg, voidO)
  3440. ⓪&END;
  3441. ⓪&s:= ErrorMsg;
  3442. ⓪&WrapAlert (s, 0);
  3443. ⓪&Insert (s, 4, msg, voidO);
  3444. ⓪&FormAlert (1, msg, buttonNum);
  3445. ⓪&IF buttonNum = 1 THEN
  3446. ⓪(autoCmd:= edit; cont:= FALSE;
  3447. ⓪&ELSE
  3448. ⓪(autoCmd:= noCmd; cont:= (buttonNum = 2);
  3449. ⓪&END
  3450. ⓪$ELSE
  3451. ⓪&autoCmd:= edit; cont:= FALSE;
  3452. ⓪$END
  3453. ⓪"END DoEditBox;
  3454. ⓪ 
  3455. ⓪ 
  3456. ⓪ (*  callComp -- Calls the compiler to compile the file 'modName'.
  3457. ⓪!*              'work = TRUE' means the workfile is compiled.
  3458. ⓪!*              'batch = TRUE' means the compiler is called while
  3459. ⓪!*              executing a batch file. In that case 'cont' states,
  3460. ⓪!*              if the execution of the batch file has to continue
  3461. ⓪!*              after this proc. returns.
  3462. ⓪!*)
  3463. ⓪ 
  3464. ⓪ PROCEDURE callComp (VAR modname: ARRAY OF CHAR;
  3465. ⓪8work,
  3466. ⓪8batch  : BOOLEAN;
  3467. ⓪4VAR cont   : BOOLEAN);
  3468. ⓪ 
  3469. ⓪"VAR i:INTEGER;
  3470. ⓪&s,msg:Str128;
  3471. ⓪ 
  3472. ⓪"BEGIN
  3473. ⓪$(*  String mit Compileroptionen aufbauen.
  3474. ⓪%*)
  3475. ⓪$WITH CompilerParm DO
  3476. ⓪&IF shortMsgs THEN s:= ' -Q' ELSE s:= ' +Q' END;
  3477. ⓪&Append (' ', s, voidO);
  3478. ⓪&Append (CompilerArgs, s, voidO);
  3479. ⓪&IF ~ Empty (MainOutputPath) THEN
  3480. ⓪(Append (' /O', s, voidO);
  3481. ⓪(Append (MainOutputPath, s, voidO);
  3482. ⓪&END;
  3483. ⓪&IF protocol THEN
  3484. ⓪(Append (' /C', s, voidO);
  3485. ⓪(Append (CardToStr (protWidth, 0), s, voidO);
  3486. ⓪(Append (' /P', s, voidO);
  3487. ⓪(Append (protName, s, voidO);
  3488. ⓪&END;
  3489. ⓪$END;
  3490. ⓪$
  3491. ⓪$CodeName:= '';
  3492. ⓪$IF autoCmd = scan THEN ScanMode:= TRUE END;
  3493. ⓪$call (CompilerParm.name, conc (modname, s),
  3494. ⓪*CompilerStackSize, FALSE, FALSE, TRUE);
  3495. ⓪$
  3496. ⓪$cont:= TRUE;
  3497. ⓪$IF callRes # noError THEN
  3498. ⓪&alert (CompStr^, callMsg, OkStr^);
  3499. ⓪&autoCmd:= noCmd
  3500. ⓪$ELSE
  3501. ⓪&CASE exitCode OF
  3502. ⓪(0:   IF autoCmd = scan THEN
  3503. ⓪/autoCmd:= edit
  3504. ⓪-ELSIF ~ batch THEN
  3505. ⓪-
  3506. ⓪/IF makeActive THEN
  3507. ⓪1CodeName:= LastCodeName;
  3508. ⓪/ELSE
  3509. ⓪1Upper (CodeName);
  3510. ⓪1LastCodeName:= CodeName;
  3511. ⓪1LastCodeSize:= CodeSize;
  3512. ⓪/END;
  3513. ⓪/IF work THEN
  3514. ⓪1workCName:= CodeName;
  3515. ⓪1writeWorkName (TextName, CodeName);
  3516. ⓪/END;
  3517. ⓪/IF autoCmd = comp_exec THEN
  3518. ⓪1autoCmd:= execute
  3519. ⓪/ELSE
  3520. ⓪1autoCmd:= noCmd
  3521. ⓪/END;
  3522. ⓪/
  3523. ⓪-END|
  3524. ⓪(2:   DoEditBox (batch, TRUE, cont)|
  3525. ⓪(3:   DoEditBox (batch, FALSE, cont)
  3526. ⓪&ELSE
  3527. ⓪(autoCmd:= noCmd
  3528. ⓪&END
  3529. ⓪$END
  3530. ⓪"END callComp;
  3531. ⓪ 
  3532. ⓪ 
  3533. ⓪ PROCEDURE callLink (VAR moduleName: ARRAY OF CHAR);
  3534. ⓪ 
  3535. ⓪"VAR s: ARRAY [0..124] OF CHAR;
  3536. ⓪"
  3537. ⓪"BEGIN
  3538. ⓪$Assign (moduleName, s, voidO);
  3539. ⓪$WITH LinkerParm DO
  3540. ⓪&IF optimize = partOptimize THEN
  3541. ⓪(Append (' -H', s, voidO);
  3542. ⓪&ELSIF optimize = nameOptimize THEN
  3543. ⓪(Append (' -M', s, voidO);
  3544. ⓪&ELSIF optimize = fullOptimize THEN
  3545. ⓪(Append (' -F', s, voidO);
  3546. ⓪&END;
  3547. ⓪&IF fastLoad THEN
  3548. ⓪(Append (' -0', s, voidO)
  3549. ⓪&END;
  3550. ⓪&IF fastCode THEN
  3551. ⓪(Append (' -1', s, voidO)
  3552. ⓪&END;
  3553. ⓪&IF fastMemory THEN
  3554. ⓪(Append (' -2', s, voidO)
  3555. ⓪&END;
  3556. ⓪&IF symbolFile THEN
  3557. ⓪(Append (' -S', s, voidO);
  3558. ⓪(Append (symbolArgs, s, voidO)
  3559. ⓪&END;
  3560. ⓪&IF outputName[0] # '' THEN
  3561. ⓪(Append (' -O', s, voidO);
  3562. ⓪(Append (outputName, s, voidO)
  3563. ⓪&END;
  3564. ⓪&call (name, s, LinkerStackSize, FALSE, FALSE, TRUE);
  3565. ⓪$END;
  3566. ⓪$IF callRes # noError THEN
  3567. ⓪&alert (LinkStr^, callMsg, OkStr^)
  3568. ⓪$END
  3569. ⓪"END callLink;
  3570. ⓪ 
  3571. ⓪ 
  3572. ⓪ PROCEDURE callMake (REF name: ARRAY OF CHAR; batch: BOOLEAN; VAR cont: BOOLEAN);
  3573. ⓪ 
  3574. ⓪"BEGIN
  3575. ⓪$call (shellParm.makeName, name, MakeStackSize, FALSE, FALSE, TRUE);
  3576. ⓪$cont:= TRUE;
  3577. ⓪$IF callRes # noError THEN
  3578. ⓪&alert (MakeStr^, callMsg, OkStr^);
  3579. ⓪&autoCmd:= noCmd;
  3580. ⓪$ELSE
  3581. ⓪&CASE exitCode OF
  3582. ⓪(0: LastCodeName:= CodeName;
  3583. ⓪+LastCodeSize:= 0L;
  3584. ⓪+ConcatPath (TemporaryPath, MakeCompFileName, TextName);
  3585. ⓪+ReplaceHome (TextName);
  3586. ⓪+IF autoCmd = make_exec THEN autoCmd:= comp_exec
  3587. ⓪+ELSE autoCmd:= compile END|
  3588. ⓪(1: IF autoCmd = make_exec THEN autoCmd:= execute
  3589. ⓪+ELSE autoCmd:= noCmd END|
  3590. ⓪(2: DoEditBox (batch, FALSE, cont)
  3591. ⓪&ELSE
  3592. ⓪(autoCmd:= noCmd;
  3593. ⓪&END;
  3594. ⓪$END
  3595. ⓪"END callMake;
  3596. ⓪ 
  3597. ⓪ 
  3598. ⓪ PROCEDURE hdscan (wrk: BOOLEAN);
  3599. ⓪ 
  3600. ⓪"BEGIN
  3601. ⓪$ErrorMsg:= '<Scanned>';
  3602. ⓪$autoCmd:= scan;
  3603. ⓪$IF wrk THEN callComp (workFName, TRUE, FALSE, voidO);
  3604. ⓪$ELSIF Empty (currFn) THEN callComp (lastFn, FALSE, FALSE, voidO)
  3605. ⓪$ELSE callComp (currFn, FALSE, FALSE, voidO) END;
  3606. ⓪"END hdscan;
  3607. ⓪ 
  3608. ⓪ PROCEDURE hdcomp (wrk: BOOLEAN);
  3609. ⓪ 
  3610. ⓪"BEGIN
  3611. ⓪$IF wrk THEN callComp (workFName, TRUE, FALSE, voidO);
  3612. ⓪$ELSE callComp (currFn, FALSE, FALSE, voidO); lastFn:= currFn; END;
  3613. ⓪"END hdcomp;
  3614. ⓪ 
  3615. ⓪ PROCEDURE hdlink (wrk: BOOLEAN);
  3616. ⓪ 
  3617. ⓪"BEGIN
  3618. ⓪$IF wrk THEN callLink (workCName)
  3619. ⓪$ELSE callLink (currFn) END;
  3620. ⓪"END hdlink;
  3621. ⓪"
  3622. ⓪ PROCEDURE hdmake (wrk: BOOLEAN);
  3623. ⓪ 
  3624. ⓪"BEGIN
  3625. ⓪$IF wrk THEN callMake (workFName, FALSE, voidO)
  3626. ⓪$ELSE callMake (currFn, FALSE, voidO) END;
  3627. ⓪"END hdmake;
  3628. ⓪ 
  3629. ⓪ PROCEDURE action (what: actionType; wrkFile, tool: BOOLEAN);
  3630. ⓪ 
  3631. ⓪"TYPE aTypeSet = SET OF actionType;
  3632. ⓪"
  3633. ⓪"CONST noHideAction = aTypeSet {doLoad, doUnLd, doCont};
  3634. ⓪"
  3635. ⓪"VAR s       : Str128;
  3636. ⓪&dummy, i: CARDINAL;
  3637. ⓪&n1, n2  : ARRAY [0..11] OF CHAR;
  3638. ⓪&hidden  : BOOLEAN;
  3639. ⓪ 
  3640. ⓪"BEGIN
  3641. ⓪$IF wrkFile THEN readWorkNames END;
  3642. ⓪$
  3643. ⓪$IF what IN noHideAction THEN hidden:= FALSE
  3644. ⓪$ELSE HideSS (TRUE); hidden:= TRUE END;
  3645. ⓪$
  3646. ⓪$editorsMakeCmd:= noCmd;
  3647. ⓪$makeActive:= FALSE;
  3648. ⓪$CASE what OF
  3649. ⓪&doEdit: hdedit (wrkFile)|
  3650. ⓪&doComp: hdcomp (wrkFile)|
  3651. ⓪&doExec: hdrun (wrkFile, tool);
  3652. ⓪.IF wrkFile THEN writeWorkName (workFName, workCName) END|
  3653. ⓪&doLink: hdlink (wrkFile)|
  3654. ⓪&doScan: hdscan (wrkFile)|
  3655. ⓪&doCpEx: autoCmd := comp_exec; hdcomp (wrkFile)|
  3656. ⓪&doLoad: load|
  3657. ⓪&doUnLd: unload|
  3658. ⓪&doCont: InputScan (ErrorMsg, ScanIndex);
  3659. ⓪.PrepareScan;
  3660. ⓪.IF ScanBox (TextName) THEN
  3661. ⓪0HideSS (TRUE); hidden:= TRUE;
  3662. ⓪0autoCmd:= scan;
  3663. ⓪0callComp (TextName, FALSE, FALSE, voidO)
  3664. ⓪.END|
  3665. ⓪&doBtch: IF wrkFile THEN ExecuteBatch (workFName, TRUE)
  3666. ⓪.ELSE ExecuteBatch (currFn, TRUE) END|
  3667. ⓪&doParm: IF wrkFile THEN LoadParameter (workFName, TRUE)
  3668. ⓪.ELSE LoadParameter (currFn, TRUE) END|
  3669. ⓪&doMake,
  3670. ⓪&doMkEx,
  3671. ⓪&doDftM: makeActive:= TRUE;
  3672. ⓪.autoCmd:= contMake
  3673. ⓪$ELSE
  3674. ⓪$END;
  3675. ⓪ 
  3676. ⓪$REPEAT
  3677. ⓪&CASE autoCmd OF
  3678. ⓪ 
  3679. ⓪(contMake:  CASE what OF
  3680. ⓪5doMake: autoCmd:= noCmd; hdmake (wrkFile)|
  3681. ⓪5doMkEx: autoCmd:= make_exec; hdmake (wrkFile)|
  3682. ⓪5doDftM: autoCmd:= dftMake
  3683. ⓪3ELSE
  3684. ⓪5autoCmd:= editorsMakeCmd
  3685. ⓪3END|
  3686. ⓪ 
  3687. ⓪(edit     : Concat (TextName, ' ', s, strVal);
  3688. ⓪3IF EditorParm.passErrorPos THEN
  3689. ⓪5Append (CardToStr (TextLine, 0), s, strVal);
  3690. ⓪5Append (' ', s, strVal);
  3691. ⓪5Append (CardToStr (TextCol - 1, 0), s, strVal);
  3692. ⓪5Append (' ', s, strVal);
  3693. ⓪3END;
  3694. ⓪3IF EditorParm.passErrorText THEN
  3695. ⓪5Append ('"', s, strVal);
  3696. ⓪5Append (ErrorMsg, s, voidO);
  3697. ⓪5Append ('" ', s, strVal);
  3698. ⓪3END;
  3699. ⓪3callEdit (s, TRUE)|
  3700. ⓪ 
  3701. ⓪(scan,
  3702. ⓪(compile,
  3703. ⓪(comp_exec: callComp (TextName, wrkFile, FALSE, voidO)|
  3704. ⓪(
  3705. ⓪(exec_src : autoCmd:= noCmd;
  3706. ⓪3workFName:= '';
  3707. ⓪3workCName:= '';
  3708. ⓪3wrkFile:= FALSE;
  3709. ⓪3WITH WorkField DO
  3710. ⓪5IF current >= 0 THEN
  3711. ⓪7i:= 0;
  3712. ⓪7LOOP (* workFile richtig bestimmen *)
  3713. ⓪9WITH elems[i] DO
  3714. ⓪;IF used & StrEqual (TextName, sourceName) THEN
  3715. ⓪=workFName:= sourceName;
  3716. ⓪=workCName:= codeName;
  3717. ⓪=wrkFile:= TRUE;
  3718. ⓪=EXIT
  3719. ⓪;END;
  3720. ⓪9END;
  3721. ⓪9INC (i);
  3722. ⓪9IF i = maxWorkFiles THEN
  3723. ⓪;EXIT
  3724. ⓪9END;
  3725. ⓪7END
  3726. ⓪5END;
  3727. ⓪3END;
  3728. ⓪3IF ~wrkFile THEN currFn:= TextName END;
  3729. ⓪3hdrun (wrkFile, tool);
  3730. ⓪3IF wrkFile THEN writeWorkName (workFName, workCName) END|
  3731. ⓪ 
  3732. ⓪(execute  : autoCmd:= noCmd;
  3733. ⓪3call (CodeName, args, 0, TRUE, TRUE, tool)|
  3734. ⓪ 
  3735. ⓪(dftMake_exec,
  3736. ⓪(dftMake  : IF autoCmd = dftMake_exec THEN autoCmd:= make_exec END;
  3737. ⓪3callMake ('' (* >> Make verw. Default-Namen aus ShellMsg *), FALSE, voidO)|
  3738. ⓪&ELSE
  3739. ⓪&END
  3740. ⓪$UNTIL autoCmd = noCmd;
  3741. ⓪$
  3742. ⓪$Assign (lastFn, TextName, voidO);
  3743. ⓪$
  3744. ⓪$IF hidden THEN ShowSS (TRUE) END;
  3745. ⓪"END action;
  3746. ⓪ 
  3747. ⓪ 
  3748. ⓪ 
  3749. ⓪ TYPE    pathEntry       = RECORD
  3750. ⓪<used: BOOLEAN;
  3751. ⓪<path: PathStr;
  3752. ⓪:END;
  3753. ⓪ 
  3754. ⓪ VAR     pathArray: ARRAY [1..MaxSearchPaths] OF pathEntry;
  3755. ⓪ 
  3756. ⓪ PROCEDURE ExecuteBatch (name: ARRAY OF CHAR; load: BOOLEAN);
  3757. ⓪ 
  3758. ⓪"VAR f                 : File;
  3759. ⓪&s, arg            : ARRAY[0..255] OF CHAR;
  3760. ⓪&gotLine, cont,
  3761. ⓪&doIt              : BOOLEAN;
  3762. ⓪&result            : INTEGER;
  3763. ⓪&oldDrive          : Drive;
  3764. ⓪&oldPath           : PathStr;
  3765. ⓪"
  3766. ⓪"PROCEDURE delSpc (VAR s:ARRAY OF CHAR);
  3767. ⓪$BEGIN
  3768. ⓪&WHILE s[0] = ' ' DO Delete (s,0,1, voidO) END
  3769. ⓪$END delSpc;
  3770. ⓪"
  3771. ⓪"PROCEDURE equ (a,b: ARRAY OF CHAR): BOOLEAN;
  3772. ⓪$BEGIN
  3773. ⓪&Upper (a);
  3774. ⓪&Upper (b);
  3775. ⓪&RETURN Compare (FileName (a), FileName (b)) = equal
  3776. ⓪$END equ;
  3777. ⓪ 
  3778. ⓪"PROCEDURE setLinkName (VAR n:ARRAY OF CHAR);
  3779. ⓪$VAR first: CHAR;
  3780. ⓪(i: CARDINAL;
  3781. ⓪(useEmpty: BOOLEAN;
  3782. ⓪$BEGIN
  3783. ⓪&first:=n[0];
  3784. ⓪&IF (first = '-') OR (first = '+') THEN
  3785. ⓪(Delete (n, 0, 1, voidO);
  3786. ⓪(delSpc (n);
  3787. ⓪&END;
  3788. ⓪&FOR useEmpty:= FALSE TO TRUE DO
  3789. ⓪(FOR i:= MIN (LLRange) TO  MAX (LLRange) DO
  3790. ⓪*IF equ (LinkerParm.linkList[i].name, n)
  3791. ⓪*OR (useEmpty AND Empty (LinkerParm.linkList[i].name)) THEN
  3792. ⓪,LinkerParm.linkList[i].valid:= (first # '-');
  3793. ⓪,Assign (n, LinkerParm.linkList[i].name, voidO);
  3794. ⓪,RETURN
  3795. ⓪*END
  3796. ⓪(END
  3797. ⓪&END
  3798. ⓪$END setLinkName;
  3799. ⓪"
  3800. ⓪"PROCEDURE setToolName (VAR n:ARRAY OF CHAR);
  3801. ⓪$VAR i: CARDINAL;
  3802. ⓪$BEGIN
  3803. ⓪&FOR i:=1 TO MaxTool DO
  3804. ⓪(IF ~ToolField[i].used THEN
  3805. ⓪*ToolField[i].used:= TRUE;
  3806. ⓪*Assign (n,ToolField[i].name, voidO);
  3807. ⓪*RETURN
  3808. ⓪(END
  3809. ⓪&END
  3810. ⓪$END setToolName;
  3811. ⓪"
  3812. ⓪"PROCEDURE getFirstPath (paths: PathList; VAR path: ARRAY OF CHAR);
  3813. ⓪$VAR entry: PathEntry;
  3814. ⓪$BEGIN
  3815. ⓪&Lists.ResetList (paths);
  3816. ⓪&entry:= Lists.NextEntry (paths);
  3817. ⓪&IF entry # NIL THEN
  3818. ⓪(Assign (entry^, path, voidO)
  3819. ⓪&ELSE
  3820. ⓪(path[0]:= ''
  3821. ⓪&END
  3822. ⓪$END getFirstPath;
  3823. ⓪"
  3824. ⓪"PROCEDURE killPaths (VAR paths: PathList);
  3825. ⓪"
  3826. ⓪$VAR entry: ADDRESS;
  3827. ⓪(idx  : CARDINAL;
  3828. ⓪"
  3829. ⓪$BEGIN
  3830. ⓪&Lists.ResetList (paths);
  3831. ⓪&entry:= Lists.PrevEntry (paths);
  3832. ⓪&WHILE entry # NIL DO
  3833. ⓪(idx:= 1;
  3834. ⓪(WHILE (idx <= MaxSearchPaths)
  3835. ⓪.AND (ADR (pathArray[idx].path) # entry) DO INC (idx) END;
  3836. ⓪(IF idx <= MaxSearchPaths THEN pathArray[idx].used:= FALSE END;
  3837. ⓪(Lists.RemoveEntry (paths, voidO);
  3838. ⓪(entry:= Lists.CurrentEntry (paths);
  3839. ⓪&END;
  3840. ⓪$END killPaths;
  3841. ⓪"
  3842. ⓪"PROCEDURE setP ( VAR paths: PathList );
  3843. ⓪$VAR err:BOOLEAN; c:CHAR; idx: CARDINAL;
  3844. ⓪$BEGIN
  3845. ⓪&killPaths (paths);
  3846. ⓪&idx:= 1;
  3847. ⓪&LOOP
  3848. ⓪(IF EOF (f) THEN EXIT END;
  3849. ⓪(Text.ReadString (f,s);
  3850. ⓪(IF s[0] # ' ' THEN EXIT END;
  3851. ⓪(WHILE (idx <= MaxSearchPaths) AND pathArray[idx].used DO INC (idx) END;
  3852. ⓪(IF idx <= MaxSearchPaths THEN
  3853. ⓪*EatSpaces (s);
  3854. ⓪*IF Compare ('.',s) = equal THEN s:= '' END;
  3855. ⓪*ValidatePath (s);
  3856. ⓪*Assign (s,pathArray[idx].path,err);
  3857. ⓪*Lists.AppendEntry (paths,ADR(pathArray[idx].path),err);
  3858. ⓪*pathArray[idx].used:= TRUE;
  3859. ⓪*INC (idx)
  3860. ⓪(ELSE
  3861. ⓪*alert (NoPathsStr^, '', OkStr^)
  3862. ⓪(END
  3863. ⓪&END;
  3864. ⓪&gotLine:= TRUE;
  3865. ⓪$END setP;
  3866. ⓪"
  3867. ⓪"PROCEDURE is (REF s0:ARRAY OF CHAR): BOOLEAN;
  3868. ⓪$BEGIN
  3869. ⓪&RETURN StrEqual (s0,s)
  3870. ⓪$END is;
  3871. ⓪ 
  3872. ⓪"PROCEDURE prep (REF in: ARRAY OF CHAR): BOOLEAN;
  3873. ⓪$BEGIN
  3874. ⓪&Split (in,PosLen (' ',in,0),s,arg,strVal);
  3875. ⓪&delSpc (arg);
  3876. ⓪&Upper (s);
  3877. ⓪&RETURN (s[0] # 0C) AND (s[0] # '*')
  3878. ⓪$END prep;
  3879. ⓪ 
  3880. ⓪"PROCEDURE getLC (VAR l: LONGCARD);
  3881. ⓪$VAR i: CARDINAL;
  3882. ⓪$BEGIN
  3883. ⓪&i:= 0;
  3884. ⓪&l:= StrToLCard (arg, i, strVal);
  3885. ⓪$END getLC;
  3886. ⓪ 
  3887. ⓪"VAR found, tell: BOOLEAN;
  3888. ⓪&i: CARDINAL;
  3889. ⓪&res : INTEGER;
  3890. ⓪ 
  3891. ⓪"PROCEDURE unTell;
  3892. ⓪$BEGIN
  3893. ⓪&IF tell THEN TellLoading (endTell, ''); tell := FALSE END;
  3894. ⓪$END unTell;
  3895. ⓪ 
  3896. ⓪"BEGIN
  3897. ⓪$ShowBee;
  3898. ⓪$tell:= FALSE;
  3899. ⓪$SearchFile (name, StdPaths, fromStart, found, name);
  3900. ⓪$Open (f, name, readSeqTxt);
  3901. ⓪$IF State (f) < 0 THEN
  3902. ⓪&GetStateMsg (State(f), s);
  3903. ⓪&alert (InfStr^, s, OkStr^);
  3904. ⓪$ELSE
  3905. ⓪&gotLine:= FALSE;
  3906. ⓪&cont:= TRUE;
  3907. ⓪&REPEAT
  3908. ⓪ 
  3909. ⓪(IF NOT gotLine THEN Text.ReadString (f, s) END;
  3910. ⓪(gotLine:= FALSE;
  3911. ⓪(
  3912. ⓪(doIt:= FALSE;
  3913. ⓪(IF prep (s) THEN
  3914. ⓪*IF is ('IF_SHELLSTART') THEN    (*  IF-Clause  *)
  3915. ⓪,IF shellStart THEN
  3916. ⓪.doIt:= prep (arg);
  3917. ⓪,END;
  3918. ⓪*ELSIF is ('IF_EXITCODE') THEN
  3919. ⓪,i:= 0;
  3920. ⓪,IF StrToInt (arg, i, voidO) = exitCode THEN
  3921. ⓪.Copy (arg, i, 200, arg, voidO);
  3922. ⓪.doIt:= prep (arg);
  3923. ⓪,END
  3924. ⓪*ELSE
  3925. ⓪,doIt:= TRUE
  3926. ⓪*END;
  3927. ⓪(END;
  3928. ⓪ 
  3929. ⓪(IF doIt THEN
  3930. ⓪H(*  misc  *)
  3931. ⓪*IF is ('WAIT') THEN
  3932. ⓪,alert (arg,'',ContStr^);
  3933. ⓪*ELSIF is ('STACKSIZE') THEN
  3934. ⓪,getLC (DefaultStackSize);
  3935. ⓪,IF DefaultStackSize < 1024L THEN DefaultStackSize:= 1024 END;
  3936. ⓪ 
  3937. ⓪H(*  tools  *)
  3938. ⓪*ELSIF is ('DELETETOOLS') THEN
  3939. ⓪,FOR i:= 1 TO MaxTool DO ToolField[i].used:= FALSE END;  (*  Keine Tools  *)
  3940. ⓪*ELSIF is ('TOOL') THEN
  3941. ⓪,setToolName (arg)
  3942. ⓪H(*  loader commands  *)
  3943. ⓪*ELSIF is ('EXEC') THEN
  3944. ⓪,Split (arg, PosLen (' ', arg, 0), arg, s, strVal);
  3945. ⓪,delSpc (s);
  3946. ⓪,unTell;
  3947. ⓪,Upper (arg);
  3948. ⓪,IF IsMBTFile (arg) THEN
  3949. ⓪.ExecuteBatch (arg, load)
  3950. ⓪,ELSE
  3951. ⓪.call (arg, s, 0, FALSE, TRUE, FALSE);
  3952. ⓪,END;
  3953. ⓪,IF autoCmd # noCmd THEN cont := FALSE END;
  3954. ⓪*ELSIF is ('POSTAMBLE1') THEN
  3955. ⓪,Split (arg,PosLen (' ',arg,0),postAmble1,postArgs1,strVal);
  3956. ⓪,delSpc (postArgs1);
  3957. ⓪,withPost1:= TRUE;
  3958. ⓪*ELSIF is ('POSTAMBLE2') THEN
  3959. ⓪,Split (arg,PosLen (' ',arg,0),postAmble2,postArgs2,strVal);
  3960. ⓪,delSpc (postArgs2);
  3961. ⓪,withPost2:= TRUE;
  3962. ⓪*ELSIF is ('LOAD') THEN
  3963. ⓪,IF load THEN
  3964. ⓪.IF NOT tell THEN TellLoading (initTell, ''); tell := TRUE END;
  3965. ⓪.TellLoading (newTellValue, arg);
  3966. ⓪.LoadModule (arg, StdPaths, callMsg (* dummy *), callMsg,
  3967. ⓪:callRes);
  3968. ⓪,END
  3969. ⓪*ELSIF is ('UNLOAD') THEN
  3970. ⓪,IF load THEN
  3971. ⓪.UnLoadModule (arg, callRes)
  3972. ⓪,END
  3973. ⓪*
  3974. ⓪*ELSIF is ('LINKSTACKSIZE') THEN
  3975. ⓪,getLC (LinkerParm.linkStackSize);
  3976. ⓪*ELSIF is ('NO_OPTIMIZE') THEN
  3977. ⓪,LinkerParm.optimize:= noOptimize 
  3978. ⓪*ELSIF is ('NAME_OPTIMIZE') THEN
  3979. ⓪,LinkerParm.optimize:= nameOptimize 
  3980. ⓪*ELSIF is ('PART_OPTIMIZE') THEN
  3981. ⓪,LinkerParm.optimize:= partOptimize 
  3982. ⓪*ELSIF is ('FULL_OPTIMIZE') THEN
  3983. ⓪,LinkerParm.optimize:= fullOptimize 
  3984. ⓪*ELSIF is ('DRIVER') THEN
  3985. ⓪,setLinkName (arg)
  3986. ⓪*ELSIF is ('DELETEDRIVERS') THEN
  3987. ⓪,SysUtil0.ClearVar (LinkerParm.linkList);
  3988. ⓪ 
  3989. ⓪H(*  comp./link/make  *)
  3990. ⓪*ELSIF is ('COMPILE') THEN
  3991. ⓪,autoCmd:= noCmd;
  3992. ⓪,unTell;
  3993. ⓪,callComp (arg, FALSE, TRUE, cont)
  3994. ⓪*ELSIF is ('MAKE') THEN
  3995. ⓪,autoCmd:= noCmd;
  3996. ⓪,unTell;
  3997. ⓪,callMake (arg, TRUE, cont)
  3998. ⓪*ELSIF is ('LINK') THEN
  3999. ⓪,autoCmd:= noCmd;
  4000. ⓪,unTell;
  4001. ⓪,callLink (arg)
  4002. ⓪*ELSIF is ('EDIT') THEN
  4003. ⓪,autoCmd:= noCmd;
  4004. ⓪,unTell;
  4005. ⓪,callEdit (arg, FALSE)
  4006. ⓪H(*  paths  *)
  4007. ⓪*ELSIF is ('SETDIR') THEN
  4008. ⓪,SetCurrentDir (defaultDrv, arg, voidI);
  4009. ⓪*ELSIF is ('SETDRIVE') THEN
  4010. ⓪,SetDefaultDrive (StrToDrive (arg))
  4011. ⓪*ELSIF is ('SETPATH') THEN
  4012. ⓪,SetDefaultPath (arg, voidI)
  4013. ⓪ 
  4014. ⓪*ELSIF is ('DEFAULTPATH') THEN
  4015. ⓪,setP ( StdPaths );
  4016. ⓪*ELSIF is ('DEFPATH') THEN
  4017. ⓪,setP ( DefPaths );
  4018. ⓪,getFirstPath (DefPaths, DefOutPath);
  4019. ⓪*ELSIF is ('IMPPATH') THEN
  4020. ⓪,setP ( ImpPaths );
  4021. ⓪,getFirstPath (ImpPaths, ImpOutPath);
  4022. ⓪*ELSIF is ('MODPATH') THEN
  4023. ⓪,setP ( ModPaths );
  4024. ⓪,getFirstPath (ModPaths, ModOutPath);
  4025. ⓪*ELSIF is ('SOURCEPATH') THEN
  4026. ⓪,setP ( SrcPaths )
  4027. ⓪*ELSIF is ('DEFOUT') THEN
  4028. ⓪,Assign (arg, DefOutPath, voidO);
  4029. ⓪,ValidatePath (DefOutPath)
  4030. ⓪*ELSIF is ('IMPOUT') THEN
  4031. ⓪,Assign (arg, ImpOutPath, voidO);
  4032. ⓪,ValidatePath (ImpOutPath)
  4033. ⓪*ELSIF is ('MODOUT') THEN
  4034. ⓪,Assign (arg, ModOutPath, voidO);
  4035. ⓪,ValidatePath (ModOutPath)
  4036. ⓪*ELSIF is ('MAINOUTPUTPATH') THEN
  4037. ⓪,Assign (arg, MainOutputPath, voidO);
  4038. ⓪,ValidatePath (MainOutputPath);
  4039. ⓪*END;
  4040. ⓪(
  4041. ⓪(END;
  4042. ⓪(
  4043. ⓪&UNTIL EOF (f) OR NOT cont;
  4044. ⓪&Close (f);
  4045. ⓪ 
  4046. ⓪&(* getFirstPath-Aufrufe hier weg und oben eingefügt *)
  4047. ⓪ 
  4048. ⓪$END;
  4049. ⓪$unTell;
  4050. ⓪$ShowArrow;
  4051. ⓪"END ExecuteBatch;
  4052. ⓪ 
  4053. ⓪ VAR     level   : CARDINAL;
  4054. ⓪ 
  4055. ⓪ PROCEDURE envlpProc (start, inChild:BOOLEAN; VAR i:INTEGER);
  4056. ⓪ 
  4057. ⓪"BEGIN
  4058. ⓪$IF ~inChild THEN
  4059. ⓪&IF start THEN
  4060. ⓪(IF level = 0 THEN
  4061. ⓪*IF shellParm.breakActive THEN voidO:=EnableBreak () END
  4062. ⓪(END;
  4063. ⓪(INC (level);
  4064. ⓪&ELSE
  4065. ⓪(DEC (level);
  4066. ⓪(IF level = 0 THEN
  4067. ⓪*IF shellParm.breakActive THEN DisableBreak END;
  4068. ⓪(END;
  4069. ⓪&END
  4070. ⓪$END;
  4071. ⓪"END envlpProc;
  4072. ⓪"
  4073. ⓪"
  4074. ⓪ VAR     oldOpen : InOutBase.OpenProc;
  4075. ⓪(oldClose: InOutBase.ClsProc;
  4076. ⓪ 
  4077. ⓪ PROCEDURE myOpen (x, y: CARDINAL);
  4078. ⓪ 
  4079. ⓪"BEGIN
  4080. ⓪$IF NOT callSwitchedToTextMode THEN
  4081. ⓪&HideMouse;
  4082. ⓪&clrscr;
  4083. ⓪&curon;
  4084. ⓪$END;
  4085. ⓪$oldOpen (x, y);
  4086. ⓪"END myOpen;
  4087. ⓪ 
  4088. ⓪ PROCEDURE myClose;
  4089. ⓪ 
  4090. ⓪"BEGIN
  4091. ⓪$IF NOT callSwitchedToTextMode THEN
  4092. ⓪&curoff;
  4093. ⓪&ShowMouse
  4094. ⓪$END;
  4095. ⓪$oldClose;
  4096. ⓪"END myClose;
  4097. ⓪ 
  4098. ⓪ 
  4099. ⓪ VAR     err     : BOOLEAN;
  4100. ⓪(wsp     : MemArea;
  4101. ⓪(envlpHdl: EnvlpCarrier;
  4102. ⓪(ch      : CHAR;
  4103. ⓪(idx     : CARDINAL;
  4104. ⓪ 
  4105. ⓪ BEGIN (* Main of MShell *)
  4106. ⓪ 
  4107. ⓪"(*  ShellMsg - Variablen initialisieren
  4108. ⓪#*)
  4109. ⓪"Active:= TRUE;
  4110. ⓪"
  4111. ⓪"(*  Pfadlisten anlegen
  4112. ⓪#*)
  4113. ⓪"Lists.CreateList (StdPaths,err);
  4114. ⓪"Lists.CreateList (DefPaths,err);
  4115. ⓪"Lists.CreateList (ImpPaths,err);
  4116. ⓪"Lists.CreateList (ModPaths,err);
  4117. ⓪"Lists.CreateList (SrcPaths,err);
  4118. ⓪"FOR idx:= 1 TO MaxSearchPaths DO pathArray[idx].used:= FALSE END;
  4119. ⓪ 
  4120. ⓪"autoCmd:= noCmd;
  4121. ⓪"
  4122. ⓪"shellStart:= TRUE;
  4123. ⓪"
  4124. ⓪"IF InitSS () THEN
  4125. ⓪"
  4126. ⓪$(*  Kontrolle gestarteter Prozesse zur Ctrl-C - Aktivierung
  4127. ⓪%*)
  4128. ⓪$SetEnvelope (envlpHdl, envlpProc, wsp);
  4129. ⓪$
  4130. ⓪$(*  Link into 'InOutBase' driver procs
  4131. ⓪%*)
  4132. ⓪$oldOpen := InOutBase.OpenWdw;
  4133. ⓪$InOutBase.OpenWdw := myOpen;
  4134. ⓪$oldClose := InOutBase.CloseWdw;
  4135. ⓪$InOutBase.CloseWdw := myClose;
  4136. ⓪$
  4137. ⓪$shellStart:= FALSE;
  4138. ⓪$(*$? UseExtKeys: InstallKbdEvents; *)
  4139. ⓪$TalkWithUser;               (* Hauptschleife der Shell *)
  4140. ⓪$(*$? UseExtKeys: DeInstallKbdEvents; *)
  4141. ⓪ 
  4142. ⓪$IF withPost1 THEN
  4143. ⓪&call (postAmble1, postArgs1, 0L, FALSE, TRUE, FALSE);
  4144. ⓪$END;
  4145. ⓪$IF withPost2 THEN
  4146. ⓪&call (postAmble2, postArgs2, 0L, FALSE, TRUE, FALSE);
  4147. ⓪$END;
  4148. ⓪ 
  4149. ⓪$InOutBase.OpenWdw := oldOpen;
  4150. ⓪$InOutBase.CloseWdw := oldClose;
  4151. ⓪ 
  4152. ⓪$(* eigenen Namen löschen, damit GEMINI die Shell nicht nochmal startet *)
  4153. ⓪$IF DoShellWrite & (GEMEnv.GEMVersion () >= $140) THEN
  4154. ⓪&IF NOT multiTOS THEN
  4155. ⓪(AESMisc.ShellWrite (FALSE, AESMisc.graphicPrgm, '', '');
  4156. ⓪&END
  4157. ⓪$END;
  4158. ⓪ 
  4159. ⓪$ExitSS;
  4160. ⓪ 
  4161. ⓪"ELSE
  4162. ⓪$TermProcess (fInsufficientMemory)
  4163. ⓪"END;
  4164. ⓪"
  4165. ⓪ END MM2TinyShell.
  4166. ⓪ ə
  4167. (* $000096BA$FFEE34BD$000126F0$000171BA$FFF7016F$FFF7016F$FFF7016F$FFF7016F$FFF7016F$FFEC1D4A$FFF7016F$000001C2$FFF7016F$0001A06C$FFF7016F$FFEC67A7$FFF7016F$00005FE8$FFED6C22$FFF7016F$FFED6C22$00011614$FFF7016F$FFF7016F$FFF64330$00002098$FFE96D50$FFF7016F$FFF7016F$00014F4A$FFF7016F$FFF7016F$FFF7016F$FFF7016F$FFE96809$0001159C$FFEE34BD$FFF7016F$00004278$0000723D$FFF7016F$FFF7016FÇ$000029C4T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000C82$00002FC6$000029C4$0000A2FA$000001C2$00001493$000001C2$00000781$000001C2$FFDEC118$0000A61B$0000A5CE$0000A5B0$000029C4$FFE18A32$00000C59£Çâ*)
  4168.