(* OPREFS OberonOpts mdai OLinkOpts mdais *) (* ------------------------------------------------------------------------ :Program. BlackMagic.mod :Contents. Versatile, powerful module for GUIs, WBench Interfacing, :Contents. Dynamic Strings, Localization, and more. :Author. Franz Schwarz :Copyright. Freeware (freely distributable, copyrighted software) :Copyright. Free use in Freely Distributable stuff (but gimme credit) :Copyright. Explicit confirmation needed for use in commercial code :Language. Oberon-2 :Translator. Amiga Oberon 3.00 :History. BlackMagic.mod 1.0 (24.6.93) [fSchwarz] initial release :History. 1.1 (2.7.93) [fSchwarz] added GadKey()/GadKeyA() :History. 1.2 (6.7.93) [fSchwarz] added Max2()/Min2() and :History. VisibleOfScreen() :History. 1.3 (6.7.93) [fSchwarz] removed EasyRequest(Args)(), :History. added SimpleRequest() / SimpleRequestArgs() :History. 1.4 (9.7.93) [fSchwarz] added Dos.IoErr support :History. for ReadArgs*(), added CmpToolNames(), ToolNameLen(), :History. GetToolValue(), WriteTTEntry(), FLPrintf(), FLPrintF(), :History. VFLPrintF(), Strlastn(i)cmp(), fixed minor bugs :History. 1.5 (20.7.93) [fSchwarz] moved varargs stuff to own :History. module BlackMagicVA, removed reqtools stuff, :History. added ClearMem() / ClearMemAPTR() :History. 1.6 (25.7.93) [fSchwarz] changed DynamicExtra to be :History. variable and accessable from other modules. :History. added external access toDynamicExtra, changed :History. DynExpand() to use Exec.CopyMem() and copy whole :History. array. :History. 1.7 (27.7.93) [fSchwarz] added GetTTYScreen(), fixed :History. BlackMagicVA <-> BlackMagic layout :Bugs. none known :Address. Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A. :Address. uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18 :Remark. Don't be afraid of this module's extent: OLink supports :Remark. selective linking - so only functions that you use are :Remark. included into your code. :Remark. As of Amiga Oberon Release 3.00: possible odd pointers to :Remark. array of char/byte: _don't_ compile with OddChk. The :Remark. compiler's options stack is broken as of Amiga-Oberon 3.00 --------------------------------------------------------------------------- *) (* $SET NODEBUG *) MODULE BlackMagic; (****** BlackMagic/--overview-- *********************************************** * * BlackMagic is a very versatile module designed for your relief * when dealing with Graphical User Interfaces, Workbench Interfacing, * dynamic-length strings, Localization, and more. Its Workbench argument * parsing functions are unique in the Amiga community, yet. In fact, it * provides you with all the flexibility and power of Dos.ReadArgs() * argument parsing while keeping up to the Workbench ToolTypes * design as stated in the Amiga User Interface Style Guide. It * also takes care of project ToolTypes overriding corresponding * tool ToolTypes entries. As an intended side effect, the parse * functions may also be alienated from their main purpose by making * them operate as inclusion- and/or exclusion-filters. For this * very purpose, a new dynamic ToolType array datatype has been * introduced for easy manipulation of the filtered ToolTypes. Similar * to the concept of dynamic ToolType arrays, a dynamic String type has * been introduced. As opposed to the one defined in the STRING Oberon-2 * support module supplied with the Amiga compiler, this one does not * require a garbage collector for resource deallocation. Both, the * dynamic ToolType array type as well as the dynamic String type are * implemented using the new open array concept introduced in Oberon-2. * There's another function which converts simple CLI arguments or a * string into a ToolType array you can manipulate with this module's * functions. * Furthermore two functions (ReadArgs()/FreeArgs()) have been made * available to the user, that provide a uniform interface to the Oberon * program's arguments no matter whether the program was started from * CLI or Workbench. * For your ease when dealing with the Operating System, functions for * string type conversion (LongStrPtr/Exec.STRPTR/ARRAY OF CHAR-Index * conversion functions) as well as a general pointer arithmetics * support functions have been supplied. * Another field of functions, BlackMagic provides, are sprintf()-like * functions for both, simple strings, as well as for the dynamic string * type of this module - and all of them provide real varargs argument * passing for the programmers ease, of course. Especially the varargs * dynamic string sprintf()-pendant DynAppendFmt()/DSPrintf() is all you * always missed in Amiga- Oberon, but never dared to think of in your * wildest dreams (yeah, you'll be nuts about it, when you'll use * DynAppendFmt()/DSPrintf() for your fist time, too;-)). After all, * as a bonus, locale.library's FormatString() front ends (var/vector args) * for dynamic strings are present, too - and they work without locale * librray, too (fallback to DSPrintf()). * Amongst BlackMagic's repertoire, there are functions for locking * windows, setting busy pointers, functions for easy retrieval of menus * and menu items that were created from GadTools/CreateMenusA(), and Last * but not least, versatile and brief support functions for localization/ * catalogs with an appertaining ARexx script to convert catalog definition * files (#?.cd) into the necessary Oberon source with string constants * definitions. * * Two final notes: First, in this documentation, the term is * always used as a synonym for . * Finally, some implementation details: BlackMagic's Arguments parsing * functions are implemented heavily using OOP (Object Orientated * Programming) techniques like type-bound functions, inheritance of * methods and dynamic binding. * *****************************************************************************) (****** BlackMagic/--legal-- ************************************************** * * LEGAL STATUS * BlackMagic is Freeware, Copyright © 1993 by F.Schwarz. All Rights * reserved. Freeware is an abbreviation for Freely Distributable * Copyrighted Software. That means, you may freely distribute this * software for non-profit-making purposes, and use it in your own * freely distributable software. However if you intend to use it * in commercial software or shareware you may only use it under the * condition you consider me to be a registred, legitimate user of * that software and you contact me before releasing that software. * * DISCLAIMER * Liability - what liability?? In fact, no liability whatsoever is * provided by the author of this software - this is generally known * as "USE AT YOUR OWN RISK" - and that is exactly what it means. * * DISTRIBUTION * This software may be distributed if only a _reasonable_ copying * fee is charged apart from the consts for the media it is copied to. * Furthermore, it may be included in Freely Distributable software * libraries like AMOK, etc, including CD-ROM versions of them. * * Contact addresses for bug reports, comments, inquiries or anything else: * * Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A. * email: uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18 * *****************************************************************************) IMPORT e := Exec, d: Dos, I: Intuition, gt: GadTools, u: Utility, wb: Workbench, ic: Icon, g: Graphics, loc: Locale, st: Strings, o: OberonLib, y: SYSTEM (* $IF DEBUG *) , NoGuru (* $END *) ; CONST (* $IF DEBUG *) defaultDynamicExtra = 0; (* $ELSE *) defaultDynamicExtra = 64; (* $END *) VAR DynamicExtra - : LONGINT; TYPE (* due to misdefinition of wb.WBArgumentsPtr: Ptr TO ARRAY 256!! OF ... *) WBArgumentsPtr * = UNTRACED POINTER TO ARRAY MAX(LONGINT) DIV 8-1 OF wb.WBArg; LongStrPtr * = UNTRACED POINTER TO ARRAY MAX (LONGINT)-1 OF CHAR; LStrPtr * = LongStrPtr; TTPtr * = UNTRACED POINTER TO ARRAY MAX (LONGINT) DIV 4-1 OF LongStrPtr; StrVecPtr * = TTPtr; NumVecPtr * = UNTRACED POINTER TO ARRAY MAX (LONGINT) DIV 4-1 OF UNTRACED POINTER TO LONGINT; DynStrPtr * = UNTRACED POINTER TO ARRAY OF CHAR; DynTTPtr * = UNTRACED POINTER TO ARRAY OF LongStrPtr; (* ReadArgsWB flags *) CONST ignoreTool * = 0; relPath * = 1; dontFill * = 3; doCD * = 4; ignoreProject * = 5; argFile * = 9; (* also propagated to to.Init(...,flags,...) *) argFiles * = 10; (* also propagated to to.Init(...,flags,...) *) noFullMulti * = 11; (* also propagated to to.Init(...,flags,...) *) noMultiMulti * = 12; (* also propagated to to.Init(...,flags,...) *) multiExclSep * = 13; (* also propagated to to.Init(...,flags,...) *) multiCommaSep * = 14; (* also propagated to to.Init(...,flags,...) *) disableSpecialNo * = 15; (* also propagated to to.Init(...,flags,...) *) (* DynAppendTT flags *) CONST createEmpty * = 0; (* create empty TT handle if NIL, otherwise NOP, ignore chr array *) numericArr = 1; (* for handling of LONGINT-Ptr arrays instead of LongStrPtr-Arrays! *) PROCEDURE^ AddPtr * (a, b: e.APTR): e.APTR; (****** BlackMagic/DynStrLen ************************************************** * * NAME * DynStrLen -- Return the length of a dynamic string * * SYNOPSIS * DynStrLen (dstr: DynStrPtr): LONGINT; * * FUNCTION * Returns the length of the string that is currently stored * in the dynamic, run-time allocated/expanded string array * represented by the passed dstr handle. Note that this * is NOT the actual current capacity of the dynamic array, i.e. * it is not the number of characters the array can store currently. * You may get that value by invoking the standard Oberon-2 function * LEN (dstr^) (only with a non-NIL dstr, of course!). * This function handles a NIL dstr handle correctly, returning null. * (which is the one and only raison d'être for this function, by * the way;-)) * * INPUTS * dstr - the dynamic string handle - may be NIL. * * RESULT * The length of the string stored in the dynamic string passed as * input parameter. * * SEE ALSO * DynExpand(), DynAppend(), DStrLPtr(), InitDynStr(), ResetDynStr() * *****************************************************************************) PROCEDURE DynStrLen * (dstr: DynStrPtr): LONGINT; BEGIN IF dstr = NIL THEN RETURN 0; END; RETURN st.Length (dstr^); END DynStrLen; (****** BlackMagic/DynExpand ************************************************** * * NAME * DynExpand -- Ensure a specified length of a dynamic char array * * SYNOPSIS * DynExpand (VAR string: DynStrPtr; len: LONGINT): BOOLEAN; * * FUNCTION * Make sure that a dynamic, run-time allocated/expanded character * array can hold at least len+1 characters while preserving its * current contents -- performs a reallocation of the dynamic char * array if its current length doesn't suffice. When a reallocation * takes place, the whole contents - not only the contents until the * first nul character- of the old dynamic char array is copied * into the new dynamic char array. This enables usage of this * function in conjunction with char buffers where nul is a valid * character, generally without sacrificing performance because * Exec.CopyMem() is usually _much_ faster than Oberon's COPY() * command. * * INPUTS * string - the dynamic char array (string) handle - may be NIL. * len - desired minimum length. In fact, it is made sure that * the dynamic string can store at least len+1 characters * because of the terminating null character. * * RESULT * TRUE - for success. * FALSE - if memory allocation fails - in this case the dynamic * char array and its handle are left unchanged. * * NOTES * See DynAppend() * * SEE ALSO * DynAppend(), DStrLPtr(), InitDynStr(), ResetDynStr() * *****************************************************************************) PROCEDURE DynExpand * (VAR string: DynStrPtr; len: LONGINT): BOOLEAN; VAR str1: DynStrPtr; BEGIN INC (len, 1); IF string # NIL THEN IF LEN (string^) >= len THEN RETURN TRUE; END; END; y.ALLOCATE (str1, len+DynamicExtra); (* add some extra space for less reallocs *) IF str1 = NIL THEN RETURN FALSE; END; IF string # NIL THEN e.CopyMem (string^, str1^, LEN (string^)); DISPOSE (string); ELSE str1^[0] := '\000'; END; string := str1; RETURN TRUE; END DynExpand; (****** BlackMagic/DynAppend ************************************************** * * NAME * DynAppend -- Append a string to a dynamic string * * SYNOPSIS * DynAppend (VAR string: DynStrPtr; append: ARRAY OF CHAR): BOOLEAN; * * FUNCTION * Appends a null-terminated char array string to a dynamic, run- * time allocated/expanded string - performs a reallocation of the * dynamic string if its length doesn't suffice to append the append * string. * * INPUTS * string - the dynamic string handle - may be NIL. * append - the string to be appended - may be empty. * * RESULT * TRUE - for success. * FALSE - if memory allocation fails - in this case the dynamic * string and its handle are left unchanged. * * NOTES * Make sure that your string handle is set to NIL before its first * reference in your code. (Amiga-Oberon does this for global * vars, for function vars unless you set the compiler flag * ClearVars to False, as well as for handles allocated by NEW()/ * SYSTEM.ALLOCATE()/OberonLib.Allocate() if (Exec.memClear IN * OberonLib.MemReqs) which is the default. This is not only true for * Dynamic String handles, but also for all other pointer vars. * To free the dynamic string's resources, just call * 'DISPOSE (string);'. * * SEE ALSO * DynInsert(), DynExpand(), DStrLPtr(), InitDynStr(), ResetDynStr() * *****************************************************************************) PROCEDURE DynAppend * (VAR string: DynStrPtr; append: ARRAY OF CHAR): BOOLEAN; VAR str1: DynStrPtr; (* $CopyArrays- *) BEGIN IF ~DynExpand (string, DynStrLen (string)+st.Length (append)+1) THEN RETURN FALSE; END; st.Append (string^, append); RETURN TRUE; END DynAppend; (****** BlackMagic/DynInsert ************************************************** * * NAME * DynInsert -- Insert a string in a dynamic string * * SYNOPSIS * DynInsert (VAR string: DynStrPtr; * at : LONGINT; * ins : ARRAY OF CHAR): BOOLEAN; * * FUNCTION * Inserts a null-terminated char array string in a dynamic, run- * time allocated/expanded string at a specific position - performs * a reallocation of the dynamic string if its length doesn't suffice * to insert the ins string. * * INPUTS * string - the dynamic string handle - may be NIL. * at - the position (starting at 0) at which the ins string * should be inserted in the dynamic string. Invalid * values cause this function to return failure * ins - the string to be inserted - may be empty. * * RESULT * TRUE - for success. * FALSE - if memory allocation fails or the specified insertion * position was invalid. In both cases the dynamic * string and its handle are left unchanged. * * NOTES * See DynAppend() * * SEE ALSO * DynAppend(), DynExpand(), DStrLPtr(), InitDynStr(), ResetDynStr() * *****************************************************************************) PROCEDURE DynInsert (VAR string: DynStrPtr; at : LONGINT; ins : ARRAY OF CHAR): BOOLEAN; VAR str1: DynStrPtr; (* $CopyArrays- *) BEGIN IF (at < 0) OR (at > DynStrLen (string)) THEN RETURN FALSE; END; IF ~DynExpand (string, DynStrLen (string)+st.Length (ins)+1) THEN RETURN FALSE; END; st.Insert (string^, at, ins); RETURN TRUE; END DynInsert; (****** BlackMagic/ResetDynStr ************************************************ * * NAME * ResetDynStr -- disposes a dynamic string if necessary and inits it. * * SYNOPSIS * ResetDynStr (VAR dstr: DynStrPtr): BOOLEAN; * * FUNCTION * Disposes the dynamic string if dstr is not NIL, and initializes it * in a way that the dstr dynamic string handle points to a nul string. * * INPUTS * string - the dynamic string handle - may be NIL. * * RESULT * TRUE - for success. * FALSE - if memory allocation fails - in this case the dynamic * string handle is set to NIL. * * NOTES * Make sure that your dstr handle is set to NIL before its first * reference in your code. (Amiga-Oberon does this for global * global, for function vars unless you set the compiler flag * ClearVars to False, as well as for handles allocated by NEW()/ * SYSTEM.ALLOCATE()/OberonLib.Allocate() if (Exec.memClear IN * OberonLib.MemReqs) which is the default. This is not only true for * Dynamic String handles, but also for all other pointer vars. * * SEE ALSO * InitDynStr(), DynExpand(), DynAppend() * *****************************************************************************) PROCEDURE ResetDynStr * (VAR dstr: DynStrPtr): BOOLEAN; BEGIN IF dstr # NIL THEN DISPOSE (dstr); END; RETURN DynAppend (dstr, ""); END ResetDynStr; (****** BlackMagic/InitDynStr ************************************************* * * NAME * InitDynStr -- inits a dynamic string IGNORING its handle's value * * SYNOPSIS * InitDynStr (VAR dstr: DynStrPtr): BOOLEAN; * * FUNCTION * Sets the dstr handle to NIL first while ignoring its hitherto value, * and initializes it then in a way that the dstr dynamic string handle * points to a nul string. If you call this function for every dynamic * string handle at the very beginning of your code, you ensure that * you may reference all dynamic strings' contents using dstr^. Note * however, that all functions of this module work fine with NIL- * Dynamic String handles as well! * * INPUTS * string - the dynamic string handle - may be NIL. * * RESULT * TRUE - for success. * FALSE - if memory allocation fails - in this case the dynamic * string handle is set to NIL. * * SEE ALSO * ResetDynStr(), DynExpand(), DynAppend() * *****************************************************************************) PROCEDURE InitDynStr * (VAR dstr: DynStrPtr): BOOLEAN; BEGIN dstr := NIL; RETURN DynAppend (dstr, ""); END InitDynStr; (****** BlackMagic/DStrLPtr ***************************************************** * * NAME * DStrLPtr -- Return a 'conventional' LongStrPtr to a dynamic string * DStrAPtr -- Return a 'conventional' Exec.APTR to a dynamic string * * SYNOPSIS * DStrLPtr (dstr: DynStrPtr): LongStrPtr; * DStrAPtr (dstr: DynStrPtr): Exec.APTR; * * FUNCTION * These functions return a LongStrPtr as defined in this module, resp. * an Exec.APTR, to the dynamic string passed as the function's * argument. A LongStrPtr is defined as an UNTRACED POINTER TO ARRAY * MAX(LONGINT) - 1 OF CHAR which should be in all possible cases * used instead of Exec.STRPTR, if you don't know the array * bound of the string. This keeps you from ugly runtime errors * you get when you manipulate Exec.STRPTR^ beyond the 256th char * element. (Exec.STRPTR is currently definded as ARRAY 256 OF CHAR) * Note however, that you have to use (* [Dollar]CopyArrays- *) for * your functions that have ARRAY OF CHAR parameters, you may pass * LongStrPtr^ to. * * INPUTS * dstr - the dynamic string handle - may be NIL. * * RESULT * a LongStrPtr / Exec.APTR pointing to the first char element of the * dstr or NIL if dstr is NIL. * * SEE ALSO * DynAppend(), StrIndex() * *****************************************************************************) PROCEDURE DStrLPtr * (dstr: DynStrPtr): LongStrPtr; BEGIN IF dstr = NIL THEN RETURN NIL; END; RETURN y.ADR (dstr^[0]); END DStrLPtr; PROCEDURE DStrAPtr * (dstr: DynStrPtr): e.APTR; BEGIN RETURN DStrLPtr (dstr); END DStrAPtr; (****** BlackMagic/StrIndex **************************************************** * * NAME * StrIndex -- Return a LongStrPtr to a string index. * StrIndexA -- Return an Exec.APTR to a string index. * * SYNOPSIS * StrIndex (str: ARRAY OF CHAR; n: LONGINT): LongStrPtr; * StrIndexA (str: ARRAY OF CHAR; n: LONGINT): Exec.APTR; * * FUNCTION * These functions return a LongStrPtr as defined in this module, * resp. an Exec.APTR, pointing to the nth element of the string str. * This function is extremely useful since there are thousands if * not millions of occasions where you need to pass an array of char * starting with a specific index of another string to a function, * especially when working with the Operating System. * Note however, that you have to use (* [Dollar]CopyArrays- *) for * your functions that have ARRAY OF CHAR parameters, you may pass * LongStrPtr^ to. * * INPUTS * str - the string to operate on * n - the ordinal index - may be even negative since no range * checking takes place * * RESULT * a LongStrPtr / Exec.APTR pointing to the nth char of the string. * * SEE ALSO * DStrLPtr() * *****************************************************************************) PROCEDURE StrIndex * (str: ARRAY OF CHAR; n: LONGINT): LongStrPtr; (* $CopyArrays- *) BEGIN RETURN AddPtr (y.ADR (str[0]), n); END StrIndex; PROCEDURE StrIndexA * (str: ARRAY OF CHAR; n: LONGINT): e.APTR; (* $CopyArrays- *) BEGIN RETURN StrIndex (str, n); END StrIndexA; (****** BlackMagic/StrToLStr ************************************************ * * NAME * StrToLStr - Typecast an Exec.STRPTR into a LongStrPtr * * SYNOPSIS * StrToLStr (str: Exec.STRPTR): LongStrPtr; * * FUNCTION * This function simply typecasts the str Exec.STRPTR passed into * a LongStrPtr which may be needed when dealing with Operating System * structures and functions whose STRPTR typed strings you want to * manipulate without disabling the compiler's range checking. * * INPUTS * str - the Exec.STRPTR which is to be typecasted - may be NIL. * * RESULT * the LongStrPtr * * NOTES * you should be able to pass an Exec.APTR to this function * * SEE ALSO * LStrToStr(), DStrLPtr(), StrIndex() * *****************************************************************************) PROCEDURE StrToLStr * (str: e.STRPTR): LongStrPtr; BEGIN RETURN AddPtr (str, 0); END StrToLStr; (****** BlackMagic/LStrToStr ************************************************ * * NAME * LStrToStr - Typecast a LongStrPtr into an Exec.STRPTR; * * SYNOPSIS * LStrToStr (lstr: LongStrPtr): Exec.STRPTR; * * FUNCTION * This function simply typecasts the lstr LongStrPtr passed into * an Exec.STRPTR which may be needed when dealing with Operating * System structures and functions that expect Exec.STRPTRs. * * INPUTS * lstr - the LongStrPtr that is to be typecasted - may be NIL. * * RESULT * the Exec.STRPTR * * NOTES * you should be able to pass an Exec.APTR to this function * * SEE ALSO * StrToLStr(), DStrLPtr(), StrIndex() * *****************************************************************************) PROCEDURE LStrToStr * (lstr: LongStrPtr): e.STRPTR; BEGIN RETURN AddPtr (lstr, 0); END LStrToStr; (****** BlackMagic/DynAppendTT ************************************************* * * NAME * DynAppendTT -- Append a string to a dynamic ToolType array. * * SYNOPSIS * DynAppendTT (VAR tt : DynTTPtr; * append : ARRAY OF y.BYTE; * flags : SET ): BOOLEAN; * * FUNCTION * This function adds a string to a dynamically, run-time allocated, * NIL-terminated array of pointers to null-terminated strings. * space for the string is allocated, and the string is copied. * A dynamic ToolType array handle (DynTTPtr) is defined as an * UNTRACED POINTER TO ARRAY OF LongStrPtr. If the array size is * insufficient, this function reallocates it. * * INPUTS * tt - the dynamic ToolType array handle - may be NIL. * append - the string to be appended * flags - currently only one flag is defined: createEmpty. * If you specify it, the append string is ignored, and * this function just returns TRUE except when the * ToolType array handle is NIL - in that case it will * allocate a minimal ToolType array and write NIL into its * first element, indicating that the array contains no * elements. * * RESULT * TRUE - for success. * FALSE - if memory allocation failed - in this case the contents * of the ToolType array - NOT necessarily the handle * itself - is left unchanged. * * NOTES * You should initialize the ToolType array handle with * 'tt := MIL;' before your first call to DynAppendTT(). * * It is of utmost importance that you only specify the flag(s) * documented along with this function for the flags argument since * otherwise unexpected things may happen to the system, to the * computer, and finally to yourself (you may get a nervous, violent * fit of temper, run amok, or even commit suicide due to your machine * crashing in the very moment when want to save save your hitherto * unsaved source for your new great, nifty, revolutionary, * trailblazing, unprecedented new software project!)) - Just kidding, * girls & boys, currently no severe things may result, but this may * well change in the future! * * SEE ALSO * FreeDynTT(), WriteTTEntry(), RemDynTTEntry(), TTAPtr() * *****************************************************************************) PROCEDURE DynAppendTT * (VAR tt : DynTTPtr; append : ARRAY OF y.BYTE; flags : SET ): BOOLEAN; VAR tt1 : DynTTPtr; origlen, i : LONGINT; ls : LongStrPtr; (* $CopyArrays- *) BEGIN origlen := 0; ls := y.ADR (append); IF tt # NIL THEN IF createEmpty IN flags THEN RETURN TRUE; END; LOOP FOR i:=0 TO LEN (tt^)-1 DO IF tt^[i] = NIL THEN origlen := i; EXIT; END; END; RETURN FALSE; END; END; LOOP IF tt # NIL THEN IF LEN (tt^) >= origlen+2 THEN EXIT; END; END; y.ALLOCATE (tt1, origlen+2+DynamicExtra DIV 4); (* add some extra space for less reallocs *) IF tt1 = NIL THEN RETURN FALSE; END; IF tt # NIL THEN FOR i:=0 TO origlen DO tt1^[i] := tt^[i]; END; DISPOSE (tt); END; tt := tt1; EXIT; END; tt [origlen+1] := NIL; IF createEmpty IN flags THEN tt [origlen] := NIL; ELSE IF numericArr IN flags THEN o.Allocate (tt [origlen], SIZE (LONGINT)); ELSE o.Allocate (tt [origlen], st.Length (ls^)+1); END; IF tt [origlen] = NIL THEN RETURN FALSE; END; IF numericArr IN flags THEN e.CopyMem (append, tt [origlen]^, SIZE (LONGINT)); ELSE COPY (ls^, tt [origlen]^); END; END; RETURN TRUE; END DynAppendTT; (****** BlackMagic/WriteTTEntry *********************************************** * * NAME * WriteTTEntry -- Write a TTEntry into a dynamic ToolType array. * * SYNOPSIS * WriteTTEntry (VAR dtt: DynTTPtr; * Entry : LONGINT; * str : ARRAY OF CHAR): BOOLEAN; * * FUNCTION * This function writes a string at a specific position to a * dynamically, run-time allocated, NIL-terminated array of * pointers to null-terminated strings. space for the * string is allocated, and the string is copied. A potential * old string is deleted first. A dynamic ToolType array * handle (DynTTPtr) is defined as an UNTRACED POINTER TO * ARRAY OF LongStrPtr. If the array size is insufficient, * this function reallocates it. * * INPUTS * dtt - the ToolType array handle - may be NIL. * Entry - The ordinal number of the entry where the string * is to be written, starting at zero, or -1 to * append at the end of the ToolType array. * str - the string to be appended * * RESULT * TRUE - for success. * FALSE - if memory allocation failed - in this case the contents * of the ToolType array - NOT necessarily the handle * itself - is left unchanged. * * SEE ALSO * DynAppendTT(), RemDynTTEntry(), FreeDynTT(), TTAPtr() * *****************************************************************************) PROCEDURE WriteTTEntry * (VAR dtt: DynTTPtr; Entry : LONGINT; str : ARRAY OF CHAR): BOOLEAN; VAR i : LONGINT; ls: LongStrPtr; (* $CopyArrays- *) BEGIN ls := NIL; i := 0; IF dtt # NIL THEN WHILE dtt[i] # NIL DO INC (i); END; END; IF (Entry < -1) OR (Entry > i) THEN RETURN FALSE; END; IF (Entry = -1) OR (Entry = i) THEN RETURN DynAppendTT (dtt, str, {}) END; IF dtt = NIL THEN RETURN FALSE; END; o.Allocate (ls, st.Length (str)+1); IF ls = NIL THEN RETURN FALSE; END; COPY (str, ls^); DISPOSE (dtt[Entry]); dtt[Entry] := ls; RETURN TRUE; END WriteTTEntry; (****** BlackMagic/FreeDynTT *************************************************** * * NAME * FreeDynTT -- Frees a ToolType array handle's resources & resets it. * * SYNOPSIS * FreeDynTT (VAR dtt: DynTTPtr); * * FUNCTION * This function frees all resources that may have been allocated * for a ToolType array and reinitializes its handle to NIL. * It is save to invoke this function with a NIL ToolType array * handle. * * INPUTS * dtt - the ToolType array handle - may be NIL. * * SEE ALSO * AppendDynTT(), RemDynTTEntry(), TTAPtr() * *****************************************************************************) PROCEDURE FreeDynTT * (VAR dtt: DynTTPtr); VAR i: LONGINT; BEGIN IF dtt = NIL THEN RETURN; END; i := 0; LOOP IF i>=LEN (dtt^) THEN EXIT; END; IF dtt^[i] = NIL THEN EXIT; END; DISPOSE (dtt^[i]); INC (i); END; DISPOSE (dtt); END FreeDynTT; (****** BlackMagic/RemDynTTEntry *********************************************** * * NAME * RemDynTTEntry -- Remove an entry from a dynamic ToolType array. * * SYNOPSIS * RemDynTTEntry (dtt: DynTTPtr; Entry: LONGINT): BOOLEAN; * * FUNCTION * This function removes an entry from a dynamic ToolType array. * Removes the 'Entrieth' entry (count starts at 0) or the last * entry if Entry is -1, and deallocates the space for it. * This function is safe to call with insensible parameters like * NIL ToolType array handles, empty ToolType arrays, or invalid Entry * values. In these cases, it will return FALSE, otherwise TRUE. * * INPUTS * dtt - the ToolType array handle - may be NIL. * Entry - The ordinal number of the entry to be removed, starting * at zero, or -1 to remove the last entry. * * RESULT * TRUE - for success. * FALSE - for 'insensible' parameters * * SEE ALSO * DynAppendTT(), FreeDynTT(), TTAPtr() * *****************************************************************************) PROCEDURE RemDynTTEntry * (dtt: DynTTPtr; Entry: LONGINT): BOOLEAN; VAR i,j: LONGINT; BEGIN IF dtt = NIL THEN RETURN FALSE; END; i := 0; WHILE dtt[i] # NIL DO INC (i); END; DEC (i); IF Entry = -1 THEN Entry := i; END; IF (Entry < 0) OR (Entry > i) THEN RETURN FALSE; END; DISPOSE (dtt[Entry]); FOR j := Entry TO i DO dtt[j] := dtt[j+1]; END; RETURN TRUE; END RemDynTTEntry; (****** BlackMagic/TTAPtr ****************************************************** * * NAME * TTAptr -- Returns a conventional pointer to a dynamic ToolType array * * SYNOPSIS * TTAPtr (dtt: DynTTPtr): TTPtr; * * FUNCTION * This function returns a TTPtr as defined in this module * to the dynamic ToolType array passed as the function's argument. * A TTPtr is defined as an UNTRACED POINTER TO ARRAY MAX(LONGINT) * DIV 4 - 1 OF LongStrPtr. It is especially useful to pass it to * or to convert function results frm other functions that deal with * ToolTypes such as the icon.library's, etc. * Since this module's ReadArgs() functions return structure * RDArgsWB contain two dynamic ToolType array handles, which you may * use or manipulate with all of this module's documented dynamic * ToolType array handle related functions, you may convert * them to conventional ToolType array handles using this function. * * INPUTS * dtt - the dynamic ToolType array handle - may be NIL. * * RESULT * The respective 'conventional' TTPtr equivalent. * * SEE ALSO * DynAppendTT(), FreeDynTT(), RemDynTTEntry() * *****************************************************************************) PROCEDURE TTAPtr * (dtt: DynTTPtr): TTPtr; BEGIN IF dtt = NIL THEN RETURN NIL; END; RETURN y.ADR (dtt^[0]); END TTAPtr; CONST (* type modifiers for template options *) ignoreC = 'I'; strC = '\x00'; numC = 'N'; switchC = 'S'; toggleC = 'T'; multiNumC= '\x00'; remainC = 'F'; multiC = 'M'; (* attribute modifiers for template options *) keyC = 'K'; alwaysC = 'A'; (* type values *) ignore = 0; str = 1; num = 2; switch = 3; toggle = 4; multiNum= 5; remain = 6; multi = 7; maxType = multi; (* highest type value *) AddEmptyName = maxType+1; (* attribute set elements *) keyAttr = 0; alwaysAttr = 1; numAttr = 2; TYPE TmplTypArrT = ARRAY maxType+1 OF CHAR; CONST tmplTypes = TmplTypArrT ('I\000NST\000FM'); tmplTypesSansNum = TmplTypArrT ('I\000\000ST\000FM'); (* required for special /M/N handling *) TYPE TemplOptPtr = UNTRACED POINTER TO TemplOpt; TemplOpt = RECORD name : DynTTPtr; activeName: LongStrPtr; flags : SET; pri : LONGINT; (* was: type: LONGINT; *) used : BOOLEAN; entry : UNTRACED POINTER TO e.APTR; END; TemplIgnore = RECORD (TemplOpt) END; TemplStrT = RECORD (TemplOpt) string: DynStrPtr; END; TemplStr = RECORD (TemplStrT) END; TemplRemain = RECORD (TemplStrT) END; TemplSwitchT = RECORD (TemplOpt) END; TemplSwitch = RECORD (TemplSwitchT) END; TemplToggle = RECORD (TemplSwitchT) END; TemplNum = RECORD (TemplOpt) num: LONGINT; END; TemplMultiT = RECORD (TemplOpt) argsArr: DynTTPtr; END; TemplMulti = RECORD (TemplMultiT) END; TemplMultiNum = RECORD (TemplMultiT) END; TemplArrT = UNTRACED POINTER TO ARRAY OF TemplOptPtr; RDArgsPtr * = UNTRACED POINTER TO RDArgs; RDArgs * = RECORD END; RDArgsWBPtr * = UNTRACED POINTER TO RDArgsWB; RDArgsWB * = RECORD (RDArgs) opts : TemplArrT; oldCD : d.FileLockPtr; (* NIL is a valid oldCD directory! *) validCD : BOOLEAN; (* thus this entry... *) ttIncl * : DynTTPtr; ttRest * : DynTTPtr; END; RDArgsCLIPtr * = UNTRACED POINTER TO RDArgsCLI; RDArgsCLI = RECORD (RDArgs) rda: d.RDArgsPtr; END; PROCEDURE^ FreeTemplArr (Arr: TemplArrT); PROCEDURE (VAR rda: RDArgs) Free(); BEGIN END Free; PROCEDURE (VAR rda: RDArgsWB) Free(); BEGIN IF rda.opts = NIL THEN RETURN; END; IF rda.validCD THEN y.SETREG (0, d.CurrentDir (rda.oldCD)); END; FreeTemplArr (rda.opts); FreeDynTT (rda.ttRest); FreeDynTT (rda.ttIncl); END Free; PROCEDURE (VAR rda: RDArgsCLI) Free(); BEGIN IF rda.rda = NIL THEN RETURN; END; d.FreeArgs (rda.rda); rda.rda := NIL; END Free; (****** BlackMagic/ToolNameLen ************************************************ * * NAME * ToolNameLen -- Get length of ToolType's name from a tt argument str * * SYNOPSIS * ToolNameLen (tt: ARRAY OF CHAR): LONGINT; * * FUNCTION * Returns the length of the name part of a ToolType arguemnt * string. This is done by checking for the first occurence of * either nul or '='. * * INPUTS * tt - the ToolType argument string * * RESULT * the length of the ToolType's name part. * * SEE ALSO * GetToolValue(), ToolNameLen() * *****************************************************************************) PROCEDURE ToolNameLen * (tt: ARRAY OF CHAR): LONGINT; VAR ii: LONGINT; (* $CopyArrays- *) BEGIN ii := 0; WHILE (tt[ii] # '=') & (tt[ii] # '\000') DO INC (ii); END; RETURN ii; END ToolNameLen; PROCEDURE (VAR to: TemplOpt) ToolNameLen (tt: ARRAY OF CHAR): LONGINT; (* $CopyArrays- *) BEGIN IF to.activeName # NIL THEN IF to.activeName^ = "" THEN RETURN 0; END; END; RETURN ToolNameLen (tt); END ToolNameLen; (****** BlackMagic/CmpToolNames ************************************************ * * NAME * CmpToolNames -- test two ToolTypes's names for equality * * SYNOPSIS * CmpToolNames (tt1, tt2: ARRAY OF CHAR): BOOLEAN; * * FUNCTION * Compares two ToolTypes' names * * INPUTS * tt1,tt2 - the ToolType argument strings * * RESULT * TRUE if the ToolTypes' names are identical (case insensitive), * FALSE otherwise. * * SEE ALSO * ToolNameLen(), GetToolValue() * *****************************************************************************) PROCEDURE CmpToolNames * (tt1, tt2: ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *) BEGIN IF ToolNameLen (tt1) = ToolNameLen (tt2) THEN IF u.Strnicmp (tt1, tt2, ToolNameLen (tt1)) = 0 THEN RETURN TRUE; END; END; RETURN FALSE; END CmpToolNames; (****** BlackMagic/GetToolValue *********************************************** * * NAME * GetToolValue -- Return LongStrPtr to value part of tt argument str * * SYNOPSIS * GetToolValue (tt: ARRAY OF CHAR): LongStrPtr; * * FUNCTION * Returns a LongStrPtr to the value part of the provided ToolType * argument string. This is done by getting the length of the name * part with ToolNameLen(), and returning either a pointer * to the next character, or if the next character is '=' a pointer * to the character right after the next charcter. * * INPUTS * tt - the ToolType argument string * * RESULT * the LongStrPtr to the value part of the ToolType * * SEE ALSO * ToolNameLen(), CmpToolNames() * *****************************************************************************) PROCEDURE GetToolValue * (tt: ARRAY OF CHAR): LongStrPtr; VAR l: LONGINT; (* $CopyArrays- *) BEGIN l := ToolNameLen (tt); IF tt[l] = '=' THEN INC (l); END; RETURN StrIndex (tt, l); END GetToolValue; PROCEDURE (VAR to: TemplOpt) GetToolValue (tt: ARRAY OF CHAR): LongStrPtr; (* $CopyArrays- *) BEGIN IF to.activeName # NIL THEN IF to.activeName^ = "" THEN RETURN StrIndex (tt, 0); END; END; RETURN GetToolValue (tt); END GetToolValue; PROCEDURE (VAR to: TemplOpt) Free (); BEGIN FreeDynTT (to.name); END Free; PROCEDURE (VAR ts: TemplStrT) Free (); BEGIN ts.Free^ (); IF ts.string # NIL THEN DISPOSE (ts.string); END; END Free; PROCEDURE (VAR tm: TemplMultiT) Free (); BEGIN tm.Free^ (); FreeDynTT (tm.argsArr); END Free; PROCEDURE (VAR to: TemplOpt) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; VAR s : DynStrPtr; i,j,k: LONGINT; ls : LongStrPtr; PROCEDURE CleanUp (success: BOOLEAN): BOOLEAN; BEGIN IF s # NIL THEN DISPOSE (s); END; IF ~success THEN FreeDynTT (to.name); END; RETURN success; END CleanUp; (* $CopyArrays- *) BEGIN s := NIL; to.name := NIL; to.activeName := NIL; to.flags := flags; to.used := FALSE; to.entry := y.ADR (Res); IF ~DynAppend (s, Name) THEN RETURN CleanUp (FALSE); END; s[0] := CHR (0); j := 0; i := 0; LOOP IF (Name[i] = '=') OR (Name[i] = CHR (0)) THEN st.Cut (Name, j, i-j, s^); k := 0; WHILE TotNames[k] # NIL DO IF (u.Stricmp (s^, TotNames[k]^) = 0) & ~(to IS TemplIgnore) THEN RETURN CleanUp (FALSE); END; INC (k); END; IF s^ = "" THEN IF (to.pri > maxType) OR (keyAttr IN to.flags) THEN RETURN CleanUp (FALSE); END; END; IF ~DynAppendTT (to.name, s^, {}) THEN RETURN CleanUp (FALSE); END; IF ~(to IS TemplIgnore) THEN IF ~DynAppendTT (TotNames, s^, {}) THEN RETURN CleanUp (FALSE); END; IF s^ = "" THEN to.pri := to.pri + AddEmptyName; END; END; j := i+1; END; IF Name[i] = CHR (0) THEN EXIT; END; INC (i); END; IF to.pri > maxType THEN (* move empty name to the end of array *) i := 0; WHILE to.name[i] # NIL DO IF to.name[i]^ = "" THEN j := i; END; INC (i); END; DEC (i); ls := to.name[i]; to.name[i] := to.name[j]; to.name[j] := ls; END; RETURN CleanUp (TRUE); END Init; PROCEDURE (VAR ts: TemplStrT) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN ts.string := NIL; RETURN ts.Init^ (Name, Res, flags, TotNames); END Init; PROCEDURE (VAR ts: TemplStr) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN ts.pri := str; RETURN ts.Init^ (Name, Res, flags, TotNames); END Init; PROCEDURE (VAR ts: TemplSwitch) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN ts.pri := switch; IF ~ts.Init^ (Name, Res, flags, TotNames) THEN RETURN FALSE; END; IF ts.pri > maxType THEN ts.Free(); RETURN FALSE; END; (* no empty name please *) RETURN TRUE; END Init; PROCEDURE (VAR tn: TemplNum) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames : DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN tn.pri := num; RETURN tn.Init^ (Name, Res, flags, TotNames); END Init; PROCEDURE (VAR ti: TemplIgnore) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames : DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN ti.pri := ignore; flags := {}; RETURN ti.Init^ (Name, Res, flags, TotNames); END Init; PROCEDURE (VAR tg: TemplToggle) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN tg.pri := toggle; IF ~tg.Init^ (Name, Res, flags, TotNames) THEN RETURN FALSE; END; IF tg.pri > maxType THEN tg.Free(); RETURN FALSE; END; (* no empty name please *) RETURN TRUE; END Init; PROCEDURE (VAR tr: TemplRemain) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN tr.pri := remain; RETURN tr.Init^ (Name, Res, flags, TotNames); END Init; PROCEDURE (VAR tm: TemplMultiT) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN tm.argsArr := NIL; RETURN tm.Init^ (Name, Res, flags, TotNames); END Init; PROCEDURE (VAR tm: TemplMulti) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN tm.pri := multi; RETURN tm.Init^ (Name, Res, flags, TotNames); END Init; PROCEDURE (VAR tm: TemplMultiNum) Init (Name : ARRAY OF CHAR; VAR Res : y.BYTE; flags : SET; VAR TotNames: DynTTPtr ): BOOLEAN; (* $CopyArrays- *) BEGIN tm.pri := multiNum; RETURN tm.Init^ (Name, Res, flags, TotNames); END Init; PROCEDURE DisposeTemplOpt (VAR to: TemplOptPtr); BEGIN IF to = NIL THEN RETURN END; to.Free (); to := NIL; END DisposeTemplOpt; (* CmpTT flags *) CONST specialNo = 0; PROCEDURE CmpTT (s : DynTTPtr; tt: ARRAY OF CHAR; flags: SET): LongStrPtr; VAR i : LONGINT; ls : LongStrPtr; offs : LONGINT; (* $CopyArrays- *) BEGIN IF s = NIL THEN RETURN NIL; END; FOR i := 0 TO LEN (s^)-1 DO IF s[i] = NIL THEN RETURN NIL; END; IF specialNo IN flags THEN IF u.Strnicmp ("NO", s[i]^, 2) = 0 THEN ls := y.ADR (s[i] [2]); IF (u.Strnicmp (ls^, tt, st.Length (ls^)) = 0) & (ToolNameLen (tt) = st.Length (ls^)) THEN RETURN s[i]; END; END; IF u.Strnicmp ("NO", tt, 2) = 0 THEN ls := y.ADR (tt[2]); IF (u.Strnicmp (s[i]^, ls^, st.Length (s[i]^)) = 0) & (ToolNameLen (ls^) = st.Length (s[i]^)) THEN RETURN s[i]; END; END; ELSE IF (s[i]^ = "") OR ((u.Strnicmp (s[i]^, tt, ToolNameLen (tt)) = 0) & (st.Length (s[i]^) = ToolNameLen (tt))) THEN RETURN s[i]; END; END; END; (* FOR *) RETURN NIL; END CmpTT; (* to.Process return codes *) CONST fail = 0; ok = 1; okSwitchT = 2; okSpecNo = 3; (* to.Cmp return codes *) CONST notFound = 0; found = 1; foundEmpty = 2; foundNoSpc = 3; foundSwitchT = 4; PROCEDURE (VAR to: TemplOpt) Cmp (tt : ARRAY OF CHAR; status: LONGINT ): LONGINT; VAR (* $CopyArrays- *) BEGIN IF status # fail THEN RETURN notFound; END; to.activeName := CmpTT (to.name, tt, {}); IF to.activeName = NIL THEN RETURN notFound; ELSIF to.activeName^ = "" THEN RETURN foundEmpty; ELSE RETURN found; END; END Cmp; PROCEDURE (VAR ti: TemplIgnore) Cmp (tt : ARRAY OF CHAR; status: LONGINT ): LONGINT; VAR (* $CopyArrays- *) BEGIN RETURN notFound; END Cmp; PROCEDURE (VAR ts: TemplSwitchT) Cmp (tt : ARRAY OF CHAR; status: LONGINT ): LONGINT; VAR s : LongStrPtr; (* $CopyArrays- *) BEGIN IF status # okSwitchT THEN IF ts.Cmp^ (tt, fail) = found THEN RETURN foundSwitchT; END; (* foundEmpty impossible for TemplSwitchT! *) END; IF (status = okSpecNo) OR (disableSpecialNo IN ts.flags) THEN RETURN notFound; END; ts.activeName := CmpTT (ts.name, tt, {specialNo}); IF ts.activeName = NIL THEN RETURN notFound; END; s := ts.GetToolValue (tt); IF (s^ = "") OR ic.MatchToolValue (s^, "FALSE") OR ic.MatchToolValue (s^, "NO") OR ic.MatchToolValue (s^, "TRUE") OR ic.MatchToolValue (s^, "YES") THEN RETURN foundNoSpc; END; RETURN notFound; END Cmp; PROCEDURE (VAR to: TemplOpt) Process (tt: ARRAY OF CHAR): LONGINT; (* $CopyArrays- *) BEGIN RETURN fail; END Process; PROCEDURE (VAR ts: TemplStr) Process (tt: ARRAY OF CHAR): LONGINT; (* $CopyArrays- *) BEGIN IF ts.used THEN RETURN fail; END; IF ~DynAppend (ts.string, ts.GetToolValue (tt)^) THEN RETURN fail; END; ts.entry^ := DStrLPtr (ts.string); ts.used := TRUE; RETURN ok; END Process; PROCEDURE (VAR tr: TemplRemain) Process (tt: ARRAY OF CHAR): LONGINT; (* $CopyArrays- *) BEGIN IF tr.used & (noFullMulti IN tr.flags) THEN RETURN fail; END; IF tr.string # NIL THEN IF ~DynAppend (tr.string, " ") THEN RETURN fail; END; END; IF ~DynAppend (tr.string, tr.GetToolValue (tt)^) THEN RETURN fail; END; tr.entry^ := DStrLPtr (tr.string); tr.used := TRUE; RETURN ok; END Process; PROCEDURE (VAR ts: TemplSwitch) Process (tt: ARRAY OF CHAR): LONGINT; VAR val : LONGINT; specialno: BOOLEAN; (* $CopyArrays- *) BEGIN IF ts.used THEN RETURN fail; END; specialno := CmpTT (ts.name, tt, {}) = NIL; val := I.LTRUE; LOOP IF ts.GetToolValue (tt)^ = "" THEN EXIT END; IF ic.MatchToolValue (ts.GetToolValue (tt)^, "TRUE") OR ic.MatchToolValue (ts.GetToolValue (tt)^, "YES") THEN IF ic.MatchToolValue (ts.GetToolValue (tt)^, "FALSE") OR ic.MatchToolValue (ts.GetToolValue (tt)^, "NO") THEN RETURN fail; END; EXIT; END; IF ~ic.MatchToolValue (ts.GetToolValue (tt)^, "FALSE") & ~ic.MatchToolValue (ts.GetToolValue (tt)^, "NO") THEN RETURN fail; END; val := I.LFALSE; EXIT; END; IF specialno THEN IF val = I.LTRUE THEN val := I.LFALSE; ELSE val := I.LTRUE; END; END; ts.entry^ := val; ts.used := TRUE; IF specialno THEN RETURN okSpecNo; ELSE RETURN okSwitchT; END; END Process; PROCEDURE (VAR tg: TemplToggle) Process (tt: ARRAY OF CHAR): LONGINT; VAR val : LONGINT; specialno : BOOLEAN; (* $CopyArrays- *) BEGIN IF tg.used THEN RETURN fail; END; specialno := CmpTT (tg.name, tt, {}) = NIL; val := I.LTRUE; LOOP IF tg.GetToolValue (tt)^ = "" THEN IF ~specialno THEN IF tg.entry^ = 0 THEN val := I.LTRUE; ELSE val := I.LFALSE; END; END; EXIT; END; IF ic.MatchToolValue (tg.GetToolValue (tt)^, "TRUE") OR ic.MatchToolValue (tg.GetToolValue (tt)^, "YES") THEN IF ic.MatchToolValue (tg.GetToolValue (tt)^, "FALSE") OR ic.MatchToolValue (tg.GetToolValue (tt)^, "NO") THEN RETURN fail; END; EXIT; END; IF ~ic.MatchToolValue (tg.GetToolValue (tt)^, "FALSE") & ~ic.MatchToolValue (tg.GetToolValue (tt)^, "NO") THEN RETURN fail; END; val := I.LFALSE; EXIT; END; IF specialno THEN IF val = I.LTRUE THEN val := I.LFALSE; ELSE val := I.LTRUE; END; END; tg.entry^ := val; tg.used := TRUE; IF specialno THEN RETURN okSpecNo; ELSE RETURN okSwitchT; END; END Process; (****** BlackMagic/StrToLong ************************************************ * * NAME * StrToLong - convert (hexa)decimal string to integer representation * * SYNOPSIS * StrToLong (str: ARRAY OF CHAR; VAR result: LONGINT): BOOLEAN; * * FUNCTION * StrToLong converts a (hexa)decimal string representatation of an * integer into an integer. Leading white space chars are skipped, * then a sign char ('+','-') may occur, followed by decimal digits * or a '0x', '0X' or '[Dollar]' hex identifier followed by hex digits. * After the digits sequence, any number of white space chars may * terminate the string. * * INPUTS * str - the string holding the number * result - the variable that will hold the resulting integer * if a valid number is read. * * RESULT * TRUE if a number was successfully read into the result variable, * false otherwise * FALSE if an error occurred. In that case the result variable holds * the generated number at the very stage when the error occurred. * ****************************************************************************) PROCEDURE StrToLong * (str: ARRAY OF CHAR; VAR result: LONGINT): BOOLEAN; VAR i: LONGINT; c: INTEGER; neg: BOOLEAN; hex: BOOLEAN; base: INTEGER; (* $CopyArrays- $OvflChk- *) BEGIN result := 0; i := 0; neg := FALSE; hex := FALSE; WHILE (str[i] = ' ') OR (str[i] = '\t') DO INC (i); END; CASE str[i] OF '+': INC (i); | '-': neg := TRUE; INC (i); ELSE END; CASE str[i] OF '$': hex := TRUE; INC (i); | '0': IF CAP(str[i+1])='X' THEN hex := TRUE; INC (i,2); END; ELSE END; IF ~hex THEN base := 10; ELSE base := 16; END; LOOP c := ORD (CAP (str[i])); CASE c OF ORD('0')..ORD('9'): c := c - ORD ('0'); | ORD('A')..ORD('F'): IF ~hex THEN y.SETREG (0, d.SetIoErr (d.badNumber)); RETURN FALSE; END; c := c - ORD ('A') + 10; ELSE LOOP CASE str[i] OF CHR (0) : IF neg THEN result := - result; END; RETURN TRUE; | ' ', '\t': INC (i); | ELSE y.SETREG (0, d.SetIoErr (d.badNumber)); RETURN FALSE; END; END; END; result := base * result + c; INC (i); END; END StrToLong; (* $OvflChk= *) PROCEDURE (VAR tn: TemplNum) Process (tt: ARRAY OF CHAR): LONGINT; (* $CopyArrays- *) BEGIN IF tn.used THEN RETURN fail; END; IF ~StrToLong (tn.GetToolValue (tt)^, tn.num) THEN RETURN fail; END; tn.entry^ := y.ADR (tn.num); tn.used := TRUE; RETURN ok; END Process; PROCEDURE (VAR tm: TemplMultiT) Process (tt: ARRAY OF CHAR): LONGINT; VAR ds : DynStrPtr; s1 : LongStrPtr; c1,c2,i : LONGINT; num : LONGINT; PROCEDURE CleanUp(); BEGIN IF ds # NIL THEN DISPOSE (ds); END; WHILE i>0 DO IF RemDynTTEntry (tm.argsArr, -1) THEN END; DEC (i); END; END CleanUp; PROCEDURE ArgFil (): BOOLEAN; BEGIN RETURN ((u.Stricmp (tm.activeName^, "FILE")=0) & (argFile IN tm.flags)) OR ((u.Stricmp (tm.activeName^, "FILES")=0) & (argFiles IN tm.flags)); END ArgFil; (* $CopyArrays- *) BEGIN ds := NIL; i := 0; c1 := 0; c2 := 0; s1 := NIL; IF tm.used & (noMultiMulti IN tm.flags) & ~ArgFil() THEN CleanUp(); RETURN fail; END; s1 := tm.GetToolValue (tt); IF ~DynAppend (ds, s1^) THEN CleanUp(); RETURN fail; END; ds[0] := CHR (0); LOOP IF ((((s1[c2] = ',') & (multiCommaSep IN tm.flags)) OR ((s1[c2] = '!') & (multiExclSep IN tm.flags))) & ~ArgFil()) OR (s1[c2] = CHR (0)) THEN st.Cut (s1^, c1, c2-c1, ds^); WITH tm: TemplMultiNum DO IF ~StrToLong (ds^, num) THEN CleanUp(); RETURN fail; END; IF ~DynAppendTT (tm.argsArr, num, {numericArr}) THEN CleanUp(); RETURN fail; END; | tm: TemplMulti DO IF ~DynAppendTT (tm.argsArr, ds^, {}) THEN CleanUp(); RETURN fail; END; END; INC (i); IF s1[c2] = CHR (0) THEN EXIT; END; c1 := c2+1; END; INC (c2); END; (* LOOP *) i := 0; tm.entry^ := TTAPtr (tm.argsArr); CleanUp(); tm.used := TRUE; RETURN ok; END Process; PROCEDURE FreeTemplArr (Arr: TemplArrT); VAR i: LONGINT; BEGIN IF Arr = NIL THEN RETURN; END; FOR i := 0 TO LEN (Arr^)-1 DO IF Arr[i] # NIL THEN Arr[i].Free(); DISPOSE (Arr[i]); END; END; DISPOSE (Arr); END FreeTemplArr; (****** BlackMagic/ReadArgsTT ************************************************* * * NAME * ReadArgsTT -- Parse ToolType's input similar to Dos.ReadArgs() * * SYNOPSIS * ReadArgsTT (tmpl : ARRAY OF CHAR; * args : ARRAY OF y.BYTE; * ttTool, ttProject: TTPtr; * flags : SET ): RDArgsWBPtr; * * FUNCTION * This function is a very versatile and powerful ToolTypes parse * routine, supplying you with all the flexibility of current * Dos.ReadArgs, plus access to the ToolTypes that weren't used * to fill the argument fields, as well as to the ones used. * This function is also well-suited for filtering ToolTypes, * manipulating the ToolTypes of one or more DiskObjects, merging * ToolTypes of two DiskObjects into one ToolType array, etc. * The aim of this function was also to follow the Amiga User Style * Guide's claim that the project's ToolTypes should be merged with * the tool's ToolTypes, while the project's ToolTypes supercede the * tool's ones, etc. This function may be controlled using several * flags, resulting in thorough-going configurability of its behaviour * in fields like handling of /M,/F,/T & /S options. Also this function * is quite fool-proof to a certain extent, and accepts only sensible * command line templates. * * INPUTS * tmpl - A command line template as defined in the the * documentation of Dos.ReadArgs() For a complete * description, look there. Full support for aliases/ * abbreviations ("Quit=Q/S" or "Multi=/S" etc.) * is available. * * Possible types of template options: * * no specifier - string * The action of this option template is to fill * the arguemnt entry with the string value of the * first matching ToolType. * * /N - number * The argument entry is filled with a pointer to * an integer, or left unchanged if not provided * In addidtion to decimal numbers, hexadecimal numbers * are accepted if they are preceded by a [Dollar] or '0x' * If no valid number is provided, the entry is left * unchanged. * * /S - switch -- implies option modifier /K * The argument entry is filled with -1 (LTRUE) if * the keyword is specified as a ToolType with no * value or values YES or TRUE. It is filled with * 0 (LFALSE) if the ToolType has NO or FALSE as its * value. There is also, if you don't supply the flag * disableSpecialNo, a more extentsive recognition: * If the template option and a tooltype name * match each other except a missing prefix 'NO' of one of * them, after * checking all other options' non-empty names for exact * equality (as oppposed to 'NO'-prefix equality), the * ToolType is considered to fit for that /S option: * If the ToolType has no value, or it's value is YES or * TRUE, the arguemnt entry will be filled with a 0 (LFALSE) * If it's value is FALSE or NO, the entry will be filled * with -1 (LTRUE). Note that in any case, if the ToolType * value is not empty, TRUE, YES, FALSE or NO, no action will * take place, and in the case of 'NO'-prefix equality the * ToolType won't be considered to appertain to this option. * * /T - toggle -- implies option modifier /K * The action for this option type exactly follows the * description of the /S (switch) option except that * in the case of exact equality (not 'NO'-prefix equality) * if the ToolType has no value assigned, the action will * toggle the arguemnt entry: if it is 0 (LFALSE), * it will turn into -1 (LTRUE), otherwise it will turn into * LFALSE. * * /M - Multi * The argument entry is filled with a pointer to a NIL- * terminated array of pointers to strings. * The action for this option type is heavily influenced * by the following flags: * noMultiMulti:The first matching ToolType is considered * only - all later matches will be ignored. Useful in * connection with the other flags: * multiExclSep: Considers the ToolType value string to * consist of several differnt strings, seperated * by exclamation marks (!) * multiCommaSep: Same goes for this - yet the separators * are commas (,) in this case. * * /M/N - MultiNum * The action for this is the same as for /M (Multi) type, * except that the tooltype values must be numbers, and * the argument entry is filled with a pointer to an array * of pointers to LONGINTs (32 bit integers) For more * information also look at the /N (number) option type. * Note that if there are one or more invalid numbers * in a ToolType value, and multi****Sep is enabled, * no number of that ToolType will be regarded to be valid. * * /F - Full remainder * All matching ToolType values will be joined, with one * whitespace separator between them, and the argument * entry will be filled with a pointer to that string. * This type is affected by the noFullMulti flag. If it is * specified, only the first matching ToolType will match, * all other following matching ToolTypes are ignored, i.e. * the action is the same as with simple String option type. * * /I - Ignore * Yes, you,re right!;-) This is just a dummy entry, which * will never match, however, space in the argument entry * array for this option must be present. * * possible modifiers: * /K - key attribute * require the specification of one of the option's alias * names as the ToolType name - excludes the possibilty of * specifying empty ("") aliases. This attribute is * implicitely specified with the /S and /T option types. * /A - always attribute * this attribute causes ReadArgsTT() to fail if the * respective argument entry could not be filled from the * supplied ToolType array handles. * * Priority of filling up arguement entries: * String entries are filled first, then Numeric entries, * then Switch entries, then Toggle entries, then * MultiNum entries, then FullRest (/F) entries, and * at last Multi entries. In addition, all matching name * aliases that are not empty ("") are filled before any * entry of any type whatsoever that only matches because * of an empty name alias match (Empty name aliases match * any tooltype whatsoever, and their possible name part * is considered to be part of the value string!) The * priority is also broken by the 'NO'-prefix equality * match of /S and /T -type option entries: Any exact * match of any not empty name alias is preferred to them. * * Two remarks of significance: One ToolType may -of course- * only match one option entry, and any name alias may only * occure once -except for /I ignore type options: they are * always ignored- otherwise, failure is returned. * * args - an array or structure to hold the argument entries - * four bytes per template option large at least. You may * predefine the entries with your default values: if no * valid matching tooltype is found, and successfully * processed, no changes are made to the pertinent entry. * However, if ReadArgsTT() returns failure, you may _NOT_ * assume, that no changes have been made to the predefined * defaults. * * ttTool & - ordinary, 'conventional' ToolType array handles, as * ttProject opposed to dynamic ones (which can be converted to * conventional ones by TTAPtr() ). May be NIL or simple * Exec.APTRs, etc. * * flags - No, One or several of noFullMulti, noMultiMulti, * multiExclSep, multiCommaSep, disableSpecialNo & * dontFill. dontFill has the effect that the args argument * is ignored, thus you won't get any values of the * template options specified within the ToolTypes reported. * This is useful when you want to use this function solely * as an inclusion/exclusion filter for your ToolTypes. * The description of the other flags is given in the * section about the tmpl input argument. NOTE: DON'T * specify any OTHER flags, since strange things may happen * if you specify flags apart from those documented here!! * * RESULT * RDArgsWBPtr * - A pointer to a RECORD RDArgsWB, which contains * two dynamic ToolType array handles, one containing * all ToolTypes that have been used while parsing the * template, and one with all those ToolTypes that * remain unparsed. You can manipulate them using * the dynamic ToolType array manipulation functions * of this module. This gives an enormous burst of * versatility and usefulness for this function - you * can use it just to filter normal ToolTypes arrays * multiple times, discarding the Dos.ReadArgs() * functionality of this function. * NIL is this function's failure indicator. * * * NOTES * Remember what I said in the discussion of the flags input parameter * section. * * SEE ALSO * FreeArgsWB(), ReadArgsWBMsg(), ReadArgsWB(), TTAPtr() * *****************************************************************************) PROCEDURE ReadArgsTT * (tmpl : ARRAY OF CHAR; args : ARRAY OF y.BYTE; ttTool, ttProject: TTPtr; flags : SET ): RDArgsWBPtr; VAR ToolEnd, ProjectEnd: BOOLEAN; ttCurr : LONGINT; tt : LongStrPtr; TmplArr : TemplArrT; Rda : RDArgsWBPtr; i,j : LONGINT; ret, status : LONGINT; ttUsed : BOOLEAN; PROCEDURE CleanUp(err: LONGINT); BEGIN FreeTemplArr (TmplArr); IF (err # 0) & (d.IoErr() = 0) THEN y.SETREG (0, d.SetIoErr (err)); END; END CleanUp; PROCEDURE GetTT(): LongStrPtr; BEGIN IF ~ProjectEnd THEN IF ttProject # NIL THEN IF ttProject^[ttCurr] # NIL THEN INC (ttCurr); RETURN ttProject^[ttCurr-1]; END; END; ProjectEnd := TRUE; ttCurr:=0; END; IF ToolEnd THEN RETURN NIL; END; IF ttTool # NIL THEN IF ttTool^[ttCurr] # NIL THEN INC (ttCurr); RETURN ttTool^[ttCurr-1]; END; END; ToolEnd := TRUE; RETURN NIL; END GetTT; PROCEDURE ParseTemplate(): BOOLEAN; VAR i, j, n : LONGINT; fl : SET; el : INTEGER; type : LONGINT; chr : ARRAY 2 OF CHAR; s : DynStrPtr; AllNames: DynTTPtr; to : TemplOptPtr; fakeargs: ARRAY 4 OF y.BYTE; PROCEDURE CleanUp (); BEGIN IF s # NIL THEN DISPOSE (s); END; FreeDynTT (AllNames); END CleanUp; PROCEDURE ClrOptVars(): BOOLEAN; BEGIN fl := flags * {noFullMulti,noMultiMulti,multiExclSep, argFile, argFiles, multiCommaSep, disableSpecialNo}; type := str; IF s # NIL THEN DISPOSE (s); END; RETURN DynAppend (s, ""); END ClrOptVars; BEGIN i := 0; n := 0; chr[1] := '\x00'; s := NIL; AllNames := NIL; LOOP CASE tmpl[i] OF '\x00' : EXIT; | ',' : INC (n); ELSE END; INC (i); END; IF i # 0 THEN INC (n); END; IF n = 0 THEN CleanUp(); RETURN TRUE; END; IF ~DynAppendTT (AllNames, "", {createEmpty}) THEN CleanUp(); RETURN FALSE; END; y.ALLOCATE (TmplArr, n); IF TmplArr = NIL THEN CleanUp(); RETURN FALSE; END; FOR i := 0 TO LEN (TmplArr^)-1 DO TmplArr[i] := NIL; END; i := 0; n := 0; IF ~ClrOptVars() THEN CleanUp(); RETURN FALSE; END; LOOP CASE tmpl[i] OF '\x00', ',': IF (numAttr IN fl) THEN LOOP IF type = str THEN type := num; EXIT; END; IF type = multi THEN type := multiNum; EXIT; END; CleanUp(); RETURN FALSE; END; EXCL (fl, numAttr); END; CASE type OF ignore : y.ALLOCATE (TmplArr[n] (TemplIgnore)); | str : y.ALLOCATE (TmplArr[n] (TemplStr)); | switch : y.ALLOCATE (TmplArr[n] (TemplSwitch)); | num : y.ALLOCATE (TmplArr[n] (TemplNum)); | toggle : y.ALLOCATE (TmplArr[n] (TemplToggle)); | multiNum: y.ALLOCATE (TmplArr[n] (TemplMultiNum)) | remain : y.ALLOCATE (TmplArr[n] (TemplRemain)); | multi : y.ALLOCATE (TmplArr[n] (TemplMulti)); END; IF TmplArr[n] = NIL THEN CleanUp(); RETURN FALSE; END; IF dontFill IN flags THEN e.CopyMem ("\000\000\000\000", fakeargs, LEN (fakeargs)); IF ~TmplArr[n].Init (s^, fakeargs[0], fl, AllNames) THEN CleanUp(); RETURN FALSE; END; ELSE IF ~TmplArr[n].Init (s^, args[4*n], fl, AllNames) THEN CleanUp(); RETURN FALSE; END; END; IF ~ClrOptVars() THEN CleanUp(); RETURN FALSE; END; INC (n); IF tmpl[i] = '\x00' THEN EXIT; END; | '/' : WHILE tmpl[i] = '/' DO INC (i); j := 0; LOOP IF j >= LEN (tmplTypesSansNum) THEN EXIT; END; IF (CAP(tmpl[i]) = tmplTypesSansNum[j]) & (tmplTypesSansNum[j] # CHR (0)) THEN EXIT; END; INC (j); END; IF j < LEN (tmplTypesSansNum) THEN IF type # str THEN CleanUp(); RETURN FALSE; END; type := j; ELSE CASE CAP(tmpl[i]) OF numC: el := numAttr; | (* new special num type handling *) keyC: el := keyAttr; | alwaysC: el := alwaysAttr; ELSE CleanUp(); RETURN FALSE; END; IF el IN fl THEN CleanUp(); RETURN FALSE; END; INCL (fl, el); END; INC (i); END; (* WHILE *) CASE tmpl[i] OF ',', '\x00': | ELSE CleanUp(); RETURN FALSE; END; DEC (i); ELSE chr[0] := tmpl[i]; IF ~DynAppend (s, chr) THEN CleanUp(); RETURN FALSE; END; END; (* CASE *) INC (i); END; (* LOOP *) FOR i:=0 TO LEN (TmplArr^)-1 DO (* sorting *) FOR j:=i+1 TO LEN (TmplArr^)-1 DO IF TmplArr[j].pri= LEN (TmplArr^) THEN EXIT; END; ret := TmplArr[i].Cmp (tt^, status); IF ret = foundNoSpc THEN FOR j:=i+1 TO LEN (TmplArr^)-1 DO IF TmplArr[j].Cmp (tt^, status) = found THEN ret := notFound; END; END; END; IF ret # notFound THEN ret := TmplArr[i].Process (tt^); IF ret # fail THEN ttUsed := TRUE; END; IF ret = ok THEN EXIT; ELSIF (ret = okSwitchT) OR (ret = okSpecNo) THEN status := ret; END; END; INC (i); END; (* LOOP *) IF ~ttUsed THEN IF ~DynAppendTT (Rda.ttRest, tt^, {}) THEN CleanUp(d.noFreeStore); RETURN NIL; END; ELSE IF ~DynAppendTT (Rda.ttIncl, tt^, {}) THEN CleanUp(d.noFreeStore); RETURN NIL; END; END; END; (* LOOP *) FOR i:= 0 TO LEN (TmplArr^)-1 DO IF alwaysAttr IN TmplArr[i].flags THEN IF ~TmplArr[i].used THEN CleanUp(d.requiredArgMissing); RETURN NIL; END; END; END; END; Rda.opts := TmplArr; TmplArr := NIL; CleanUp(0); RETURN Rda; END ReadArgsTT; (****** BlackMagic/FreeArgs *************************************************** * * NAME * FreeArgs -- Frees resources allocated with ReadArgs() * * SYNOPSIS * FreeArgs (VAR rda: RDArgsPtr); * * FUNCTION * This function just frees all resources allocated with a prior * call to ReadArgs() and reinitializes the RDArgsPtr to NIL. * * INPUTS * rda - A valid or NIL RDArgsPtr * * SEE ALSO * ReadArgs() * *****************************************************************************) PROCEDURE FreeArgs * (VAR rda: RDArgsPtr); BEGIN IF rda # NIL THEN rda.Free(); DISPOSE (rda); END; END FreeArgs; (****** BlackMagic/FreeArgsWB ************************************************* * * NAME * FreeArgsWB -- Frees resources allocated with ReadArgsTT/WBMsg/WB() * * SYNOPSIS * FreeArgsWB (VAR rda: RDArgsWBPtr); * * FUNCTION * This function just frees all resources allocated with a prior * call to ReadArgsTT(), ReadArgsWBMsg() or ReadArgsWB() and * reinitializes the RDArgsWBPtr to NIL. * * INPUTS * rda - A valid or NIL RDArgsWBPtr * * SEE ALSO * ReadArgsTT(), ReadArgsWBMsg(), ReadArgsWB() * *****************************************************************************) PROCEDURE FreeArgsWB * (VAR rda: RDArgsWBPtr); BEGIN IF rda # NIL THEN rda.Free(); DISPOSE (rda); END; END FreeArgsWB; (****** BlackMagic/WBArgToFNam ************************************************* * * NAME * WBArgToFNam -- generates complete file path from filename & dir lock * * SYNOPSIS * WBArgToFNam * (VAR string : DynStrPtr; * lock : d.FileLockPtr; * fName : ARRAY OF CHAR; * flags : SET): BOOLEAN; * * FUNCTION * This function generates the complete path of a file from * its name component and a lock of the directory where * the file is located, and appends it to the passed dynamic * string. This function is especially useful when dealing * with WBStartup / AppMessage file lists. Note that you * can alienate this function from its original purpose by * supplying an empty fName parameter. In that case, this * function simply returns the complete path of the supplied * lock parameter. * * INPUTS * string - the dynamic string handle - may be NIL. * lock - the lock of the directory where the file is located. * fName - the name of the file. * flags - flags modifying the operation of this function. * At the moment, the one and only documented flag is * relPath. If you specify it, this function may * generate relative paths to the current directory, * otherwise it will always create absolute paths. * It is *absolutely illegal* to specify any other * flags than the ones documented here. * * RESULT * TRUE - for success. * FALSE - for failure - in this case the dynamic string and its * handle are left unchanged. * * SEE ALSO * ReadArgsWBMsg() * *****************************************************************************) PROCEDURE WBArgToFNam * (VAR string : DynStrPtr; lock : d.FileLockPtr; fName : ARRAY OF CHAR; flags : SET): BOOLEAN; VAR FullPathStr, AuxStr: DynStrPtr; i: LONGINT; PROCEDURE CleanUp(); BEGIN IF FullPathStr # NIL THEN DISPOSE (FullPathStr); END; END CleanUp; (* $CopyArrays- *) BEGIN FullPathStr := NIL; IF (d.SameLock (lock, e.FindTask (NIL)(d.Process).currentDir) # d.same) OR ~(relPath IN flags) THEN i := 1+DynamicExtra; LOOP y.ALLOCATE (FullPathStr, i); IF FullPathStr = NIL THEN CleanUp(); RETURN FALSE; END; IF d.NameFromLock (lock, FullPathStr^, LEN (FullPathStr^)) THEN EXIT; ELSE IF d.IoErr() # d.lineTooLong THEN CleanUp(); RETURN FALSE; END; END; INC (i, 1+DynamicExtra); DISPOSE (FullPathStr); END; (* LOOP *) END; IF ~DynExpand (FullPathStr, DynStrLen (FullPathStr)+st.Length (fName)+2) THEN CleanUp(); RETURN FALSE; END; IF fName # "" THEN IF ~d.AddPart (FullPathStr^, fName, LEN (FullPathStr^)) THEN CleanUp(); RETURN FALSE; END; END; IF ~DynAppend (string, FullPathStr^) THEN CleanUp(); RETURN FALSE; END; CleanUp(); RETURN TRUE; END WBArgToFNam; (****** BlackMagic/ReadArgsWBMsg ********************************************** * * NAME * ReadArgsWBMsg -- Parse WBStartup's input similar to Dos.ReadArgs() * * SYNOPSIS * ReadArgsWBMsg (template : ARRAY OF CHAR; * args : ARRAY OF y.BYTE; * wbenchMsg: wb.WBStartupPtr; * project : LONGINT; * flags : SET): RDArgsWBPtr; * * FUNCTION * This function is a frontend for the ReadArgsTT() function. * Its main additional benefit is that it does all the bothersome * DiskObject handling and provides the capability to pass the * project(s)'s file names you supply as arguments for your tool * invocation. All ToolTypes of the project (if specified) are * searched for a match and are processed before the tool's * ToolTypes, as demanded in the Amiga User Interface Style Guide. * * INPUTS * template- The option template. Have a look at the ReadArgsTT * documentation for a thorough-going discussion. * * args - The array or struct to hold the option argument entries. * Four bytes for each option large at least. See also * ReadArgsTT() documentation. * * wbenchMsg- The WBStartup you were passed by Workbench on * startup of your program. For Oberon you can access it * with OberonLib.wbStartup * * project - The ordinal number of the project you want to be taken * into account for parsing - starting at 1. Passing 0 * means that you only want the tool's ToolTypes to be * taken into account. Passing -1 means that if there * exist one or more passed projects, the first project * is used for parsing, otherwise only the tool's ToolTypes * are taken into account. The number of projects supplied * may be calculated using wbenchMsg^.numArgs-1 * * flags - Flags modifying the operation of this function: * You may use all those documented with ReadArgsTT, * including noFullMulti, noMultiMulti, multiExclSep, * multiCommaSep, disableSpecialNo & dontFill. * There are six more flags you may specify along with * this function: * doCD: * Make the directory specified by the directory lock of * WBStartup's tool the current directory. A call to * FreeArgsWB() will reset the original current * directory. * ignoreTool: * Discard the tool's ToolTypes, only consider the * project's ToolTypes. Incompatible with specifying 0 * as project parameter and with ignoreProject * ignoreProject: * Discard the project's ToolTypes, only consider the * tools's ToolTypes. Incompatible with ignoreTool * argFile, argFiles & relPath: * If you specify exactly one of either argFile or * argFiles, and you pass either a FILE/K or a * a FILES/M/K template option, the respective option * entries will either be filled with the file name * of the specified project or with all file names of * all projects passed on startup. * File name(s) are either always given as an absolute * path (default) or may have a path relative to the * tool's current directory if you specify the relPath * flag. * * RESULT * RDArgsWBPtr * - A pointer to a RECORD RDArgsWB, as documented along * with the ReadArgsTT() doc. NIL indicates failure. * * NOTES * Remember what I said in the discussion of unauthorized flag * specification in the ReadArgsTT() and also in the DynAppendTT() * documentation. * * SEE ALSO * FreeArgsWB(), ReadArgsTT(), ReadArgsWB() * *****************************************************************************) PROCEDURE ReadArgsWBMsg * (template : ARRAY OF CHAR; args : ARRAY OF y.BYTE; wbenchMsg: wb.WBStartupPtr; project : LONGINT; flags : SET): RDArgsWBPtr; VAR do1, do2: wb.DiskObjectPtr; lock: d.FileLockPtr; rda: RDArgsPtr; rdareturn: RDArgsWBPtr; ArgStr: DynStrPtr; endflg : BOOLEAN; i: LONGINT; tmpl: LongStrPtr; av: ARRAY 4 OF y.BYTE; tt1, tt2: TTPtr; fprj: LONGINT; cd: d.FileLockPtr; wba: WBArgumentsPtr; (* $CopyArrays- *) BEGIN do1 := NIL; do2 := NIL; lock := NIL; rda := NIL; rdareturn := NIL; ArgStr := NIL; endflg := FALSE; i := 0; tmpl := NIL; tt1 := NIL; tt2 := NIL; IF ((argFile IN flags) & (argFiles IN flags)) OR ((ignoreTool IN flags) & ((ignoreProject IN flags) OR (project=0))) THEN y.SETREG (0, d.SetIoErr (d.objectWrongType)); RETURN NIL; END; IF argFile IN flags THEN tmpl := y.ADR ("FILE/M/K"); ELSIF argFiles IN flags THEN tmpl := y.ADR ("FILES/M/K"); ELSE tmpl := y.ADR (""); END; IF wbenchMsg = NIL THEN y.SETREG (0, d.SetIoErr (d.objectWrongType)); RETURN NIL; END; IF project = -1 THEN IF wbenchMsg^.numArgs > 1 THEN project := 1; ELSE project := 0; END; END; IF (project < 0) OR (project >= wbenchMsg^.numArgs) THEN y.SETREG (0, d.SetIoErr (d.badNumber)); RETURN NIL; END; IF (project=0) & (wbenchMsg^.numArgs>1) THEN fprj := 1; ELSE fprj := project; END; (* due to misdefinition of wb.WBArgumentsPtr: Ptr TO ARRAY 256!! OF ... *) wba := AddPtr (wbenchMsg.argList, 0); IF doCD IN flags THEN cd := d.CurrentDir (wba^[0].lock); END; lock := d.CurrentDir (wba^[0].lock); do1 := ic.GetDiskObjectNew (wba^[0].name^); y.SETREG (0, d.CurrentDir (wba^[project].lock)); do2 := ic.GetDiskObjectNew (wba^[project].name^); y.SETREG (0, d.CurrentDir (lock)); IF ignoreTool IN flags THEN tt1 := NIL; ELSE tt1 := do1^.toolTypes; END; IF ((project = 0) OR (ignoreProject IN flags)) & (tt1 # NIL) THEN tt2 := NIL; ELSE tt2 := do2^.toolTypes; END; LOOP IF ~DynAppend (ArgStr, "") THEN EXIT; END; rda := ReadArgsTT (tmpl^, av, tt1, tt2, {}); IF rda = NIL THEN EXIT; END; WITH rda: RDArgsWB DO IF (argFile IN flags) & (fprj > 0) THEN ArgStr[0] := CHR (0); IF ~DynAppend (ArgStr, "FILE=") THEN EXIT; END; (* due to misdefinition of wb.WBArgumentsPtr: Ptr TO ARRAY 256!! OF ... *) IF ~WBArgToFNam (ArgStr, wba^[fprj].lock, wba^[fprj].name^, flags) THEN EXIT; END; IF ~DynAppendTT (rda.ttRest, ArgStr^, {}) THEN EXIT; END; END; IF argFiles IN flags THEN FOR i := 1 TO wbenchMsg^.numArgs-1 DO ArgStr[0] := CHR (0); (* due to misdefinition of wb.WBArgumentsPtr: Ptr TO ARRAY 256!! OF ... *) IF ~DynAppend (ArgStr, "FILES=") THEN EXIT; END; IF ~WBArgToFNam (ArgStr, wba^[i].lock, wba^[i].name^, flags) THEN EXIT; END; IF ~DynAppendTT (rda.ttRest, ArgStr^, {}) THEN EXIT; END; END; (* FOR *) END; (* IF argFiles IN flags *) rdareturn := ReadArgsTT (template, args, NIL, TTAPtr (rda.ttRest), flags); EXIT; END (* WITH *) END; (* LOOP *) IF rda # NIL THEN FreeArgs (rda); END; IF do1 # NIL THEN ic.FreeDiskObject (do1); END; IF do2 # NIL THEN ic.FreeDiskObject (do2); END; IF ArgStr # NIL THEN DISPOSE (ArgStr); END; IF doCD IN flags THEN IF rdareturn # NIL THEN rdareturn.validCD := TRUE; rdareturn.oldCD := cd; ELSE y.SETREG (0, d.CurrentDir (cd)); END; END; RETURN rdareturn; END ReadArgsWBMsg; (****** BlackMagic/ReadArgsWB ************************************************* * * NAME * ReadArgsWB -- Parse Workbench input within an Oberon program * * SYNOPSIS * ReadArgsWB (template: ARRAY OF CHAR; * args : ARRAY OF y.BYTE; * project : LONGINT; * flags : SET): RDArgsWBPtr; * * FUNCTION * This function is a frontend for the ReadArgsWBMsg() function * to be used in Oberon programs. The arguments passed to it are * exactly the same as the ones passed to ReadArgsWBMsg() except * for the omitted wbenchMsg arguement which is directly taken * from OberonLib.wbStartup. If the Oberon program was started from * CLI, failure is returned. * * INPUTS * see ReadArgsWBMsg() documentation * * RESULT * RDArgsWBPtr * - A pointer to a RECORD RDArgsWB, as documented along * with the ReadArgsTT() doc, NIL for failure. * * NOTES * Remember what I said in the discussion of unauthorized flag * specification in the ReadArgsTT() and also in the DynAppendTT() * documentation. * * SEE ALSO * FreeArgsWB(), ReadArgsTT(), ReadArgsWBMsg() * *****************************************************************************) PROCEDURE ReadArgsWB * (template: ARRAY OF CHAR; args : ARRAY OF y.BYTE; project : LONGINT; flags : SET): RDArgsWBPtr; (* $CopyArrays- *) BEGIN IF ~o.wbStarted THEN y.SETREG (0, d.SetIoErr (d.objectWrongType)); RETURN NIL; END; RETURN ReadArgsWBMsg (template, args, o.wbenchMsg(wb.WBStartup), project, flags); END ReadArgsWB; (****** BlackMagic/ReadArgs *************************************************** * * NAME * ReadArgs -- Parse Workbench OR CLI input args Dos.ReadArgs()-like * * SYNOPSIS * ReadArgs (template: ARRAY OF CHAR; * args : ARRAY OF y.BYTE; * project : LONGINT; * flags : SET): RDArgsWBPtr; * * FUNCTION * This function provides all Oberon programmers with a unique * argument parsing interface, from both CLI and Workbench. * It offers you all of the flexibility of the Dos.ReadArgs() * function also for Workbench argument parsing. * * INPUTS * see ReadArgsWBMsg() documentation * Note that for CLI parsing, the project and flags paramters * are naturally ignored, since they are Workbench specific. You * may only use template option combinations that are documented * for both, ReadArgsTT() AND dos/ReadArgs(), of course. * * RESULT * RDArgsPtr * - A pointer to a RECORD RDArgs or NIL. * You may free the resources allocated with it by * invoking FreeArgs (RDArgsPtr). * * NOTES * Remember what I said in the discussion of unauthorized flag * specification in the ReadArgsTT() and also in the DynAppendTT() * documentation. * * SEE ALSO * FreeArgs(), ReadArgsTT(), ReadArgsWBMsg(), ReadArgsWB() * *****************************************************************************) PROCEDURE ReadArgs * (template: ARRAY OF CHAR; args : ARRAY OF y.BYTE; project : LONGINT; flags : SET): RDArgsPtr; VAR rda: RDArgsPtr; (* $CopyArrays- *) BEGIN rda := NIL; IF o.wbStarted THEN rda := ReadArgsWBMsg (template, args, o.wbenchMsg(wb.WBStartup), project, flags); ELSE y.ALLOCATE (rda (RDArgsCLI)); IF rda # NIL THEN rda (RDArgsCLI).rda := d.ReadArgs (template, args, NIL); IF rda (RDArgsCLI).rda = NIL THEN DISPOSE (rda); END; END; END; RETURN rda; END ReadArgs; (****** BlackMagic/ArgsToTT *************************************************** * * NAME * ArgsToTT -- Convert a string/CLIArgs into a dynamic ToolType array * * SYNOPSIS * ArgsToTT (str: ARRAY OF CHAR, flags: SET): DynTTPtr; * * FUNCTION * This function does 'CLI to WB parsing' for you, as opposed to the * ReadArgsTT/WBMsg/WB() functions which parse the other way round. * It simply stores each of the white-space separated 'words' of the * input string into an own entry of a dynamic ToolType array. Usual * dos escaping like *n, *e, ** inside quotes is done because this * function uses Dos.ReadArgs(). * * INPUTS * str - the string to be parsed * flags - flags that modify operation of this function. * currently only useCLIArgs may be specified, which * causes ArgsToTT to ignore the passed string and get * its input rather from the arguemnts passed to your * program by the shell on startup. * * RESULT * DynTTPtr - The dynamic ToolType array handle whose ToolTypes * represent the input source's string. The array may * be empty, i.e. its first element may be NIL if the * input string was empty or consisted solely of white * space characters. A NIL return is this function's * failure indicator. * * NOTES * Dos.ReadItem()/Dos.ReadArgs() parse all '=' equal characters into * white space, if they're not surrounded by quotes. Remember this. * Concerning the flags parameter, keep in mind what I said in the * DynAppendTT documentation about using unauthorized flags for * the flags paramter! * * SEE ALSO * FreeDynTT(), DynAppendTT(), ReadArgsTT() * *****************************************************************************) (* Flags for ArgsToTT *) CONST useCLIArgs * = 0; PROCEDURE ArgsToTT * (str: ARRAY OF CHAR; flags: SET): DynTTPtr; VAR rda1, rda2: d.RDArgsPtr; dtt, dttnf: DynTTPtr; Args: TTPtr; i : LONGINT; PROCEDURE CleanUp(); BEGIN FreeDynTT (dtt); IF rda2 # NIL THEN d.FreeArgs (rda2); rda2 := NIL; END; IF rda1 # NIL THEN d.FreeDosObject (d.rdArgs, rda1); rda1 := NIL; END; END CleanUp; (* $CopyArrays- *) BEGIN rda1 := NIL; rda2 := NIL; dtt := NIL; dttnf := NIL; Args := NIL; IF ~(useCLIArgs IN flags) THEN rda1 := d.AllocDosObject (d.rdArgs, NIL); IF rda1 = NIL THEN CleanUp(); RETURN NIL; END; rda1.source.buffer := y.ADR (str); rda1.source.length := st.Length (str); rda1.source.curChr := 0; rda1.daList := NIL; rda1.buffer := NIL; rda1.bufSiz := 0; rda1.extHelp := NIL; rda1.flags := LONGSET{d.noPrompt}; END; rda2 := d.ReadArgs ("/M", Args, rda1); IF rda2 = NIL THEN CleanUp(); RETURN NIL; END; IF ~DynAppendTT (dtt, "", {createEmpty}) THEN CleanUp(); RETURN NIL; END; IF Args # NIL THEN i := 0; WHILE Args[i] # NIL DO IF ~DynAppendTT (dtt, Args[i]^, {}) THEN CleanUp(); RETURN NIL; END; INC (i); END; END; dttnf := dtt; dtt := NIL; CleanUp(); RETURN dttnf; END ArgsToTT; (****** BlackMagic/AddPtr ***************************************************** * * NAME * AddPtr -- Add UNTRACED (B)POINTERs/integers/LONGSETs * * SYNOPSIS * AddPtr (a: Exec.APTR; b: Exec.APTR): Exec.APTR; * * FUNCTION * This function provides mixed untraced pointer/integer arithmetics * for you, no matter whether the passed values are Exec.APTRS, * BPOINTERs, integers or LONGSETs * It takes the two values (and corrects any BPOINTER values), adds * them, and returns the result as an Exec.APTR. * * INPUTS * a,b - the values to perform the addition on. * * RESULT * Exec.APTR - the result of the performed arithmetics returned as an * Exec.APTR. * * NOTES * *Never* try to use this function with traced pointers arguments. * * SEE ALSO * SubPtr(), StrIndex(), PtrToInt() * *****************************************************************************) PROCEDURE AddPtr * (a, b: e.APTR): e.APTR; BEGIN RETURN y.VAL (e.APTR, y.VAL (LONGINT, a) + y.VAL (LONGINT, b)); END AddPtr; (****** BlackMagic/SubPtr ***************************************************** * * NAME * SubPtr -- Subtracts UNTRACED (B)POINTERs/integers/LONGSETs * * SYNOPSIS * SubPtr (a: Exec.APTR; b: Exec.APTR): Exec.APTR; * * FUNCTION * This function provides mixed untraced pointer/integer arithmetics * for you, no matter whether the passed values are Exec.APTRS, * BPOINTERs, integers or LONGSETs. * It takes the b parameter, subtracts it from the a parameter, and * returns the result as an Exec.APTR (result := a-b;) * * INPUTS * a - the value from which b is to be subtracted * b - the value to subtract from a. * * RESULT * Exec.APTR - the result of the performed arithmetics returned as an * Exec.APTR. * * NOTES * *Never* try to use this function with traced pointers arguments. * * SEE ALSO * AddPtr(), StrIndex(), PtrToInt() * *****************************************************************************) PROCEDURE SubPtr * (a, b: e.APTR): e.APTR; BEGIN RETURN y.VAL (e.APTR, y.VAL (LONGINT, a) - y.VAL (LONGINT, b)); END SubPtr; (****** BlackMagic/PtrToInt **************************************************** * * NAME * PtrToInt - Typecast UNTRACED (B)POINTER/integer/LONGSET to LONGINT * * SYNOPSIS * PtrToInt (ptr: Exec.APTR): LONGINT; * * FUNCTION * This function simply typecasts an Exec.APTR into a LONGINT. * This is useful for pointer arithmetics. * * INPUTS * ptr - the UNTRACED POINTER / BPOINTER / integer / LONGSET * to be typecasted into LONGINT * * RESULT * the typecasted LONGINT * * SEE ALSO * AddPtr(), SubPtr(), BPtrVal() * *****************************************************************************) PROCEDURE PtrToInt * (ptr: e.APTR): LONGINT; BEGIN RETURN y.VAL (LONGINT, ptr); END PtrToInt; (****** BlackMagic/BPtrVal ***************************************************** * * NAME * BPtrVal - Typecast a BPOINTER to LONGINT * * SYNOPSIS * BPtrVal (bptr: Exec.APTR): LONGINT; * * FUNCTION * This function simply typecasts a BPOINTER into a LONGINT * without shifting it 2 bits left. Useful for operating system * TagLists where BPOINTERs have to be passed as real BPOINTERs. * * * INPUTS * bptr - the BPOINTER to be typecasted into LONGINT * * RESULT * the typecasted LONGINT * * SEE ALSO * PtrToInt(), AddPtr(), SubPtr() * *****************************************************************************) PROCEDURE BPtrVal * (bptr: e.APTR): LONGINT; BEGIN RETURN y.VAL (LONGINT, bptr) DIV 4; END BPtrVal; (****** BlackMagic/GetCatalogStr *********************************************** * * NAME * GetCatalogStr - Return a localized string from a catalog * GetCatalogStrA - Return a localized str (Exec.APTR) from a catalog * * SYNOPSIS * GetCatalogStr (catalog: Locale.CatalogPtr; * string : ARRAY OF CHAR ): LongStrPtr; * * GetCatalogStrA (catalog: Locale.CatalogPtr; * string : ARRAY OF CHAR ): Exec.APTR; * * FUNCTION * These functions are similar to locale.library's GetCatalogStr() * equivalent, except that they work with a NIL - Locale.base and * consume one parameter less, because they expect the string id * to be placed in the two leading chars of the passed string * (high byte first, then low byte), the actual default string * is expected to start at the 3rd char of the string. * For further documentation, have a look at Locale/GetCatalogStr(). * * INPUTS * catalog - a valid Locale.CatalogPtr or NIL. * string - the string containing the string id in the first two * characters, and the null-terminated default string * starting from the third character. * * RESULT * a LongStrPtr/Exec.APTR pointing to the 'best' string found. * Guaranteed to be non-NIL. * * NOTES * you may convert your catalog definition files (#?.cd) into the * required Oberon source with the string constants definitions in * the format this function expects, with the enclosed Cat2Mod.rexx * script. * * SEE ALSO * GetStr(), Locale/GetCatalogStr(), Cat2Mod.rexx * *****************************************************************************) PROCEDURE GetCatalogStr * (catalog: loc.CatalogPtr; string : ARRAY OF CHAR ): LongStrPtr; VAR str1 : LongStrPtr; str2 : e.APTR; id : LONGINT; (* $CopyArrays- *) BEGIN str1 := StrIndex (string, 2); IF loc.base = NIL THEN RETURN str1; END; id := ASH (ORD (string[0]), 8) + ORD (string[1]); str2 := loc.GetCatalogStr (catalog, id, str1^); IF str2 # NIL THEN str1 := str2; END; RETURN str1; END GetCatalogStr; PROCEDURE GetCatalogStrA * (catalog: loc.CatalogPtr; string : ARRAY OF CHAR ): e.APTR; (* $CopyArrays- *) BEGIN RETURN GetCatalogStr (catalog, string); END GetCatalogStrA; (****** BlackMagic/GetStr ****************************************************** * * NAME * GetStr - Return a localized string from the default catalog * GetStrA - Return localized str (Exec.APTR) from the default catalog * * SYNOPSIS * GetStr (string: ARRAY OF CHAR): LongStrPtr; * * GetStrA (string: ARRAY OF CHAR): Exec.APTR; * * FUNCTION * These functions are frontends for the GetCatalogStr() function. * They take only the string parameter, and use the contents of * BlackMagic.Default as GetCatalogStr()'s catalog argument. * * INPUTS * string - the string containing the string id in the first two * characters, and the null-terminated default string * starting from the third character. * * RESULT * a LongStrPtr/Exec.APTR pointing to the 'best' string found - * guaranteed to be non-NIL; * * NOTES * You should open your program's catalog in your initialization code * and assign the value returned by Locale.OpenCatalog() to the * BlackMagic.DefaultCatalog variable. After that GetStr() / GetStrA() * do anything for you, you _MUST NOT_ even close the Catalog since * that is done in this module's shutdown code. However, if you * omit opening your catalog at startup, this function will * still work - it simply returns the built-in strings in that case. * If you convert your catalog definitions with the enclosed * Cat2Mod.rexx script, this initialization is done in the * generated Oberon source module. * * SEE ALSO * GetCatalogString(), Cat2Mod.rexx * *****************************************************************************) VAR DefaultCatalog * : loc.CatalogPtr; PROCEDURE GetStr * (string: ARRAY OF CHAR): LongStrPtr; (* $CopyArrays- *) BEGIN RETURN GetCatalogStr (DefaultCatalog, string); END GetStr; PROCEDURE GetStrA * (string: ARRAY OF CHAR): e.APTR; (* $CopyArrays- *) BEGIN RETURN GetStr (string); END GetStrA; (****** BlackMagic/Cat2Mod.rexx ********************************************* * * NAME * Cat2Mod.rexx - convert a catalog defintion file into Oberon source * * SYNOPSIS * rx Cat2mod.rexx NOBLACKMAGIC=NOBM/S, * CDFILE/A,BUILTINLANGUAGE=TONGUE,VERSION * * FUNCTION * Converts a catalog definition file (#?.cd) into Oberon source as * needed by GetCatalogString() and GetStr(). Just import the * resulting source module in your Oberon main module, and you can * use GetCatalogString() / GetStr() with the generated string * constants definitions. * * Originally this rexx script needed Nico François' Cat2H utility, * which converts catalog definitons into C-source headers. Starting * from version Cat2Mod.rexx 2.0, Cat2Mod.rexx reads the catalog * definition files directly and Cat2H employment has been discarded. * Since Cat2Mod.rexx 2.0, the only alien ressource used by * Cat2Mod.rexx is the (enclosed) rexxextra.library * * INPUTS * NOBLACKMAGIC=NOBM/S * - if this switch is specified, Cat2Mod.rexx generates * a module which does _NOT_ need BlackMagic to run. * The generated module exports equivalents to BlackMagic's * StrIndex(), StrIndexA(), GetCatalogStr(), * GetCatalogStrA(), GetStr() and GetStrA() functions. * * CDFILE/A - the catalog defintion file * * BUILTINLANGUAGE=TONGUE * - the name of the language of the built-in strings. * Defaults to 'english'. Possible values for this * parameter are 'deutsch', 'français', etc. * * VERSION - the version of the catalogs belonging to the * catalog definition file that is to be processed. * * RESULT * the Oberon source module with the string constants defintions * and the default catalog opening code - import it into your main * module. It tries to open its appertaining catalog in the * system's default language on startup, and assigns it to * BlackMagic.DefaultCatalog. Moreover the generated module exports * a function named OpenCatalog (language: ARRAY OF CHAR); * which you can use to change the language. Passing an emtpy string * ("") to it, makes it trying to (re)open the catalog in the system's * default language. * * NOTES * This rexx script and the generated Oberon source module make * some assumptions about naming and storing conventions of * your catalog defintion and Oberon source files: * the destination source is written into the directory, where the * source catalog definition file is located. Its filename is * the same as the source file's one, plus 'Strings.mod', with * a probable '.cd' suffix of the source file name omitted. * The catalog is considered to be named like the file name of the * destination module without the trailing 'Strings.mod' in lower * case, plus the standard '.catalog' suffix. * * SEE ALSO * GetCatalogString(), GetStr() * *****************************************************************************) VAR int39: I.IntuitionBasePtr; (* V39 intuition *) CONST waBusyPointer = I.waDummy + 035H; PROCEDURE SetWindowPointer {int39,-816} (win{8} : I.WindowPtr; tag1{9}..: u.Tag ); TYPE SpritePtr = UNTRACED POINTER TO Sprite; Sprite = ARRAY 36 OF INTEGER; VAR waitPointer: SpritePtr; CONST waitPointer1 = Sprite( 00000H, 00000U, 00400H, 007C0U, 00000H, 007C0U, 00100H, 00380U, 00000H, 007E0U, 007C0H, 01FF8U, 01FF0H, 03FECU, 03FF8H, 07FDEU, 03FF8H, 07FBEU, 07FFCH, 0FF7FU, 07EFCH, 0FFFFU, 07FFCH, 0FFFFU, 03FF8H, 07FFEU, 03FF8H, 07FFEU, 01FF0H, 03FFCU, 007C0H, 01FF8U, 00000H, 007E0U, 00000H, 00000H); (****** BlackMagic/SetWaitPointer ********************************************** * * NAME * SetWaitPointer - set a window's pointer to busy state * * SYNOPSIS * SetWaitPointer (win: Intuition.WindowPtr); * * FUNCTION * This function sets a window's pointer to busy state without * blocking window input or anything else. This is useful to inform * the user that your application is busy, but you still want to react * to the user's input activity. * This function tries to apply the best technique available at * runtime for this job; including Intuition V39. * * INPUTS * win - the window whose pointer is to be set to busy state - may * be NIL. * * SEE ALSO * ClearWaitPointer() * *****************************************************************************) PROCEDURE SetWaitPointer * (win: I.WindowPtr); BEGIN IF win = NIL THEN RETURN; END; IF int39 # NIL THEN (* V39 Intuition *) SetWindowPointer (win, waBusyPointer, I.LTRUE, u.done); ELSE IF waitPointer = NIL THEN waitPointer := e.AllocVec (SIZE (waitPointer^), LONGSET{e.chip,e.public}); IF waitPointer # NIL THEN waitPointer^ := waitPointer1; END; END; IF waitPointer # NIL THEN I.SetPointer(win, waitPointer^, 16, 16, 0, 0); END; END; END SetWaitPointer; (****** BlackMagic/ClearWaitPointer ******************************************** * * NAME * ClearWaitPointer - release a window's pointer from busy state * * SYNOPSIS * ClearWaitPointer (win: Intuition.WindowPtr); * * FUNCTION * This function releases a window's pointer from its busy state * set by SetWaitPointer(). It is generally harmless to call this * function without a prior call to SetWaitPointer(). * * INPUTS * win - the window whose pointer is to be released from busy * state - may be NIL. * * SEE ALSO * SetWaitPointer() * *****************************************************************************) PROCEDURE ClearWaitPointer * (win: I.WindowPtr); BEGIN IF win = NIL THEN RETURN; END; IF int39 # NIL THEN (* Intuition V39 *) SetWindowPointer (win, u.done); ELSE I.ClearPointer (win) END; END ClearWaitPointer; (****** BlackMagic/LockWindow ************************************************** * * NAME * LockWindow - set a window to busy state. * * SYNOPSIS * LockWindow (win: Intuition.WindowPtr): WinLockPtr; * * FUNCTION * This function makes a window block all input and makes it * indicate that it is in busy state by setting its busy pointer. * This function tries to apply the best technique available at * runtime for this job; including Intuition V39. * * INPUTS * win - the window to be locked - may be NIL. * * RESULT * a valid WinLockPtr that is used by UnlockWindow() to release * the Window from its busy state, or NIL. (You should usually * not check the return value for NIL since UnlockWindow() * handles a NIL input correctly. * * SEE ALSO * UnlockWindow() * *****************************************************************************) TYPE WinLockPtr * = UNTRACED POINTER TO STRUCT (req: I.Requester) END; PROCEDURE LockWindow * (win: I.WindowPtr): WinLockPtr; VAR wl : WinLockPtr; BEGIN wl := NIL; IF win=NIL THEN RETURN NIL; END; y.ALLOCATE (wl); IF wl=NIL THEN RETURN NIL; END; IF ~I.Request (wl, win) THEN DISPOSE (wl); RETURN NIL; END; SetWaitPointer (win); RETURN wl; END LockWindow; (****** BlackMagic/UnlockWindow ************************************************ * * NAME * UnlockWindow - release a window from its busy state * * SYNOPSIS * UnlockWindow (VAR wl: WinLockPtr); * * FUNCTION * This function releases a window that was previously set to busy * state by LockWindow() from its busy state and clears the passed * wl WinLockPtr. For a NIL wl input parameter, it does nothing at all. * * INPUTS * wl - the WinLockPtr retured by LockWindow(). May be NIL. * * SEE ALSO * LockWindow() * *****************************************************************************) PROCEDURE UnlockWindow* (VAR wl: WinLockPtr); VAR win: I.WindowPtr; BEGIN IF wl = NIL THEN RETURN END; win := wl.req.rWindow; I.EndRequest (wl, win); ClearWaitPointer (win); DISPOSE (wl); END UnlockWindow; (****** BlackMagic/gtItemAddr ************************************************* * * NAME * gtItemAddr - return the MenuItem from a GadTools.NewMenu.userData * * SYNOPSIS * gtItemAddr (menu: Intuition.MenuPtr; * data: Exec.APTR ): Intuition.MenuItemPtr; * * FUNCTION * This function returns the menu item that was created by GadTools * from a specific GadTools.NewMenu entry. This is done, employing * the GadTools.NewMenu.userData field, which has to be set to a * unique value if you want to find the menu item using this function. * Both, items and sub items are found. * * INPUTS * menu - the Intuition menu that was previously created by * GadTools.CreateMenusA() - may be NIL. * data - the unique userData entry of a GadTools.NewMenu array * element of either GadTools.item or GadTools.sub type * * RESULT * a valid Intuition.MenuItemPtr or NIL if the item was not found in * in the menu chain. * * SEE ALSO * gtMenuAddr() * *****************************************************************************) PROCEDURE gtItemAddr * (menu: I.MenuPtr; data: e.APTR ): I.MenuItemPtr; VAR i,s: I.MenuItemPtr; BEGIN WHILE menu # NIL DO i := menu.firstItem; WHILE i # NIL DO IF gt.MenuItemUserData (i) = data THEN RETURN i; END; s := i.subItem; WHILE s # NIL DO IF gt.MenuItemUserData (s) = data THEN RETURN s; END; s := s.nextItem; END; i := i.nextItem; END; menu := menu.nextMenu; END; RETURN NIL; END gtItemAddr; (****** BlackMagic/gtMenuAddr ************************************************* * * NAME * gtMenuAddr - return the Menu from a GadTools.NewMenu.userData * * SYNOPSIS * gtMenuAddr (firstmenu: Intuition.MenuPtr; * data : Exec.APTR ): Intuition.MenuPtr; * * FUNCTION * This function returns the menu that was created by GadTools * from a specific GadTools.NewMenu entry. This is done, employing * the GadTools.NewMenu.userData field, which has to be set to a * unique value if you want to find the menu using this function. * * INPUTS * firstmenu- the Intuition menu that was previously created by * GadTools.CreateMenusA() - may be NIL. * data - the unique userData entry of a GadTools.NewMenu array * element of GadTools.title type * * RESULT * a valid Intuition.MenuPtr or NIL if the menu was not found in * in the menu chain. * * SEE ALSO * gtItemAddr() * *****************************************************************************) PROCEDURE gtMenuAddr * (firstmenu: I.MenuPtr; data : e.APTR ): I.MenuPtr; BEGIN WHILE firstmenu # NIL DO IF gt.MenuUserData (firstmenu) = data THEN RETURN firstmenu; END; firstmenu := firstmenu.nextMenu; END; RETURN NIL; END gtMenuAddr; (****** BlackMagic/GadKey ***************************************************** * * NAME * GadKey / GadKeyA - return the key shortcut for a string. * * SYNOPSIS * GadKey (gadstr: ARRAY OF CHAR): CHAR; * * GadKeyA (gadstr: Exec.APTR): CHAR; * * FUNCTION * These functions return the key shortcut character from a string. * They search for the underscrore character in the string, and * if they find one, return the following charcter as the key * shortcut. Otherwise a nul character is returned. For GadKeyA(), * a NIL pointer may be passed. In that case, the result will be * the nul character as well. These functions use the * BlackMagic.UnderScore variable for identifiying the underscore * character. By default, this variable is initialized to '_'. * However, you may change that to any character you want. * * * INPUTS * gadstr - the string to be searched for an underscore sequence. * Either as an ARRAY OF CHAR for GadKey() or as an * Exec.APTR for GadKeyA(). * * RESULT * the key shortcut character or the nul character, if no shortcut * was found. * *****************************************************************************) VAR UnderScore * : CHAR; PROCEDURE GadKey * (gadstr: ARRAY OF CHAR): CHAR; VAR j : LONGINT; (* $CopyArrays- *) BEGIN j := 0; WHILE gadstr[j] # '\000' DO IF gadstr[j] = UnderScore THEN RETURN gadstr[j+1]; END; INC (j); END; RETURN '\000'; END GadKey; PROCEDURE GadKeyA * (gadstr: e.APTR): CHAR; VAR str: LongStrPtr; BEGIN IF gadstr = NIL THEN RETURN CHR (0); END; str := gadstr; RETURN GadKey (str^); END GadKeyA; (****** BlackMagic/ClearMem *************************************************** * * NAME * ClearMem -- clear memory * ClearMemAPTR -- " " * * SYNOPSIS * ClearMem (mem: ARRAY OF SYSTEM.BYTE; n: LONGINT); * * ClearMemAPTR (mem: Exec.APTR; n: LONGINT); * * FUNCTION * These functions clear n bytes of memory starting at * address mem, or in case of ClearMem(), it clears the whole * structure represented by the mem BYTE-ARRAY if -1 is passed * for the n parameter. * * INPUTS * mem - the starting position for the clearing operation * as an ARRAY OF SYSTEM.BYTE for ClearMem() or as an * Exec.APTR for ClearMemAPTR() * n - the number of bytes to be cleared. In case of * ClearMem(), this parameter may be -1, in which case * the whole structure represented by the BYTE-ARRAY * is cleared. * * SEE ALSO * Exec/CopyMem(), Exec.CopyMemAPTR() * *****************************************************************************) PROCEDURE ClearMem * (mem: ARRAY OF y.BYTE; n: LONGINT); (* $CopyArrays- *) BEGIN IF n=-1 THEN n := LEN (mem); END; IF n < 1 THEN RETURN; END; WHILE n > 0 DO DEC (n); mem[n] := 0; END; END ClearMem; PROCEDURE ClearMemAPTR * (mem: e.APTR; n: LONGINT); VAR m: UNTRACED POINTER TO ARRAY 1 OF y.BYTE; BEGIN m := mem; IF n < 1 THEN RETURN; END; ClearMem (m^, n); END ClearMemAPTR; (****** BlackMagic/Max2 ***************************************************** * * NAME * Max2 - return the maximum of two numbers * Min2 - return the minimum of two numbers * * SYNOPSIS * Max2 (x, y: LONGINT): LONGINT; * * Min2 (x, y: LONGINT): LONGINT; * * FUNCTION * These functions just return the larger / smaller one of two * supplied numbers. As this job is needed very often, and * since many programmers are lazybones;-) who use roundabout * programming instead of implementing these functions, I decided * to supply these trivial functions. * * INPUTS * x,y - two numbers * * RESULT * the maximum / minimum of the supplied numbers * * NOTES * Max3() etc. can be emulated by code like 'Max2 (Max2 (x, y), z)', * of course. * *****************************************************************************) PROCEDURE Max2 * (x, y: LONGINT): LONGINT; BEGIN IF x > y THEN RETURN x; ELSE RETURN y; END; END Max2; PROCEDURE Min2 * (x, y: LONGINT): LONGINT; BEGIN IF x < y THEN RETURN x; ELSE RETURN y; END; END Min2; (****** BlackMagic/Strlastnicmp ********************************************** * * NAME * Strlastnicmp - length-limited case-insensitive backward str compare * * SYNOPSIS * Strlastnicmp (s1, s2: ARRAY OF CHAR, n: LONGINT): BOOLEAN; * * FUNCTION * This function provides the much needed but rarely found * complement for the Utility.Strnicmp() function. It compares * two strings starting from the last character. It returns * TRUE if the last n characters match, or if both strings * are shorter than n characters and match exactly. * The comparisons are performed case-insensitively using the * Utility.library Stricmp() function. * * INPUTS * s1,s2 - the strings to be compared * n - the maximum number of characters that may be taken * into account * * RESULT * TRUE for equality, FALSE otherwise * * SEE ALSO * Strlastncmp(), Utility/Strnicmp() * *****************************************************************************) PROCEDURE Strlastnicmp * (s1, s2: ARRAY OF CHAR; n: LONGINT): BOOLEAN; VAR l1, l2: LONGINT; (* $CopyArrays- *) BEGIN l1 := st.Length (s1); l2 := st.Length (s2); IF (l1 < n) OR (l2 < n) THEN RETURN u.Stricmp (s1, s2) = 0; END; RETURN u.Stricmp (StrIndex (s1, l1-n)^, StrIndex (s2, l2-n)^) = 0; END Strlastnicmp; (****** BlackMagic/Strlastncmp ********************************************** * * NAME * Strlastncmp - length-limited case-sensitive backward string compare * * SYNOPSIS * Strlastncmp (s1, s2: ARRAY OF CHAR, n: LONGINT): BOOLEAN; * * FUNCTION * Same as Strlastnicmp(), except that comparisons are made * case-sensitively. * * SEE ALSO * Strlastnicmp() * *****************************************************************************) PROCEDURE Strlastncmp * (s1, s2: ARRAY OF CHAR; n: LONGINT): BOOLEAN; VAR l1, l2: LONGINT; (* $CopyArrays- *) BEGIN l1 := st.Length (s1); l2 := st.Length (s2); IF (l1 < n) OR (l2 < n) THEN RETURN s1=s2; END; RETURN StrIndex (s1, l1-n)^ = StrIndex (s2, l2-n)^; END Strlastncmp; (****** BlackMagic/VisibleOfScreen ******************************************** * * NAME * VisibleOfScreen - return the visible region of a screen * * SYNOPSIS * VisibleOfScreen (scr : Intuition.ScreenPtr; * VAR visible: Graphics.Rectangle ): BOOLEAN; * * FUNCTION * This function fills in the supplied Graphics.Rectangle structure * with the bounds of the region of the provided Screen that is * currently visible in the Screen's DisplayClip. It handles * all possible cases of DisplayClip<->Screen dimensions. * * INPUTS * scr - the screen whose visible bounds you want to get * visible - the Graphics.Rectangle strucute that is to be filled * with the bounds. * * RESULT * TRUE if everything if the supplied Rectangle structure has been * filled with the bounds, FALSE if the necessary information couldn't * be obtained for some reason. Note that the supplied Rectangle * structure's coordinates are all filled with 0 if you pass * a NIL scr Intuition.ScreenPtr, or with the bounds of the whole * screen if the function fails due to another reason. * *****************************************************************************) CONST vTags = u.Tags2 (g.vTagViewPortExtraGet, NIL, g.vTagEndCM, NIL); PROCEDURE VisibleOfScreen * (scr: I.ScreenPtr; VAR visible: g.Rectangle): BOOLEAN; VAR VTags: u.Tags2; VPE : g.ViewPortExtraPtr; BEGIN VTags := vTags; visible.minX := 0; visible.minY := 0; visible.maxX := 0; visible.maxY := 0; IF scr = NIL THEN RETURN FALSE; END; visible.maxX := scr.width-1; visible.maxY := scr.height-1; IF g.VideoControl (scr.viewPort.colorMap, VTags) THEN RETURN FALSE; END; IF VTags[0].tag # g.vTagViewPortExtraSet THEN RETURN FALSE; END; IF VTags[0].data = NIL THEN RETURN FALSE; END; VPE := VTags[0].data; visible.minX := SHORT (Max2 (0, -scr.leftEdge + VPE.displayClip.minX)); visible.minY := SHORT (Max2 (0, -scr.topEdge + VPE.displayClip.minY)); visible.maxX := SHORT (Min2 (scr.width - 1, -scr.leftEdge + VPE.displayClip.maxX)); visible.maxY := SHORT (Min2 (scr.height - 1, -scr.topEdge + VPE.displayClip.maxY)); RETURN TRUE; END VisibleOfScreen; (****** BlackMagic/SPrintf **************************************************** * * NAME * SPrintf ¹ -- varargs sprintf output formatting using Exec.RawDoFmt * SPrintF ¹ -- varargs sprintf output formatting without result code * VSPrintf ¹ -- vector sprintf output formatting using Exec.RawDoFmt * VSPrintF ¹ -- vector sprintf output formatting without result code * * SYNOPSIS * BlackMagicVA.SPrintf (buffer: ARRAY OF CHAR; * format: ARRAY OF CHAR; * args..: Exec.APTR ): LONGINT; * * BlackMagicVA.SPrintF (buffer: ARRAY OF CHAR; * format: ARRAY OF CHAR; * args..: Exec.APTR ); * * BlackMagicVA.VSPrintf (buffer: ARRAY OF CHAR; * format: ARRAY OF CHAR; * args : Exec.APTR ): LONGINT; * * BlackMagicVA.VSPrintF (buffer: ARRAY OF CHAR; * format: ARRAY OF CHAR; * args : Exec.APTR ); * * FUNCTION * These functions are full featured implementations of sprintf()/ * vsprintf(), supporting also the nifty varargs paramters provided * by Amiga-Oberon for library calls. Due to the fact that these * functions are implemented as library functions, you may pass NIL * for the buffer ARRAY OF CHAR parameter which makes this function * doing nothing but returning the length WITHOUT the trailing null * byte of the generated output. * * INPUTS * buffer - the buffer into which the output is written to or * NIL * format - the format string with the formatting directives. * For a detailed description of all possible directives * have a look at Exec/RawDoFmt(). *ALL* directives * except of %s/%b require a leading 'l' right before the * type character, e.g. '%ld', '%08lx' or '%lc' instead of * '%d', '%08x' or '%c'. This is true for Dos/Printf() and * similar functions as well. * args - the arguments to be included into the generated * string according to the directives specified in the * format string. Either as varargs for SPrintf()/SPrintF() * or as a pointer to the arguemnts for VSPrintf()/ * VSPrintF() * * RESULT * LONGINT - the length of the generated output WITHOUT the trailing * null byte, which is actually written into the buffer * as the last byte. * * NOTES * ¹) All these functions are placed in the BlackMagicVA module! * * SEE ALSO * DynAppendFmt(), VDynAppendFmt(), Exec/RawDoFmt(), Dos/VPrintf() * *****************************************************************************) (* refer to BlackMagicVA for sprintf() - code *) (****** BlackMagic/DynAppendFmt *********************************************** * * NAME * DynAppendFmt/DSPrintf ¹ -- append sprintf str to a dynstr (varargs) * VDynAppendFmt/VDSPrintf -- append sprintf str to dynstr (vector args) * * SYNOPSIS * BlackMagicVA.DynAppendFmt * BlackMagicVA.DSPrintf (VAR dstr: DynStrPtr; * format : ARRAY OF CHAR; * args.. : Exec.APTR ): BOOLEAN; * * VDynAppendFmt * VDSPrintf (VAR dstr: DynStrPtr; * format : ARRAY OF CHAR; * args : Exec.APTR ): BOOLEAN; * * FUNCTION * These functions are similar to SPrintF()/VSPrintF(), except that * they act on dynamic strings rather than on simple strings, and * append the resulting string to the dynamic string rather than * overwriting it. Note that the valid string bounds will be _never_ * violated. * * INPUTS * dstr - the handle for the dynamic string, to which the * resulting string is appended to. May be NIL. * format - the format string with the formatting directives. * For a detailed description of all possible directives * have a look at Exec/RawDoFmt(). *ALL* directives * except of %s/%b require a leading 'l' right before the * type character, e.g. '%ld', '%08lx' or '%lc' instead of * '%d', '%08x' or '%c'. This is true for Dos/Printf() and * similar functions as well. * args - the arguments to be included into the generated * string according to the directives specified in the * format string. Either as varargs for DynAppendFmt()/ * DSPrintf() or as a pointer to the arguemnts for * VDynAppendFmt()/VDSPrintf(). * * RESULT * BOOLEAN - TRUE if the resulting string was successfully appended to * the dynamic string, FALSE otherwise. For FALSE, the * contents of the dynamic string, not necessarily its * handle, are left unchanged. * * NOTES * ¹) The functions with var args parameters are placed in the * BlackMagicVA module! The other functions are exported by both, * BlackMagic and BlackMagicVA. * * SEE ALSO * SPrintF(), VSPrintF(), Exec/RawDoFmt(), Dos/VPrintf() * *****************************************************************************) TYPE FmtDataPtr = UNTRACED POINTER TO FmtData; FmtData = STRUCT a5 : e.APTR; dstr : UNTRACED POINTER TO DynStrPtr; success : BOOLEAN; END; PROCEDURE FmtFunc1 (VAR data: FmtData; ch: CHAR); VAR chrs: ARRAY 2 OF CHAR; BEGIN IF ~data.success THEN RETURN; END; chrs[0] := ch; chrs[1] := '\000'; data.success := DynAppend (data.dstr^, chrs); END FmtFunc1; PROCEDURE FmtFunc (VAR data{11}: FmtData; ch{0}: CHAR; SaveA0Kludge{8}: LONGINT); VAR c: CHAR; (* Amiga-Oberon3.0 does not save A0 with SaveAllRegs+ - The SaveA0Kludge parameter solves that for you *) (* 7-Jul-93: Maybe that's not true - I discovered that ADis1.11 - a freeware symbolic *) (* reassembler I use - mismatches some MOVEM reglists! *) (* $StackChk- $SaveAllRegs+ *) BEGIN c := ch; (* d0/d1 volatile! *) y.SETREG (13, data.a5); FmtFunc1 (data, c); END FmtFunc; (* $StackChk= *) PROCEDURE DynAppendFmtInternal1 (dstr : UNTRACED POINTER TO DynStrPtr; format: LongStrPtr; args : e.APTR ): BOOLEAN; VAR data: FmtData; origLen : LONGINT; BEGIN data.a5 := y.REG (13); data.dstr := dstr; data.success := TRUE; origLen := DynStrLen (dstr^); e.RawDoFmt (format^, args, y.VAL (e.PROC, FmtFunc), y.ADR (data)); IF ~data.success THEN IF dstr^ # NIL THEN dstr^[origLen] := '\000'; END; END; RETURN data.success; END DynAppendFmtInternal1; PROCEDURE VDynAppendFmt * (VAR dstr: DynStrPtr; format : ARRAY OF CHAR; args : e.APTR ): BOOLEAN; (* $CopyArrays- *) BEGIN RETURN DynAppendFmtInternal1 (y.ADR (dstr), y.ADR (format[0]), args); END VDynAppendFmt; PROCEDURE VDSPrintf * (VAR dstr: DynStrPtr; format : ARRAY OF CHAR; args : e.APTR ): BOOLEAN; (* $CopyArrays- *) BEGIN RETURN DynAppendFmtInternal1 (y.ADR (dstr), y.ADR (format[0]), args); END VDSPrintf; (****** BlackMagic/DynFmtLocale *********************************************** * * NAME * DynFmtLocale ¹ -- do locale/FormatString() with a dynstr (varargs) * VDynFmtLocale -- do locale/FormatString() with dynstr (vector args) * * SYNOPSIS * BlackMagicVA.DynFmtLocale (VAR dstr: DynStrPtr; * locale : Locale.LocalePtr; * format : ARRAY OF CHAR; * args.. : Exec.APTR ): BOOLEAN; * * VDynFmtLocale (VAR dstr: DynStrPtr; * locale : Locale.LocalePtr; * format : ARRAY OF CHAR; * args : Exec.APTR ): BOOLEAN; * * FUNCTION * These functions offer a dynamic string interface to locale.library's * FormatString() function, which is a RawDoFmt() / xxxprintf() - like * string formatting function with some additional support for * localization. Both functions append the resulting string to the * dynamic string represented by the dstr handle. The valid string * bounds of dstr will never be violated, it rather returns failure * if not enough string space could be allocated. If Locale.base is * NIL, these functions perform a fallback to (V)DynAppendFmt(). * * INPUTS * dstr - the handle for the dynamic string, to which the * resulting string is appended to. May be NIL. * locale - the locale structure to use for formatting. May be NIL, * in which case the system's default locale is used. * format - the format string with the formatting directives. * For a detailed description of all possible directives * have a look at Locale/FormatString(). *ALL* directives * except of %s/%b require a leading 'l' right before the * type character, e.g. '%ld', '%08lx' or '%lc' instead of * '%d', '%08x' or '%c'. This is true for Dos/Printf() and * similar functions as well. * args - the arguments to be included into the generated * string according to the directives specified in the * format string. Either as varargs for DynFmtLocale() * or as a pointer to the arguemnts for VDynFmtLocale(). * * RESULT * BOOLEAN - TRUE if the resulting string was successfully appended * to the dynamic string, FALSE otherwise (Probably failed * memory allocation for the dynamic string or a NIL- * Locale.base). For FALSE, the contents of the dynamic * string, not necessarily its handle, are left unchanged. * * NOTES * ¹) The functions with var args parameters are placed in the * BlackMagicVA module! The other functions are exported by both, * BlackMagic and BlackMagicVA. * * SEE ALSO * DynAppendFmt(), Locale/FormatString(), FLPrintf() * *****************************************************************************) PROCEDURE FmtLocaleHookFunc1 (VAR data: FmtData; ch: LONGINT); VAR c2 : ARRAY 2 OF CHAR; BEGIN IF ~data.success THEN RETURN; END; c2[0] := CHR (ch); c2[1] := '\000'; data.success := DynAppend (data.dstr^, c2); END FmtLocaleHookFunc1; PROCEDURE FmtLocaleHookFunc (hk{8}: u.HookPtr; ch{9}: LONGINT); VAR data: FmtDataPtr; (* $StackChk- $SaveRegs+ *) BEGIN data := hk.data; y.SETREG (13, data.a5); FmtLocaleHookFunc1 (data^, ch); END FmtLocaleHookFunc; (* $StackChk= *) TYPE HookEntryProc = PROCEDURE(hook{8} : u.HookPtr; object{10}: e.APTR; message{9}: e.APTR): LONGINT; PROCEDURE DynFmtLocaleInternal1 (dstr : UNTRACED POINTER TO DynStrPtr; locale: loc.LocalePtr; format: LongStrPtr; args : e.APTR ): BOOLEAN; VAR hk : u.Hook; data : FmtData; origLen : LONGINT; locale1 : loc.LocalePtr; BEGIN IF ~DynExpand (dstr^, 0) THEN RETURN FALSE; END; IF format = NIL THEN RETURN TRUE; END; IF loc.base = NIL THEN RETURN VDSPrintf (dstr^, format^, args); END; IF locale = NIL THEN locale1 := loc.OpenLocale (NIL); ELSE locale1 := locale; END; hk.entry := y.VAL (HookEntryProc, FmtLocaleHookFunc); data.a5 := y.REG (13); hk.subEntry := NIL; hk.data := y.ADR (data); data.dstr := dstr; data.success := TRUE; origLen := DynStrLen (dstr^); y.SETREG (0, loc.FormatString (locale1, format^, args, hk)); IF ~data.success THEN IF dstr^ # NIL THEN dstr^[origLen] := '\000'; END; END; IF locale = NIL THEN loc.CloseLocale (locale1); END; RETURN data.success; END DynFmtLocaleInternal1; PROCEDURE VDynFmtLocale * (VAR dstr: DynStrPtr; locale : loc.LocalePtr; format : ARRAY OF CHAR; args : e.APTR ): BOOLEAN; (* $CopyArrays- *) BEGIN RETURN DynFmtLocaleInternal1 (y.ADR (dstr), locale, y.ADR (format[0]), args); END VDynFmtLocale; (****** BlackMagic/FLPrintf *************************************************** * * NAME * FLPrintf ¹ -- equivalent to Dos/FPrintf() with localization support * FLPrintF ¹ -- equivalent to FLPrintf without return code * VFLPrintF -- equivalent to FLPrintf with vector args * * SYNOPSIS * BlackMagicVA.FLPrintf (fh : d.FileHandlePtr; * locale: loc.LocalePtr; * format: ARRAY OF CHAR; * args..: e.APTR ): BOOLEAN; * * BlackMagicVA.FLPrintF (fh : d.FileHandlePtr; * locale: loc.LocalePtr; * format: ARRAY OF CHAR; * args..: e.APTR ); * * VFLPrintf (fh : d.FileHandlePtr; * locale: loc.LocalePtr; * format: ARRAY OF CHAR; * args : e.APTR ): BOOLEAN; * * FUNCTION * These functions use VDynFmtLocale() to build a string according * to the provided arguments and if this succeeded, they write it * to the fh file. * * INPUTS * fh - the file to write the resulting string to. * May be NIL, in which case stdout is used. * * Other: - see DynFmtLocale() * * RESULT * BOOLEAN - TRUE if the resulting string was successfully generated * and written, FALSE otherwise. * * NOTES * ¹) The functions with var args parameters are placed in the * BlackMagicVA module! The other functions are exported by both, * BlackMagic and BlackMagicVA. * * SEE ALSO * DynAppendFmt(), Locale/FormatString(), DynFmtLocale() * *****************************************************************************) PROCEDURE FLPrintfInternal1 (fh : d.FileHandlePtr; locale: loc.LocalePtr; format: LongStrPtr; args : e.APTR ): BOOLEAN; VAR ds: DynStrPtr; r : BOOLEAN; BEGIN ds := NIL; IF fh = NIL THEN fh := d.Output(); END; IF format = NIL THEN RETURN FALSE; END; r := VDynFmtLocale (ds, locale, format^, args); IF r THEN IF d.FPrintf (fh, "%s", StrIndex (ds^, 0)) # DynStrLen (ds) THEN r := FALSE; END; END; IF ds # NIL THEN DISPOSE (ds); END; RETURN r; END FLPrintfInternal1; PROCEDURE VFLPrintf * (fh : d.FileHandlePtr; locale : loc.LocalePtr; format : ARRAY OF CHAR; args : e.APTR ): BOOLEAN; (* $CopyArrays- *) BEGIN RETURN FLPrintfInternal1 (fh, locale, y.ADR (format[0]), args); END VFLPrintf; (****** BlackMagic/SimpleRequest ********************************************** * * NAME * SimpleRequest ¹ -- Easy altern. to Intuition.EasyRequest() (varargs) * SimpleRequestArgs -- Easy alternative to Intuition.EasyRequestArgs() * * SYNOPSIS * BlackMagicVA.SimpleRequest (win : Intuition.WindowPtr; * flags : LONGSET; * title : ARRAY OF CHAR; * txtfmt : ARRAY OF CHAR; * gadfmt : ARRAY OF CHAR; * args.. : Exec.APTR ): LONGINT; * * SimpleRequestArgs (win : Intuition.WindowPtr; * flags : LONGSET; * title : ARRAY OF CHAR; * txtfmt : ARRAY OF CHAR; * gadfmt : ARRAY OF CHAR; * args : Exec.APTR ): LONGINT; * * FUNCTION * Simplifies invokation of Intuition.EasyRequestArgs() to the * Oberon user. You may specify most of Intuition.EasyRequestArgs()' * possible parameters (window, easyStruct.title, easyStruct.txtfmt, * easyStruct.gadfmt and args (as varargs for SimpleRequest() or as * vector args for SimpleRequestArgs()). Furthermore, the possibility * of automatically locking the parent window is available. * * INPUTS * win - the requester's 'parent window.' Corresponds to * EasyRequestArgs()' window parameter. * flags - currently two flags are defined for this parameter: * - lockWindow: if you specify it, and you pass a * non-NIL win parameter, that window is locked and * set to busy state while the requester is displayed. * - ignoreTitle: if this flag is set, the title parameter * is ignored, behaviour is the same as described for * a NIL-title parameter. * title - the title text for the requester. For the functions * exported from BlackMagicVA, this parameter may be NIL * in which case the parent window's title is used, or * if no parent window is supplied, the system's default * title. Corresponds to EasyRequestArgs()' * easyStruct.title parameter. * txtfmt - the sprintf()-like text format string. Corresponds to * EasyRequestArgs()' easyStruct.textFormat parameter. * gadfmt - the sprintf()-like gadgets format string. Corresponds * to EasyRequestArgs()' easyStruct.gadgetFormat parameter. * The '|' character is used as the gadget separator * character. * args - the arguments for the txtfmt and gadfmt formatting * directives. Corresponds to EasyRequestArgs()' parameter * of the same name. Either as varargs for SimpleRequest() * or as vector args for SimpleRequestArgs(). * * RESULT * 0 for the rightmost gadget, otherwise the triggered gadget's * ordinal number from the left, starting at one. * * NOTES * ¹) The functions with var args parameters are placed in the * BlackMagicVA module! The other functions are exported by both, * BlackMagic and BlackMagicVA. * * SEE ALSO * Intuition/EasyRequestArgs() * *****************************************************************************) CONST lockWindow * = 0; ignoreTitle * = 1; simpleEasyStruct = I.EasyStruct ( SIZE (I.EasyStruct), LONGSET{}, NIL, NIL, NIL); PROCEDURE SimpleRequestInternal1 (win : I.WindowPtr; flags : LONGSET; title : e.APTR; txtfmt: e.APTR; gadfmt: e.APTR; args : e.APTR ): LONGINT; VAR es: I.EasyStruct; r : LONGINT; wl: WinLockPtr; BEGIN wl := NIL; IF ignoreTitle IN flags THEN title := NIL; END; es := simpleEasyStruct; es.textFormat := txtfmt; es.gadgetFormat := gadfmt; es.title := title; IF lockWindow IN flags THEN wl := LockWindow (win); END; r := I.EasyRequestArgs (win, y.ADR (es), NIL, args); UnlockWindow (wl); RETURN r; END SimpleRequestInternal1; PROCEDURE SimpleRequestArgs * (win : I.WindowPtr; flags : LONGSET; title : ARRAY OF CHAR; txtfmt: ARRAY OF CHAR; gadfmt: ARRAY OF CHAR; args : e.APTR ): LONGINT; (* $CopyArrays- *) BEGIN RETURN SimpleRequestInternal1 (win, flags, y.ADR (title[0]), y.ADR (txtfmt[0]), y.ADR (gadfmt[0]), args); END SimpleRequestArgs; (****** BlackMagic/GetTTYScreen *********************************************** * * NAME * GetTTYScreen -- returns the screen of a console's window * * SYNOPSIS * GetTTYScreen (tty: Dos.FileHandlePtr): Intuition.ScreenPtr; * * FUNCTION * GetTTYScreen returns a valid Intuition.ScreenPtr to the * screen, the passed console has a window opened on. The ScreenPtr * is guaranteed to be valid on the machine this function is invoked * from. If the passed FileHandle does not refer to a console with a * screen on the invoking machine, NIL is returned. * * INPUTS * tty - A valid FileHandle, may be NIL. * * RESULT * A valid Intuition.ScreenPtr of fhe invoking machine or NIL. * *****************************************************************************) PROCEDURE GetTTYScreen * (tty: d.FileHandlePtr): I.ScreenPtr; VAR pr : e.APTR; w : I.WindowPtr; id : d.InfoDataPtr; BEGIN w := NIL; IF tty = NIL THEN RETURN NIL; END; IF ~d.IsInteractive (tty) THEN RETURN NIL; END; IF PtrToInt (pr) <= 0 THEN RETURN NIL; END; id := e.AllocVec (SIZE (id^), LONGSET {e.memClear, e.public}); IF id = NIL THEN RETURN NIL; END; IF d.DoPkt1 (pr, d.diskInfo, BPtrVal (id)) = d.DOSTRUE THEN w := y.VAL (I.WindowPtr, id.volumeNode); END; e.FreeVec (id); IF w # NIL THEN RETURN w.wScreen; END; RETURN NIL; END GetTTYScreen; (****** BlackMagic/SetDynamicExtra ******************************************** * * NAME * SetDynamicExtra -- set BlackMagic's DynamicExtra var * * SYNOPSIS * SetDynamicExtra (extra: LONGINT); * * FUNCTION * This functions allows you to set BlackMagic's DynamicExtra (which is * exported for reading). DynamicExtra specifies the extra 'units' * BlackMagic should allocate whenever (re-)allocating Dynamic Strings * or Dynamic ToolType arrays. The default for DynamicExtra is currently * sixty-four. However, this may well change in the future. * * INPUTS * extra - the new DynamicExtra value. Negative values are ignored. * * RESULT * DynamicExtra will hold the specified positive (>= 0) extra value. * * SEE ALSO * DynAppend(), DynAppendTT() * *****************************************************************************) PROCEDURE SetDynamicExtra * (extra: LONGINT); BEGIN IF extra >= 0 THEN DynamicExtra := extra; END; END SetDynamicExtra; (****** BlackMagic/MemReqs **************************************************** * * NOTES * In this module's startup code, the OberonLib.MemReqs variable is * ensured to include the flags Exec.memClear _and_ Exec.public. This * effect is documented, so you can use NEW(), SYSTEM.ALLOCATE(), * OberonLib.New() and OberonLib.Allocate() for allocating all system * structures (only with _untraced_ pointers, of course) unless they are * in use beyond your program's termination. Note that it is of vital * importance for future compatability and things like virtual memory * management to have the Exec.public flag set when allocating several * system structures like MsgPorts, etc. In the current OberonLib * startup, the Exec.public flag is not set in OberonLib.MemReqs. * However, if you allocate vast amounts of data records that are * private to your application, it is recommended to clear the * Exec.public flag for these allocations with * 'EXCL (OberonLib.MemReqs, Exec.public);' because otherwise possible * virtual memory ressources would be disabled from being used by your * program. 'Manual' inclusion of Exec.public can be achieved by * 'INCL (OberonLib.MemReqs, Exec.public);' * * Finally, it must be stated, that you can only be sure that the * Exec.memClear & Exec.public flags are set in OberonLib.MemReqs if * you don't import modules that clear these flags in their startup * code (Usually, decent modules don't do things like that!). * * SEE ALSO * Exec/AllocMem() * *****************************************************************************) BEGIN DynamicExtra := defaultDynamicExtra; o.MemReqs := o.MemReqs + LONGSET{e.public,e.memClear}; IF I.int.libNode.version >= 39 THEN int39 := I.int; END; UnderScore := '_'; CLOSE IF loc.base # NIL THEN IF DefaultCatalog # NIL THEN loc.CloseCatalog (DefaultCatalog); END; END; IF waitPointer # NIL THEN e.FreeVec (waitPointer); END; END BlackMagic.