diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 5e4556e..f665b6c 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -541,6 +541,35 @@ information is initialized. (|spad|)) @ + +\defun{spadStartUpMsgs}{The startup banner messages} +\calls{spadStartUpMsgs}{fillerSpaces} +\calls{spadStartUpMsgs}{specialChar} +\calls{spadStartUpMsgs}{sayKeyedMsg} +\calls{spadStartUpMsgs}{sayMSG} +\usesdollar{spadStartUpMsgs}{msgAlist} +\usesdollar{spadStartUpMsgs}{opSysName} +\usesdollar{spadStartUpMsgs}{linelength} +\uses{spadStartUpMsgs}{*yearweek*} +\uses{spadStartUpMsgs}{*build-version*} +<>= +(defun |spadStartUpMsgs| () + (let (bar) + (declare (special |$msgAlist| |$opSysName| $linelength *yearweek* + *build-version*)) + (when (> $linelength 60) + (setq bar (|fillerSpaces| $LINELENGTH (|specialChar| '|hbar|))) + (|sayKeyedMsg| 'S2GL0001 (list *build-version* *yearweek*)) + (|sayMSG| bar) + (|sayKeyedMsg| 'S2GL0018C nil) + (|sayKeyedMsg| 'S2GL0018D nil) + (|sayKeyedMsg| 'S2GL0003B (list |$opSysName|)) + (|sayMSG| bar) + (setq |$msgAlist| nil) + (|sayMSG| '| |)))) + +@ + \defunsec{spad}{Starts the interpreter but do not read in profiles} \calls{spad}{setOutputAlgebra} \calls{spad}{runspad} @@ -4303,10 +4332,10 @@ This function is used to build the scanKeyTable \calls{npParse}{pfWrong} \calls{npParse}{pfDocument} \calls{npParse}{pfListOf} -\usesdolloar{npParse}{ttok} -\usesdolloar{npParse}{stok} -\usesdolloar{npParse}{stack} -\usesdolloar{npParse}{inputStream} +\usesdollar{npParse}{ttok} +\usesdollar{npParse}{stok} +\usesdollar{npParse}{stack} +\usesdollar{npParse}{inputStream} <>= (defun |npParse| (stream) (let (|$ttok| |$stok| |$stack| |$inputStream| found) @@ -4386,9 +4415,9 @@ where head is either an id or (id . alist) \calls{npFirstTok}{tokConstruct} \calls{npFirstTok}{tokPosn} \calls{npFirstTok}{tokPart} -\usesdolloar{npFirstTok}{ttok} -\usesdolloar{npFirstTok}{stok} -\usesdolloar{npFirstTok}{inputStream} +\usesdollar{npFirstTok}{ttok} +\usesdollar{npFirstTok}{stok} +\usesdollar{npFirstTok}{inputStream} <>= (defun |npFirstTok| () (declare (special |$ttok| |$stok| |$inputStream|)) @@ -4400,7 +4429,7 @@ where head is either an id or (id . alist) @ \defun{npPush}{Push one item onto \$stack} -\usesdolloar{npPush}{stack} +\usesdollar{npPush}{stack} <>= (defun |npPush| (x) (declare (special |$stack|)) @@ -4409,7 +4438,7 @@ where head is either an id or (id . alist) @ \defun{npPop1}{Pop one item off \$stack} -\usesdolloar{npPop1}{stack} +\usesdollar{npPop1}{stack} <>= (defun |npPop1| () (declare (special |$stack|)) @@ -4418,7 +4447,7 @@ where head is either an id or (id . alist) @ \defun{npPop2}{Pop the second item off \$stack} -\usesdolloar{npPop2}{stack} +\usesdollar{npPop2}{stack} <>= (defun |npPop2| () (let (a) @@ -4429,7 +4458,7 @@ where head is either an id or (id . alist) @ \defun{npPop3}{Pop the third item off \$stack} -\usesdolloar{npPop3}{stack} +\usesdollar{npPop3}{stack} <>= (defun |npPop3| () (let (a) @@ -4452,8 +4481,8 @@ where head is either an id or (id . alist) \defun{npEqKey}{Advance over a keyword} Test for the keyword, if found advance the token stream \calls{npEqKey}{npNext} -\usesdolloar{npEqKey}{ttok} -\usesdolloar{npEqKey}{stok} +\usesdollar{npEqKey}{ttok} +\usesdollar{npEqKey}{stok} <>= (defun |npEqKey| (keyword) (declare (special |$ttok| |$stok|)) @@ -4469,7 +4498,7 @@ This advances the input stream. The call to npFirstTok picks off the next token in the input stream and updates the current leaf (\$stok) and the current token (\$ttok) \calls{npNext}{npFirstTok} -\usesdolloar{npNext}{inputStream} +\usesdollar{npNext}{inputStream} <>= (defun |npNext| () (declare (special |$inputStream|)) @@ -4512,7 +4541,7 @@ and the current token (\$ttok) \calls{npListofFun}{npPop3} \calls{npListofFun}{npPop2} \calls{npListofFun}{npPop1} -\usesdolloar{npListofFun}{stack} +\usesdollar{npListofFun}{stack} <>= (defun |npListofFun| (f h g) (let (a) @@ -4533,6 +4562,243 @@ and the current token (\$ttok) @ +\chapter{Keyed Message Handling} +Throughout the interpreter there are messages printed using a symbol +for a database lookup. This was done to enable translation of these +messages languages other than English. + +Axiom messages are read from a flat file database and returned +as one long string. They are preceded in the database by a key and +this is how they are referenced from code. For example, one key is +S2IL0001 which means: +\begin{verbatim} + S2 Scratchpad II designation + I from the interpreter + L originally from LISPLIB BOOT + 0001 a sequence number +\end{verbatim} + +Each message may contain formatting codes and and parameter codes. +The formatting codes are: +\begin{verbatim} + %b turn on bright printing + %ceoff turn off centering + %ceon turn on centering + %d turn off bright printing + %f user defined printing + %i start indentation of 3 more spaces + %l start a new line + %m math-print an expression + %rjoff turn off right justification (actually ragged left) + %rjon turn on right justification (actually ragged left) + %s pretty-print as an S-expression + %u unindent 3 spaces + %x# insert # spaces +\end{verbatim} + +The parameter codes look like \%1, \%2b, \%3p, \%4m, \%5bp, \%6s where the +digit is the parameter number and the letters following indicate +additional formatting. You can indicate as many additional formatting +qualifiers as you like, to the degree they make sense. +\begin{itemize} +\item The ``p'' code means to call prefix2String on the parameter, +a standard way of printing abbreviated types. +\item The ``P'' operator maps prefix2String over its arguments. +\item The ``o'' operation formats the argument as an operation name. +\item The ``b'' means to print that parameter in a bold (bright) font. +\item The ``c'' means to center that parameter on a new line. +\item The ``r'' means to right justify (ragged left) the argument. +\item The ``f'' means that the parameter is a list [fn, :args] +and that ``fn'' is to be called on ``args'' to get the text. +\end{itemize} + +Look in the file with the name defined in \$defaultMsgDatabaseName +above for examples. + +\defdollar{cacheMessages} +This is used for debugging +<>= +(defvar |$cacheMessages| t) + +@ + +\defdollar{msgAlist} +<>= +(defvar |$msgAlist| nil) + +@ + +\defdollar{msgDatabaseName} +<>= +(defvar |$msgDatabaseName| nil) + +@ + +\defdollar{testingErrorPrefix} +<>= +(defvar |$testingErrorPrefix| "Daly Bug") + +@ + +\defdollar{texFormatting} +<>= +(defvar |$texFormatting| nil) + +@ + +\defvar{*msghash*} +<>= +(defvar *msghash* nil "hash table keyed by msg number") + +@ + +\defdollar{msgdbPrims} +<>= +(defvar |$msgdbPrims| + '(|%b| |%d| |%l| |%i| |%u| %U |%n| |%x| |%ce| |%rj| "%U" "%b" "%d" + "%l" "%i" "%u" "%U" "%n" "%x" "%ce" "%rj")) + +@ + +\defdollar{msgdbPunct} +<>= +(defvar |$msgdbPunct| + '(|.| |,| ! |:| |;| ? ] |)| "." "," "!" ":" ";" "?" "]" ")")) + +@ + +\defdollar{msgdbNoBlanksBeforeGroup} +<>= +(defvar |$msgdbNoBlanksBeforeGroup| + `(" " | | "%" % ,@|$msgdbPrims| ,@|$msgdbPunct|)) + +@ + +\defdollar{msgdbNoBlanksAfterGroup} +<>= +(defvar |$msgdbNoBlanksAfterGroup| + `(" " | | "%" % ,@|$msgdbPrims| [ |(| "[" "(")) + +@ + +\defun{fetchKeyedMsg}{Fetch a message from the message database} +If the {\tt *msghash*} hash table is empty we call {\tt cacheKeyedMsg} +to fill the table, otherwise we do a key lookup in the hash table. +\calls{fetchKeyedMsg}{object2Identifier} +\calls{fetchKeyedMsg}{cacheKeyedMsg} +\usesdollar{fetchKeyedMsg}{defaultMsgDatabaseName} +\uses{fetchKeyedMsg}{*msghash*} +<>= +(defun |fetchKeyedMsg| (key ignore) + (declare (ignore ignore) (special *msghash* |$defaultMsgDatabaseName|)) + (setq key (|object2Identifier| key)) + (unless *msghash* + (setq *msghash* (make-hash-table)) + (cacheKeyedMsg |$defaultMsgDatabaseName|)) + (gethash key *msghash*)) + +@ + +\defun{cacheKeyedMsg}{Cache messages read from message database} +\uses{cacheKeyedMsg}{*msghash*} +<>= +(defun cacheKeyedMsg (file) + (let ((line "") (msg "") key) + (declare (special *msghash*)) + (with-open-file (in file) + (catch 'done + (loop + (setq line (read-line in nil nil)) + (cond + ((null line) + (when key (setf (gethash key *msghash*) msg)) + (throw 'done nil)) + ((= (length line) 0)) + ((char= (schar line 0) #\S) + (when key (setf (gethash key *msghash*) msg)) + (setq key (intern line "BOOT")) + (setq msg "")) + ('else + (setq msg (concatenate 'string msg line))))))))) + +@ + +\defun{getKeyedMsg}{getKeyedMsg} +\calls{getKeyedMsg}{fetchKeyedMsg} +<>= +(defun |getKeyedMsg| (key) (|fetchKeyedMsg| key nil)) + +@ + +\defun{sayKeyedMsg}{Say a message using a keyed lookup} +\calls{sayKeyedMsg}{sayKeyedMsgLocal} +\usesdollar{sayKeyedMsg}{texFormatting} +<>= +(defun |sayKeyedMsg| (key args) + (let (|$texFormatting|) + (declare (special |$texFormatting|)) + (setq |$texFormatting| nil) + (|sayKeyedMsgLocal| key args))) +@ + +\defun{sayKeyedMsgLocal}{Handle msg formatting and print to file} +\calls{sayKeyedMsgLocal}{segmentKeyedMsg} +\calls{sayKeyedMsgLocal}{getKeyedMsg} +\calls{sayKeyedMsgLocal}{substituteSegmentedMsg} +\calls{sayKeyedMsgLocal}{flowSegmentedMsg} +\calls{sayKeyedMsgLocal}{sayMSG2File} +\calls{sayKeyedMsgLocal}{sayMSG} +\usesdollar{sayKeyedMsgLocal}{printMsgsToFile} +\usesdollar{sayKeyedMsgLocal}{linelength} +\usesdollar{sayKeyedMsgLocal}{margin} +\usesdollar{sayKeyedMsgLocal}{displayMsgNumber} +<>= +(defun |sayKeyedMsgLocal| (key args) + (let (msg msgp) + (declare (special |$printMsgsToFile| $linelength $margin |$displayMsgNumber|)) + (setq msg (|segmentKeyedMsg| (|getKeyedMsg| key))) + (setq msg (|substituteSegmentedMsg| msg args)) + (when |$displayMsgNumber| (setq msg `("%b" ,key |:| "%d" . ,msg))) + (setq msgp (|flowSegmentedMsg| msg $linelength $margin)) + (when |$printMsgsToFile| (|sayMSG2File| msgp)) + (|sayMSG| msgp))) + +@ + +\defun{segmentKeyedMsg}{Break a message into words} +\calls{segmentKeyedMsg}{string2Words} +<>= +(defun |segmentKeyedMsg| (msg) (|string2Words| msg)) + +@ + +\defun{sayMSG2File}{Write a msg into spadmsg.listing file} +\calls{sayMSG2File}{makePathname} +\calls{sayMSG2File}{defiostream} +\calls{sayMSG2File}{sayBrightly1} +\calls{sayMSG2File}{shut} +\usesdollar{sayMSG2File}{listingDirectory} +<>= +(defun |sayMSG2File| (msg) + (let (file str) + (declare (special |$listingDirectory|)) + (setq file (|makePathname| '|spadmsg| '|listing| |$listingDirectory|)) + (setq str (defiostream `((mode . output) (file . ,file)) 255 0)) + (sayBrightly1 msg str) + (shut str))) + +@ + +\defun{sayMSG}{sayMSG} +\calls{saymsg}{saybrightly1} +\usesdollar{sayMSG}{algebraOutputStream} +<>= +(defun |sayMSG| (x) + (declare (special |$algebraOutputStream|)) + (when x (sayBrightly1 x |$algebraOutputStream|))) + +@ + \chapter{Stream Utilities} The input stream is parsed into a large s-expression by repeated calls to Delay. Delay takes a function f and an argument x and returns a list @@ -7598,7 +7864,7 @@ where head is either an id or (id . alist) @ \defun{poNoPosition}{poNoPosition} -\usesdolloar{poNoPosition}{nopos} +\usesdollar{poNoPosition}{nopos} <>= (defun |poNoPosition| () (declare (special |$nopos|)) @@ -10327,6 +10593,7 @@ If there is only one then we clean it up and print it. (|sayNewLine|)))) @ + \defun{cleanupLine}{cleanupLine} This function expects example lines in internal format that has been partially processed to remove the prefix. Thus we get lines that look @@ -17349,6 +17616,12 @@ The current setting is: On:CONSOLE NIL) @ +\defdollar{algebraOutputStream} +<>= +(defvar |$algebraOutputStream| *standard-output*) + +@ + \defun{setOutputAlgebra}{setOutputAlgebra} \calls{setOutputAlgebra}{defiostream} \calls{setOutputAlgebra}{concat} @@ -24632,22 +24905,6 @@ Note that this assumes ``table'' is a string. @ -\defdollar{algebraOutputStream} -<>= -(defvar |$algebraOutputStream| *standard-output*) - -@ - -\defun{sayMSG}{sayMSG} -\calls{saymsg}{saybrightly1} -\usesdollar{sayMSG}{algebraOutputStream} -<>= -(defun |sayMSG| (x) - (declare (special |$algebraOutputStream|)) - (when x (sayBrightly1 x |$algebraOutputStream|))) - -@ - \chapter{Common Lisp Algebra Support} These functions are called directly from the algebra source code. They fall into two basic categories, one are the functions that are @@ -25479,6 +25736,7 @@ maxindex <> <> +<> <> <> <> @@ -25580,6 +25838,7 @@ maxindex <> <> +<> <> <> <> @@ -25613,6 +25872,7 @@ maxindex <> <> <> +<> <> <> <> @@ -25938,7 +26198,10 @@ maxindex <> <> <> +<> +<> <> +<> <> <> <> @@ -25967,6 +26230,7 @@ maxindex <> <> <> +<> <> <> <> @@ -26027,6 +26291,7 @@ maxindex <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index e2d6329..4b1078e 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +20091220 tpd src/axiom-website/patches.html 20091220.01.lxd.patch +20091220 tpd src/interp/vmlisp.lisp move say messages into bookvol5 +20091220 tpd src/interp/patches.lisp move say messages into bookvol5 +20091220 tpd src/interp/msgdb.lisp move say messages into bookvol5 +20091220 tpd books/bookvol5 tree shake more functions into interpreter 20091219 tpd src/axiom-website/patches.html 20091219.03.lxd.patch 20091219 lxd src/axiom-website/hyperdoc/axbook/section-1.5.xhtml fix typos 20091219 lxd src/axiom-website/hyperdoc/axbook/section-1.4.xhtml fix typos diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 14d2f75..84c4761 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2324,5 +2324,7 @@ books/bookvol0,1,7.1 Lee Duham fix typos, added to credits
src/axiom-website/hyperdoc brought under git source control
20091219.03.lxd.patch src/hyperdoc/axbook fix Lee Duham typos, add Stack, Queue
+20091220.01.tpd.patch +books/bookvol5 tree shake code from msgdb, vmlisp, patches
diff --git a/src/interp/msgdb.lisp.pamphlet b/src/interp/msgdb.lisp.pamphlet index 79c6af7..c212ae9 100644 --- a/src/interp/msgdb.lisp.pamphlet +++ b/src/interp/msgdb.lisp.pamphlet @@ -9,79 +9,10 @@ \eject \tableofcontents \eject -\begin{verbatim} -Description of Messages - -Axiom messages are read from a flat file database and returned -as one long string. They are preceded in the database by a key and -this is how they are referenced from code. For example, one key is -S2IL0001 which means: - S2 Scratchpad II designation - I from the interpreter - L originally from LISPLIB BOOT - 0001 a sequence number - -Each message may contain formatting codes and and parameter codes. -The formatting codes are: - %b turn on bright printing - %ceoff turn off centering - %ceon turn on centering - %d turn off bright printing - %f user defined printing - %i start indentation of 3 more spaces - %l start a new line - %m math-print an expression - %rjoff turn off right justification (actually ragged left) - %rjon turn on right justification (actually ragged left) - %s pretty-print as an S-expression - %u unindent 3 spaces - %x# insert # spaces - -The parameter codes look like %1, %2b, %3p, %4m, %5bp, %6s where the -digit is the parameter number ans the letters following indicate -additional formatting. You can indicate as many additional formatting -qualifiers as you like, to the degree they make sense. The "p" code -means to call prefix2String on the parameter, a standard way of -printing abbreviated types. The "P" operator maps prefix2String over -its arguments. The "o" operation formats the argument as an operation -name. "b" means to print that parameter in -a bold (bright) font. "c" means to center that parameter on a -new line. "f" means that the parameter is a list [fn, :args] -and that "fn" is to be called on "args" to get the text. "r" means -to right justify (ragged left) the argument. - -Look in the file with the name defined in $defaultMsgDatabaseName -above for examples. - -\end{verbatim} <<*>>= (IN-PACKAGE "BOOT" ) -;--% Message Database Code and Message Utility Functions -;SETANDFILEQ($msgDatabase,NIL) - - -;SETANDFILEQ($cacheMessages,'T) -- for debugging purposes - -(SETANDFILEQ |$cacheMessages| 'T) - -;SETANDFILEQ($msgAlist,NIL) - -(SETANDFILEQ |$msgAlist| NIL) - -;SETANDFILEQ($msgDatabaseName,NIL) - -(SETANDFILEQ |$msgDatabaseName| NIL) - -;SETANDFILEQ($testingErrorPrefix, '"Daly Bug") - -(SETANDFILEQ |$testingErrorPrefix| (MAKESTRING "Daly Bug")) - -;SETANDFILEQ($texFormatting, false) - -(SETANDFILEQ |$texFormatting| NIL) - ;--% Accessing the Database ;string2Words l == ; i := 0 @@ -165,15 +96,6 @@ above for examples. (SPADLET |buf| (STRCONC |buf| |c|)))) (CONS |buf| (CONS (PLUS |k| 1) NIL))))))) -;getKeyedMsg key == fetchKeyedMsg(key,false) - -(DEFUN |getKeyedMsg| (|key|) (|fetchKeyedMsg| |key| NIL)) - -;--% Formatting and Printing Keyed Messages -;segmentKeyedMsg(msg) == string2Words msg - -(DEFUN |segmentKeyedMsg| (|msg|) (|string2Words| |msg|)) - ;segmentedMsgPreprocess x == ; ATOM x => x ; [head,:tail] := x @@ -596,27 +518,6 @@ above for examples. (SPADLET |x| |y|)))))) (NREVERSE |msg1|))))))) -;SETANDFILEQ($msgdbPrims,'( %b %d %l %i %u %U %n %x %ce %rj "%U" "%b" "%d" "%l" "%i" "%u" "%U" "%n" "%x" "%ce" "%rj")) - -(SETANDFILEQ |$msgdbPrims| - '(|%b| |%d| |%l| |%i| |%u| %U |%n| |%x| |%ce| |%rj| "%U" "%b" "%d" - "%l" "%i" "%u" "%U" "%n" "%x" "%ce" "%rj")) - - -;SETANDFILEQ($msgdbPunct,'(_. _, _! _: _; _? _] _) "." "," "!" ":" ";" "?" "]" ")" )) - -(SETANDFILEQ |$msgdbPunct| - '(|.| |,| ! |:| |;| ? ] |)| "." "," "!" ":" ";" "?" "]" ")")) - -;SETANDFILEQ($msgdbNoBlanksBeforeGroup,['" ", " ", '"%", "%",_ -; :$msgdbPrims, :$msgdbPunct]) - -(SETANDFILEQ |$msgdbNoBlanksBeforeGroup| - (CONS (MAKESTRING " ") - (CONS '| | - (CONS (MAKESTRING "%") - (CONS '% (APPEND |$msgdbPrims| |$msgdbPunct|)))))) - ;SETANDFILEQ($msgdbListPrims,'(%m %s %ce %rj "%m" "%s" "%ce" "%rj")) (SETANDFILEQ |$msgdbListPrims| @@ -652,19 +553,6 @@ above for examples. 'T) ('T NIL))))))) -;$msgdbPunct := '(_[ _( "[" "(" ) - -(SPADLET |$msgdbPunct| '([ |(| "[" "(")) - -;SETANDFILEQ($msgdbNoBlanksAfterGroup,['" ", " ",'"%" ,"%",_ -; :$msgdbPrims,:$msgdbPunct]) - -(SETANDFILEQ |$msgdbNoBlanksAfterGroup| - (CONS (MAKESTRING " ") - (CONS '| | - (CONS (MAKESTRING "%") - (CONS '% (APPEND |$msgdbPrims| |$msgdbPunct|)))))) - ;noBlankAfterP word== ; INTP word => false ; word in $msgdbNoBlanksAfterGroup => true @@ -792,45 +680,6 @@ above for examples. (SPADLET |$texFormatting| 'T) (|sayKeyedMsgLocal| |key| |args|))))) -;sayKeyedMsg(key,args) == -; $texFormatting: fluid := false -; sayKeyedMsgLocal(key, args) - -(DEFUN |sayKeyedMsg| (|key| |args|) - (PROG (|$texFormatting|) - (DECLARE (SPECIAL |$texFormatting|)) - (RETURN - (PROGN - (SPADLET |$texFormatting| NIL) - (|sayKeyedMsgLocal| |key| |args|))))) - -;sayKeyedMsgLocal(key, args) == -; msg := segmentKeyedMsg getKeyedMsg key -; msg := substituteSegmentedMsg(msg,args) -; if $displayMsgNumber then msg := ['"%b",key,":",'"%d",:msg] -; msg' := flowSegmentedMsg(msg,$LINELENGTH,$MARGIN) -; if $printMsgsToFile then sayMSG2File msg' -; sayMSG msg' - -(DEFUN |sayKeyedMsgLocal| (|key| |args|) - (PROG (|msg| |msg'|) - (declare (special |$printMsgsToFile| $LINELENGTH $MARGIN - |$displayMsgNumber|)) - (RETURN - (PROGN - (SPADLET |msg| (|segmentKeyedMsg| (|getKeyedMsg| |key|))) - (SPADLET |msg| (|substituteSegmentedMsg| |msg| |args|)) - (COND - (|$displayMsgNumber| - (SPADLET |msg| - (CONS (MAKESTRING "%b") - (CONS |key| - (CONS '|:| - (CONS (MAKESTRING "%d") |msg|))))))) - (SPADLET |msg'| (|flowSegmentedMsg| |msg| $LINELENGTH $MARGIN)) - (COND (|$printMsgsToFile| (|sayMSG2File| |msg'|))) - (|sayMSG| |msg'|))))) - ;throwKeyedErrorMsg(kind,key,args) == ; BUMPERRORCOUNT kind ; sayMSG '" " @@ -1490,58 +1339,6 @@ above for examples. (DEFUN |sayString| (|x|) (PRINTEXP |x|)) -;spadStartUpMsgs() == -; -- messages displayed when the system starts up -; $LINELENGTH < 60 => NIL -; bar := fillerSpaces($LINELENGTH,specialChar 'hbar) -; sayKeyedMsg("S2GL0001",[_*BUILD_-VERSION_*, _*YEARWEEK_*]) -; sayMSG bar -; sayKeyedMsg("S2GL0018C",NIL) -; sayKeyedMsg("S2GL0018D",NIL) -; sayKeyedMsg("S2GL0003B",[$opSysName]) -; sayMSG bar -;-- sayMSG bar -;-- sayMSG '" *" -;-- sayMSG '" ***** ** ** *** ****** ** * *" -;-- sayMSG '" * * * * * * * ** ** ** **" -;-- sayMSG '" * * * * * * ** *** **" -;-- sayMSG '" ****** * * * * * * *" -;-- sayMSG '" * * * * * * * * * *" -;-- sayMSG '" * * * * * * * * * *" -;-- sayMSG '" * * * * * * * * * *" -;-- sayMSG '" ***** * ** ** *** **** ** *** ***" -;-- sayMSG '" *" -;-- sayMSG '" Issue )copyright for copyright notices." -;-- sayKeyedMsg("S2GL0018A",NIL) -;-- sayKeyedMsg("S2GL0018B",NIL) -;-- sayKeyedMsg("S2GL0003C",NIL) -;-- sayKeyedMsg("S2GL0003A",NIL) -;-- if not $printTimeIfTrue then sayKeyedMsg("S2GL0004",NIL) -;-- if not $printTypeIfTrue then sayKeyedMsg("S2GL0005",NIL) -; -- if not $displaySetValue then sayKeyedMsg("S2GL0007",NIL) -;-- if not $HiFiAccess then sayKeyedMsg("S2GL0008",NIL) -;-- sayMSG bar -;-- version() -; $msgAlist := NIL -- these msgs need not be saved -; sayMSG " " - -(DEFUN |spadStartUpMsgs| () - (PROG (|bar|) - (declare (special |$msgAlist| |$opSysName| $LINELENGTH *YEARWEEK* - *BUILD-VERSION*)) - (RETURN - (COND - ((> 60 $LINELENGTH) NIL) - ('T - (SPADLET |bar| - (|fillerSpaces| $LINELENGTH (|specialChar| '|hbar|))) - (|sayKeyedMsg| 'S2GL0001 - (CONS *BUILD-VERSION* (CONS *YEARWEEK* NIL))) - (|sayMSG| |bar|) (|sayKeyedMsg| 'S2GL0018C NIL) - (|sayKeyedMsg| 'S2GL0018D NIL) - (|sayKeyedMsg| 'S2GL0003B (CONS |$opSysName| NIL)) - (|sayMSG| |bar|) (SPADLET |$msgAlist| NIL) (|sayMSG| '| |)))))) - ;HELP() == sayKeyedMsg("S2GL0019",NIL) ;;; *** HELP REDEFINED diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet index 9302a9d..855d6be 100644 --- a/src/interp/patches.lisp.pamphlet +++ b/src/interp/patches.lisp.pamphlet @@ -321,36 +321,6 @@ It used to read: #-(or :CCL (and :lucid :ibm/370)) (setq vmlisp::$current-directory (make-directory *default-pathname-defaults*)) -(defvar *msghash* nil "hash table keyed by msg number") - -(defun cacheKeyedMsg (file) - (let ((line "") (msg "") key) - (with-open-file (in file) - (catch 'done - (loop - (setq line (read-line in nil nil)) - (cond - ((null line) - (when key - (setf (gethash key *msghash*) msg)) - (throw 'done nil)) - ((= (length line) 0)) - ((char= (schar line 0) #\S) - (when key - (setf (gethash key *msghash*) msg)) - (setq key (intern line "BOOT")) - (setq msg "")) - ('else - (setq msg (concatenate 'string msg line))))))))) - -(defun |fetchKeyedMsg| (key ignore) - (declare (ignore ignore)) - (setq key (|object2Identifier| key)) - (unless *msghash* - (setq *msghash* (make-hash-table)) - (cacheKeyedMsg |$defaultMsgDatabaseName|)) - (gethash key *msghash*)) - #+:AKCL (proclaim '(ftype (function (t) t) identity)) #+:AKCL (defun identity (x) x) diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index c249cc5..0e8055b 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -4004,16 +4004,6 @@ The original code was: (defun |sayMSGNT| (X) (if (NULL X) NIL (sayBrightlyNT1 X |$algebraOutputStream|))) -(defun |sayMSG2File| (msg) - (PROG (file str) - (SETQ file (|makePathname| '|spadmsg| '|listing| |$listingDirectory|)) - (SETQ str - (DEFIOSTREAM - (CONS '(MODE . OUTPUT) (CONS (CONS 'FILE file) NIL)) - 255 0)) - (sayBrightly1 msg str) - (SHUT str) ) ) - (defvar |$fortranOutputStream|) (defun |sayFORTRAN| (x) "Prints on Fortran output stream."