From 4cf01c994ae67046b45b672d6f21f99008876cb3 Mon Sep 17 00:00:00 2001 From: Tim Daly Date: Wed, 22 Apr 2015 20:14:31 -0400 Subject: [PATCH] src/interp/msgdb.lisp remove dead code, simplify Certain functions were never used or used a few times. These were removed and code elsewhere rewritten. In particular, centering code can be done directly by common lisp format strings so a lot of this was removed. --- books/bookvol10.4.pamphlet | 2 +- books/bookvol5.pamphlet | 108 +-- changelog | 9 + patch | 10 +- src/axiom-website/patches.html | 2 + src/input/setcmd.input.pamphlet | 10 +- src/interp/br-con.lisp.pamphlet | 65 ++ src/interp/clam.lisp.pamphlet | 2 +- src/interp/g-util.lisp.pamphlet | 2 +- src/interp/msgdb.lisp.pamphlet | 1634 ++++++++++++++------------------------- src/interp/util.lisp.pamphlet | 3 +- 11 files changed, 719 insertions(+), 1128 deletions(-) diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet index c5ed27d..49cc200 100644 --- a/books/bookvol10.4.pamphlet +++ b/books/bookvol10.4.pamphlet @@ -27270,7 +27270,7 @@ ErrorFunctions() : Exports == Implementation where prefix2 : String := "Error signalled from user code in function " doit(s : String) : Exit == - throwPatternMsg(s,nil$(List String))$Lisp + throwKeyedMsg(s,nil$(List String))$Lisp -- there are no objects of type Exit, so we'll fake one, -- knowing we will never get to this step anyway. "exit" pretend Exit diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index e7a219e..cadb026 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -1676,7 +1676,6 @@ Properties of r :: \calls{trace1}{qslessp} \calls{trace1}{poundsign} \calls{trace1}{untrace} -\calls{trace1}{centerAndHighlight} \calls{trace1}{ptimers} \calls{trace1}{say} \calls{trace1}{pcounters} @@ -1775,10 +1774,12 @@ Properties of r :: (setq opt (cdr temp1)) (cond ((null opt) - (|centerAndHighlight| "Traced function execution times" 78 '-) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) + " Traced function execution times ") (|ptimers|) (say " ") - (|centerAndHighlight| "Traced function execution counts" 78 '-) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) + " Traced function execution counts ") (|pcounters|)) (t (|selectOptionLC| (car opt) '(|reset|) '|optionError|) @@ -3442,7 +3443,6 @@ It consists of [exposed groups,exposed constructors,hidden constructors] \calls{setExposeAddGroup}{sayKeyedMsg} \calls{setExposeAddGroup}{member} \calls{setExposeAddGroup}{msort} -\calls{setExposeAddGroup}{centerAndHighlight} \calls{setExposeAddGroup}{specialChar} \calls{setExposeAddGroup}{namestring} \calls{setExposeAddGroup}{pathname} @@ -3458,8 +3458,7 @@ It consists of [exposed groups,exposed constructors,hidden constructors] |$interpreterFrameName| $linelength)) (if (null arg) (progn - (|centerAndHighlight| - '|The group Option| $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " The group Option ") (|displayExposedGroups|) (|sayMSG| " ") (|sayAsManyPerLineAsPossible| @@ -3533,7 +3532,6 @@ It consists of [exposed groups,exposed constructors,hidden constructors] \end{chunk} \Defun{setExposeAdd}{The top level set expose add command handler} -\calls{setExposeAdd}{centerAndHighlight} \calls{setExposeAdd}{specialChar} \calls{setExposeAdd}{displayExposedGroups} \calls{setExposeAdd}{sayMSG} @@ -3553,8 +3551,7 @@ It consists of [exposed groups,exposed constructors,hidden constructors] (let (fnargs fn) (cond ((null arg) - (|centerAndHighlight| - '|The add Option| $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " The add Option ") (|displayExposedGroups|) (|sayMSG| " ") (|displayExposedConstructors|) @@ -3591,7 +3588,6 @@ It consists of [exposed groups,exposed constructors,hidden constructors] \calls{setExposeAddConstr}{delete} \calls{setExposeAddConstr}{msort} \calls{setExposeAddConstr}{clearClams} -\calls{setExposeAddConstr}{centerAndHighlight} \calls{setExposeAddConstr}{specialChar} \calls{setExposeAddConstr}{displayExposedConstructors} \usesdollar{setExposeAddConstr}{linelength} @@ -3603,8 +3599,7 @@ It consists of [exposed groups,exposed constructors,hidden constructors] (declare (special $linelength |$localExposureData| |$interpreterFrameName|)) (if (null arg) (progn - (|centerAndHighlight| - '|The constructor Option| $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " The constructor Option ") (|displayExposedConstructors|)) (dolist (x arg) (setq x (|unabbrev| x)) @@ -3631,7 +3626,6 @@ It consists of [exposed groups,exposed constructors,hidden constructors] \end{chunk} \Defun{setExposeDrop}{The top level set expose drop handler} -\calls{setExposeDrop}{centerAndHighlight} \calls{setExposeDrop}{specialChar} \calls{setExposeDrop}{displayHiddenConstructors} \calls{setExposeDrop}{sayMSG} @@ -3650,8 +3644,7 @@ It consists of [exposed groups,exposed constructors,hidden constructors] (let (fnargs fn) (cond ((null arg) - (|centerAndHighlight| - '|The drop Option| $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " The drop Option ") (|displayHiddenConstructors|) (|sayMSG| " ") (|sayKeyedMsg| @@ -3685,7 +3678,6 @@ It consists of [exposed groups,exposed constructors,hidden constructors] \calls{setExposeDropGroup}{delete} \calls{setExposeDropGroup}{sayKeyedMsg} \calls{setExposeDropGroup}{getalist} -\calls{setExposeDropGroup}{centerAndHighlight} \calls{setExposeDropGroup}{specialChar} \usesdollar{setExposeDropGroup}{linelength} \usesdollar{setExposeDropGroup}{localExposureData} @@ -3698,8 +3690,7 @@ It consists of [exposed groups,exposed constructors,hidden constructors] |$globalExposureGroupAlist|)) (if (null arg) (progn - (|centerAndHighlight| - '|The group Option| $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " The group Option ") (|sayKeyedMsg| (format nil "When followed by one or more exposure group names, this ~ option allows you to remove those groups from the local ~ @@ -3744,7 +3735,6 @@ It consists of [exposed groups,exposed constructors,hidden constructors] \calls{setExposeDropConstr}{delete} \calls{setExposeDropConstr}{msort} \calls{setExposeDropConstr}{clearClams} -\calls{setExposeDropConstr}{centerAndHighlight} \calls{setExposeDropConstr}{specialChar} \calls{setExposeDropConstr}{sayMSG} \calls{setExposeDropConstr}{displayExposedConstructors} @@ -3758,8 +3748,7 @@ It consists of [exposed groups,exposed constructors,hidden constructors] (declare (special $linelength |$localExposureData| |$interpreterFrameName|)) (if (null arg) (progn - (|centerAndHighlight| - '|The constructor Option| $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " The constructor Option ") (|sayKeyedMsg| (format nil "When followed by one or more constructor names, this option ~ allows you to explicitly hide constructors in this frame.") @@ -3794,7 +3783,6 @@ It consists of [exposed groups,exposed constructors,hidden constructors] \Defun{displayExposedGroups}{Display exposed groups} \calls{displayExposedGroups}{sayKeyedMsg} -\calls{displayExposedGroups}{centerAndHighlight} \usesdollar{displayExposedGroups}{interpreterFrameName} \usesdollar{displayExposedGroups}{localExposureData} \begin{chunk}{defun displayExposedGroups} @@ -3806,15 +3794,14 @@ It consists of [exposed groups,exposed constructors,hidden constructors] frame (called %1 ):") (list |$interpreterFrameName|)) (if (null (elt |$localExposureData| 0)) - (|centerAndHighlight| "there are no exposed groups") + (format t "~v:@<~a~>~%" (- $linelength 2) " there are no exposed groups ") (dolist (c (elt |$localExposureData| 0)) - (|centerAndHighlight| c)))) + (format t "~v:@<~a~>~%" (- $linelength 2) c)))) \end{chunk} \Defun{displayExposedConstructors}{Display exposed constructors} \calls{displayExposedConstructors}{sayKeyedMsg} -\calls{displayExposedConstructors}{centerAndHighlight} \usesdollar{displayExposedConstructors}{localExposureData} \begin{chunk}{defun displayExposedConstructors} (defun |displayExposedConstructors| () @@ -3824,15 +3811,15 @@ It consists of [exposed groups,exposed constructors,hidden constructors] "The following constructors are explicitly exposed in the current frame:" nil) (if (null (elt |$localExposureData| 1)) - (|centerAndHighlight| "there are no explicitly exposed constructors") + (format t "~v:@<~a~>~%" (- $linelength 2) + "there are no explicitly exposed constructors") (dolist (c (elt |$localExposureData| 1)) - (|centerAndHighlight| c)))) + (format t "~v:@<~a~>~%" (- $linelength 2) c)))) \end{chunk} \Defun{displayHiddenConstructors}{Display hidden constructors} \calls{displayHiddenConstructors}{sayKeyedMsg} -\calls{displayHiddenConstructors}{centerAndHighlight} \usesdollar{displayHiddenConstructors}{localExposureData} \begin{chunk}{defun displayHiddenConstructors} (defun |displayHiddenConstructors| () @@ -3842,9 +3829,10 @@ It consists of [exposed groups,exposed constructors,hidden constructors] "The following constructors are explicitly hidden in the current frame:" nil) (if (null (elt |$localExposureData| 2)) - (|centerAndHighlight| "there are no explicitly hidden constructors") + (format t "~v:@<~a~>~%" (- $linelength 2) + "there are no explicitly hidden constructors") (dolist (c (elt |$localExposureData| 2)) - (|centerAndHighlight| c)))) + (format t "~v:@<~a~>~%" (- $linelength 2) c)))) \end{chunk} @@ -27842,7 +27830,6 @@ in practice. \end{chunk} \defun{printSynonyms}{printSynonyms} -\calls{printSynonyms}{centerAndHighlight} \calls{printSynonyms}{specialChar} \calls{printSynonyms}{filterListOfStringsWithFn} \calls{printSynonyms}{synonymsForUserLevel} @@ -27853,8 +27840,7 @@ in practice. (defun |printSynonyms| (patterns) (let (ls t1) (declare (special |$CommandSynonymAlist| $linelength)) - (|centerAndHighlight| '|System Command Synonyms| - $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " System Command Synonyms ") (setq ls (|filterListOfStringsWithFn| patterns (do ((t2 (|synonymsForUserLevel| |$CommandSynonymAlist|) (cdr t2))) @@ -27896,7 +27882,7 @@ The prefix goes before each element on each side of the list, eg, ")" (when (string= (substring syn 0 1) "|") (setq syn (substring syn 1 nil))) (when (string= syn "%i") (setq syn "%i ")) - (setq wid (max (- 30 (|entryWidth| syn)) 1)) + (setq wid (max (- 30 (|#| syn)) 1)) (|sayBrightly| (|concat| prefix syn (|fillerSpaces| wid ".") " " prefix comm))) @@ -33876,7 +33862,6 @@ explanations see the list structure section \ref{Theliststructure}. \defunsec{displaySetOptionInformation}{Display the set option information} \calls{displaySetOptionInformation}{displaySetVariableSettings} -\calls{displaySetOptionInformation}{centerAndHighlight} \calls{displaySetOptionInformation}{concat} \calls{displaySetOptionInformation}{object2String} \calls{displaySetOptionInformation}{specialChar} @@ -33898,9 +33883,8 @@ explanations see the list structure section \ref{Theliststructure}. ((eq (fourth setdata) 'tree) (|displaySetVariableSettings| (sixth setdata) (first setdata))) (t - (|centerAndHighlight| - (concat "The " (|object2String| arg) " Option") - $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) + (concat " The " (|object2String| arg) " Option ")) (|sayBrightly| `(|%l| ,@(|bright| "Description:") ,(second setdata))) (case (fourth setdata) @@ -33939,7 +33923,6 @@ explanations see the list structure section \ref{Theliststructure}. \defunsec{displaySetVariableSettings}{Display the set variable settings} \calls{displaySetVariableSettings}{concat} \calls{displaySetVariableSettings}{object2String} -\calls{displaySetVariableSettings}{centerAndHighlight} \calls{displaySetVariableSettings}{sayBrightly} \calls{displaySetVariableSettings}{say} \calls{displaySetVariableSettings}{fillerSpaces} @@ -33962,8 +33945,8 @@ explanations see the list structure section \ref{Theliststructure}. (if (eq label '||) (setq label ")set") (setq label (concat " " (|object2String| label) " "))) - (|centerAndHighlight| - (concat "Current Values of" label " Variables") $linelength '| |) + (format t "~v:@<~a~>~%" (- $linelength 2) + (concat " Current Values of" label " Variables ")) (terpri) (|sayBrightly| (list "Variable " "Description " @@ -36903,20 +36886,19 @@ The current setting is: On:CONSOLE (cond ((eq arg '|%display%|) current) ((or (null arg) (eq arg '|%describe%|) (eq (car arg) '?)) - (|sayMessage| - `(" The" ,@(|bright| "characters") - "option may be followed by any one of the following:")) + (format t + " The characters option may be followed by any one ~ + of the following:~%~%") (dolist (name '("default" "plain")) (if (string= (string current) name) (|sayBrightly| `(" ->" ,@(|bright| name))) (|sayBrightly| (list " " name)))) (terpri) - (|sayBrightly| - " The current setting is indicated within the list. This option determines ") - (|sayBrightly| - " the special characters used for algebraic output. This is what the") - (|sayBrightly| - " current choice of special characters looks like:") + (format t + " The current setting is indicated within the list. ~ + This option determines ~% the special characters used ~ + for algebraic output. This is what the~% current choice of ~ + special characters looks like:~%") (do ((t1 |$specialCharacterAlist| (CDR t1)) (t2 nil)) ((or (atom t1) (progn (setq t2 (car t1)) nil) @@ -39159,7 +39141,6 @@ o )what \calls{reportOpsFromLisplib}{namestring} \calls{reportOpsFromLisplib}{selectOptionLC} \calls{reportOpsFromLisplib}{dc1} -\calls{reportOpsFromLisplib}{centerAndHighlight} \calls{reportOpsFromLisplib}{specialChar} \calls{reportOpsFromLisplib}{remdup} \calls{reportOpsFromLisplib}{msort} @@ -39215,7 +39196,7 @@ o )what (cons "To get" (append (|bright| "views") (list "you must give parameters of constructor"))))) ((eq opt '|attributes|) - (|centerAndHighlight| "Attributes" $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " Attributes ") (|sayBrightly| "") (setq attList (remdup @@ -39256,7 +39237,6 @@ o )what \defun{displayOperationsFromLisplib}{displayOperationsFromLisplib} \calls{displayOperationsFromLisplib}{getdatabase} -\calls{displayOperationsFromLisplib}{centerAndHighlight} \calls{displayOperationsFromLisplib}{specialChar} \calls{displayOperationsFromLisplib}{reportOpsFromUnitDirectly} \calls{displayOperationsFromLisplib}{remdup} @@ -39273,7 +39253,7 @@ o )what (setq name (car form)) (setq argl (cdr form)) (setq kind (getdatabase name 'constructorkind)) - (|centerAndHighlight| "Operations" $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " Operations ") (setq opList (getdatabase name 'operationalist)) (if (null opList) (|reportOpsFromUnitDirectly| form) @@ -39314,12 +39294,10 @@ o )what \calls{reportOpsFromUnitDirectly}{strconc} \calls{reportOpsFromUnitDirectly}{namestring} \calls{reportOpsFromUnitDirectly}{selectOptionLC} -\calls{reportOpsFromUnitDirectly}{centerAndHighlight} \calls{reportOpsFromUnitDirectly}{specialChar} \calls{reportOpsFromUnitDirectly}{remdup} \calls{reportOpsFromUnitDirectly}{msort} \calls{reportOpsFromUnitDirectly}{formatAttribute} -\calls{reportOpsFromUnitDirectly}{centerAndHighlight} \calls{reportOpsFromUnitDirectly}{getl} \calls{reportOpsFromUnitDirectly}{systemErrorHere} \calls{reportOpsFromUnitDirectly}{nreverse0} @@ -39368,7 +39346,7 @@ o )what (setq opt (|selectOptionLC| (car item) |$showOptions| '|optionError|)) (cond ((eq opt '|attributes|) - (|centerAndHighlight| "Attributes" $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " Attributes ") (if isRecordOrUnion (|sayBrightly| " Records and Unions have no attributes.") (progn @@ -39383,7 +39361,7 @@ o )what ((eq opt '|operations|) (setq |$commentedOps| 0) ; --new form is ( ) - (|centerAndHighlight| "Operations" $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) " Operations ") (|sayBrightly| "") (cond (isRecordOrUnion @@ -41873,7 +41851,6 @@ o )show \end{chunk} \defun{whatCommands}{The )what commands implementation} -\calls{whatCommands}{centerAndHighlight} \calls{whatCommands}{strconc} \calls{whatCommands}{specialChar} \calls{whatCommands}{filterListOfStrings} @@ -41893,7 +41870,7 @@ o )show (setq label (strconc '|System Commands for User Level: | (princ-to-string |$UserLevel|))) - (|centerAndHighlight| label $linelength (|specialChar| '|hbar|)) + (format t "~v,,,'-:@< ~a ~>~%" (- $linelength 2) label) (setq ell (|filterListOfStrings| patterns (mapcar #'princ-to-string (|commandsForUserLevel| |$systemCommands|)))) @@ -41968,7 +41945,6 @@ in patterns. \calls{filterAndFormatConstructors}{sayMessage} \calls{filterAndFormatConstructors}{blankList} \calls{filterAndFormatConstructors}{pp2Cols} -\calls{filterAndFormatConstructors}{centerAndHighlight} \calls{filterAndFormatConstructors}{specialChar} \calls{filterAndFormatConstructors}{filterListOfStringsWithFn} \calls{filterAndFormatConstructors}{whatConstructors} @@ -41979,7 +41955,8 @@ in patterns. (prog (l) (declare (special $linelength)) (return - (progn (|centerAndHighlight| label $linelength (|specialChar| '|hbar|)) + (progn + (format t "~v,,,'-:@< ~a ~>~%" (- $linelength 2) label) (setq l (|filterListOfStringsWithFn| patterns (|whatConstructors| constrType) @@ -42107,7 +42084,6 @@ This displays all operation names containing these fragments. \calls{workfilesSpad2Cmd}{namestring} \calls{workfilesSpad2Cmd}{updateSourceFiles} \calls{workfilesSpad2Cmd}{say} -\calls{workfilesSpad2Cmd}{centerAndHighlight} \calls{workfilesSpad2Cmd}{specialChar} \calls{workfilesSpad2Cmd}{sortby} \calls{workfilesSpad2Cmd}{sayBrightly} @@ -42168,10 +42144,8 @@ This displays all operation names containing these fragments. (list (|namestring| fl)))) (t (|updateSourceFiles| fl)))))) (say " ") - (|centerAndHighlight| - '| User-specified work files | - $linelength - (|specialChar| '|hbar|)) + (format t "~v,,,'-:@<~a~>~%" (- $linelength 2) + " User-specified work files ") (say " ") (if (null |$sourceFiles|) (say " no files specified") diff --git a/changelog b/changelog index 08cae5b..0172219 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,12 @@ +20150422 tpd src/axiom-website/patches.html 20150422.01.tpd.patch +20150422 tpd books/bookvol10.4 simplify msgdb code +20150422 tpd books/bookvol5 simplify msgdb code +20150422 tpd src/input/setcmd.input simplify msgdb code +20150422 tpd src/interp/br-con.lisp simplify msgdb code +20150422 tpd src/interp/clam.lisp simplify msgdb code +20150422 tpd src/interp/g-util.lisp simplify msgdb code +20150422 tpd src/interp/util.lisp simplify msgdb code +20150422 tpd src/interp/msgdb.lisp remove dead code, simplify 20150419 tpd src/axiom-website/patches.html 20150419.01.tpd.patch 20150419 tpd books/bookvol10.4 remove %b and %d processing 20150419 tpd books/bookvol5 remove %b and %d processing diff --git a/patch b/patch index 8208a8b..e051fdd 100644 --- a/patch +++ b/patch @@ -1,8 +1,10 @@ -books/bookvol5 remove %b and %d highlights +src/interp/msgdb.lisp remove dead code, simplify -The %b and %d were used to provide bold text on AIX terminals. -This feature is never used and causes a lot of output overhead. -It has been removed everywhere. +Certain functions were never used or used a few times. +These were removed and code elsewhere rewritten. + +In particular, centering code can be done directly by +common lisp format strings so a lot of this was removed. diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d6fb530..7b0a0b1 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -5018,6 +5018,8 @@ books/bookvol5 KeyedMsg functions no longer use s2-us.msgs
buglist add bug 7300 outputDomainConstructor failure
20150419.01.tpd.patch books/bookvol5 remove %b and %d processing
+20150422.01.tpd.patch +src/interp/msgdb.lisp remove dead code, simplify
diff --git a/src/input/setcmd.input.pamphlet b/src/input/setcmd.input.pamphlet index 3fc0e8e..21cc9d6 100644 --- a/src/input/setcmd.input.pamphlet +++ b/src/input/setcmd.input.pamphlet @@ -1011,11 +1011,11 @@ --S 68 of 143 )set output characters +--R --R-------------------------- The characters Option -------------------------- --R --R Description: choose special output character set --R ---R --R The characters option may be followed by any one of the following: --R --R default @@ -1373,11 +1373,11 @@ --S 87 of 143 )set output char +--R --R-------------------------- The characters Option -------------------------- --R --R Description: choose special output character set --R ---R --R The characters option may be followed by any one of the following: --R --R default @@ -1403,11 +1403,11 @@ --S 89 of 143 )set output char ---R컴컴컴컴컴컴컴컴컴컴컴컴컴 The characters Option 컴컴컴컴컴컴컴컴컴컴컴컴컴 +--R +--R-------------------------- The characters Option -------------------------- --R --R Description: choose special output character set --R ---R --R The characters option may be followed by any one of the following: --R --R -> default @@ -1433,11 +1433,11 @@ --S 91 of 143 )set output char +--R --R-------------------------- The characters Option -------------------------- --R --R Description: choose special output character set --R ---R --R The characters option may be followed by any one of the following: --R --R default diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index 1f88e09..c8f8ae5 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -13137,6 +13137,71 @@ $dbKindAlist := (SETELT |res| 0 (UPCASE (ELT |res| 0))) |res|))))) +;$htCharAlist := '( +; ("$" . "\%") +; ("[]" . "\[\]") +; ("{}" . "\{\}") +; ("\\" . "\\\\") +; ("\/" . "\\/" ) +; ("/\" . "/\\" ) ) + +(defvar |$htCharAlist| + '(("$" . "\\%") ("[]" . "\\[\\]") ("{}" . "\\{\\}") + ("\\\\" . "\\\\\\\\") ("\\/" . "\\\\/") ("/\\" . "/\\\\"))) + +;escapeSpecialChars s == +; u := LASSOC(s,$htCharAlist) => u +; member(s, $htSpecialChars) => STRCONC('"_\", s) +; ALPHA_-CHAR_-P (s.0) => s +; not (or/[dbSpecialDisplayOpChar? s.i for i in 0..MAXINDEX s]) => s +; buf := '"" +; for i in 0..MAXINDEX s repeat buf := +; dbSpecialDisplayOpChar?(s.i) => STRCONC(buf,'"\verb!",s.i,'"!") +; STRCONC(buf,s.i) +; buf + +(defun |escapeSpecialChars| (|s|) + (PROG (|u| |buf|) + (declare (special |$htSpecialChars| |$htCharAlist|)) + (RETURN + (SEQ (COND + ((setq |u| (LASSOC |s| |$htCharAlist|)) |u|) + ((|member| |s| |$htSpecialChars|) + (STRCONC "\\" |s|)) + ((ALPHA-CHAR-P (ELT |s| 0)) |s|) + ((NULL (PROG (G167323) + (setq G167323 nil) + (RETURN + (DO ((G167329 nil G167323) + (G167330 (MAXINDEX |s|)) + (|i| 0 (QSADD1 |i|))) + ((OR G167329 (QSGREATERP |i| G167330)) + G167323) + (SEQ (EXIT (SETQ G167323 + (OR G167323 + (|dbSpecialDisplayOpChar?| + (ELT |s| |i|)))))))))) + |s|) + ('T (setq |buf| "") + (DO ((G167338 (MAXINDEX |s|)) (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G167338) nil) + (SEQ (EXIT (setq |buf| + (COND + ((|dbSpecialDisplayOpChar?| + (ELT |s| |i|)) + (STRCONC |buf| + "\\verb!" + (ELT |s| |i|) "!")) + ('T + (STRCONC |buf| (ELT |s| |i|)))))))) + |buf|)))))) + +(defvar |$htSpecialChars| + (list "#" "[" "]" "%" "{" "}" "\\" "$" "&" "^" "_" "~")) + +(defun |dbSpecialDisplayOpChar?| (c) + (char= c #\~)) + ;escapeSpecialIds u == --very expensive function ; x := LASSOC(u,$htCharAlist) => [x] ; #u = 1 => diff --git a/src/interp/clam.lisp.pamphlet b/src/interp/clam.lisp.pamphlet index 37ba010..575f36a 100644 --- a/src/interp/clam.lisp.pamphlet +++ b/src/interp/clam.lisp.pamphlet @@ -2320,7 +2320,7 @@ (PROG (SIZE) (RETURN (PROGN - (SPADLET SIZE (|entryWidth| |x|)) + (SPADLET SIZE (|#| (|atom2String| |x|))) (COND ((> SIZE |maxWidth|) (|keyedSystemError| "%1 is too large" (CONS |x| NIL))) diff --git a/src/interp/g-util.lisp.pamphlet b/src/interp/g-util.lisp.pamphlet index a15cc97..edbf0bc 100644 --- a/src/interp/g-util.lisp.pamphlet +++ b/src/interp/g-util.lisp.pamphlet @@ -264,7 +264,7 @@ (PROG (|wid| |f| |fill2| |fill1|) (RETURN (SEQ (PROGN - (SPADLET |wid| (|entryWidth| |text|)) + (SPADLET |wid| (|#| (|atom2String| |text|))) (COND ((>= |wid| |width|) |text|) ('T diff --git a/src/interp/msgdb.lisp.pamphlet b/src/interp/msgdb.lisp.pamphlet index 6b0e567..cb876b8 100644 --- a/src/interp/msgdb.lisp.pamphlet +++ b/src/interp/msgdb.lisp.pamphlet @@ -18,29 +18,29 @@ ; i := 0 ; [w while wordFrom(l,i) is [w,i]] -(DEFUN |string2Words| (|l|) +(defun |string2Words| (|l|) (PROG (|ISTMP#1| |w| |ISTMP#2| |i|) (RETURN (SEQ (PROGN - (SPADLET |i| 0) + (setq |i| 0) (PROG (G166078) - (SPADLET G166078 NIL) + (setq G166078 nil) (RETURN (DO () ((NULL (PROGN - (SPADLET |ISTMP#1| (|wordFrom| |l| |i|)) - (AND (CONSP |ISTMP#1|) + (setq |ISTMP#1| (|wordFrom| |l| |i|)) + (AND (consp |ISTMP#1|) (PROGN - (SPADLET |w| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| + (setq |w| (QCAR |ISTMP#1|)) + (setq |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) + (AND (consp |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) nil) (PROGN - (SPADLET |i| (QCAR |ISTMP#2|)) + (setq |i| (QCAR |ISTMP#2|)) 'T)))))) (NREVERSE0 G166078)) - (SEQ (EXIT (SETQ G166078 (CONS |w| G166078)))))))))))) + (SEQ (EXIT (SETQ G166078 (cons |w| G166078)))))))))))) ;wordFrom(l,i) == ; maxIndex := MAXINDEX l @@ -55,16 +55,16 @@ ; if k = maxIndex and (c := l.k) ^= char ('_ ) then buf := STRCONC(buf,c) ; [buf,k+1] -(DEFUN |wordFrom| (|l| |i|) +(defun |wordFrom| (|l| |i|) (PROG (|maxIndex| |ch| |k| |c| |buf|) (RETURN (SEQ (PROGN - (SPADLET |maxIndex| (MAXINDEX |l|)) - (SPADLET |k| + (setq |maxIndex| (MAXINDEX |l|)) + (setq |k| (OR (PROG (G166098) - (SPADLET G166098 NIL) + (setq G166098 nil) (RETURN - (DO ((G166105 NIL G166098) + (DO ((G166105 nil G166098) (|j| |i| (+ |j| 1))) ((OR G166105 (> |j| |maxIndex|)) G166098) @@ -74,42 +74,42 @@ (|char| '| |)) (SETQ G166098 (OR G166098 |j|))))))))) - (RETURN NIL))) - (SPADLET |buf| "") + (RETURN nil))) + (setq |buf| "") (DO () ((NULL (AND (> |maxIndex| |k|) - (NEQUAL (SPADLET |c| (ELT |l| |k|)) + (NEQUAL (setq |c| (ELT |l| |k|)) (|char| '| |)))) - NIL) + nil) (SEQ (EXIT (PROGN - (SPADLET |ch| + (setq |ch| (COND ((BOOT-EQUAL |c| (|char| '_)) (ELT |l| - (SPADLET |k| (PLUS 1 |k|)))) + (setq |k| (PLUS 1 |k|)))) ('T |c|))) - (SPADLET |buf| (STRCONC |buf| |ch|)) - (SPADLET |k| (PLUS |k| 1)))))) + (setq |buf| (STRCONC |buf| |ch|)) + (setq |k| (PLUS |k| 1)))))) (COND ((AND (BOOT-EQUAL |k| |maxIndex|) - (NEQUAL (SPADLET |c| (ELT |l| |k|)) (|char| '| |))) - (SPADLET |buf| (STRCONC |buf| |c|)))) - (CONS |buf| (CONS (PLUS |k| 1) NIL))))))) + (NEQUAL (setq |c| (ELT |l| |k|)) (|char| '| |))) + (setq |buf| (STRCONC |buf| |c|)))) + (cons |buf| (cons (PLUS |k| 1) nil))))))) ;segmentedMsgPreprocess x == ; ATOM x => x ; [head,:tail] := x -; center := rightJust := NIL +; center := rightJust := nil ; if head in '(%ceon "%ceon") then center := true ; if head in '(%rjon "%rjon") then rightJust := true ; center or rightJust => ; -- start collecting terms -; y := NIL +; y := nil ; ok := true ; while tail and ok repeat ; [t,:tail] := tail -; t in '(%ceoff "%ceoff" %rjoff "%rjoff") => ok := NIL -; y := CONS(segmentedMsgPreprocess t,y) +; t in '(%ceoff "%ceoff" %rjoff "%rjoff") => ok := nil +; y := cons(segmentedMsgPreprocess t,y) ; head1 := [(center => '"%ce"; '"%rj"),:NREVERSE y] ; NULL tail => [head1] ; [head1,:segmentedMsgPreprocess tail] @@ -118,58 +118,58 @@ ; EQ(head,head1) and EQ(tail,tail1) => x ; [head1,:tail1] -(DEFUN |segmentedMsgPreprocess| (|x|) +(defun |segmentedMsgPreprocess| (|x|) (PROG (|head| |center| |rightJust| |LETTMP#1| |t| |tail| |ok| |y| |head1| |tail1|) (RETURN (SEQ (COND ((ATOM |x|) |x|) - ('T (SPADLET |head| (CAR |x|)) (SPADLET |tail| (CDR |x|)) - (SPADLET |center| (SPADLET |rightJust| NIL)) + ('T (setq |head| (CAR |x|)) (setq |tail| (CDR |x|)) + (setq |center| (setq |rightJust| nil)) (COND ((|member| |head| '(|%ceon| "%ceon")) - (SPADLET |center| 'T))) + (setq |center| 'T))) (COND ((|member| |head| '(|%rjon| "%rjon")) - (SPADLET |rightJust| 'T))) + (setq |rightJust| 'T))) (COND - ((OR |center| |rightJust|) (SPADLET |y| NIL) - (SPADLET |ok| 'T) - (DO () ((NULL (AND |tail| |ok|)) NIL) + ((OR |center| |rightJust|) (setq |y| nil) + (setq |ok| 'T) + (DO () ((NULL (AND |tail| |ok|)) nil) (SEQ (EXIT (PROGN - (SPADLET |LETTMP#1| |tail|) - (SPADLET |t| (CAR |LETTMP#1|)) - (SPADLET |tail| (CDR |LETTMP#1|)) + (setq |LETTMP#1| |tail|) + (setq |t| (CAR |LETTMP#1|)) + (setq |tail| (CDR |LETTMP#1|)) (COND ((|member| |t| '(|%ceoff| "%ceoff" |%rjoff| "%rjoff")) - (SPADLET |ok| NIL)) + (setq |ok| nil)) ('T - (SPADLET |y| - (CONS + (setq |y| + (cons (|segmentedMsgPreprocess| |t|) |y|)))))))) - (SPADLET |head1| - (CONS (COND + (setq |head1| + (cons (COND (|center| "%ce") ('T "%rj")) (NREVERSE |y|))) (COND - ((NULL |tail|) (CONS |head1| NIL)) + ((NULL |tail|) (cons |head1| nil)) ('T - (CONS |head1| (|segmentedMsgPreprocess| |tail|))))) - ('T (SPADLET |head1| (|segmentedMsgPreprocess| |head|)) - (SPADLET |tail1| (|segmentedMsgPreprocess| |tail|)) + (cons |head1| (|segmentedMsgPreprocess| |tail|))))) + ('T (setq |head1| (|segmentedMsgPreprocess| |head|)) + (setq |tail1| (|segmentedMsgPreprocess| |tail|)) (COND ((AND (EQ |head| |head1|) (EQ |tail| |tail1|)) |x|) - ('T (CONS |head1| |tail1|))))))))))) + ('T (cons |head1| |tail1|))))))))))) ;removeAttributes msg == ; --takes a segmented message and returns it with the attributes ; --separted. ; first msg ^= '"%atbeg" => -; [msg,NIL] +; [msg,nil] ; attList := [] ; until item = '"%atend" repeat ; msg := rest msg @@ -179,38 +179,38 @@ ; attList := rest attList ; [msg,attList] -(DEFUN |removeAttributes| (|msg|) +(defun |removeAttributes| (|msg|) (PROG (|item| |attList|) (RETURN (SEQ (COND ((NEQUAL (CAR |msg|) "%atbeg") - (CONS |msg| (CONS NIL NIL))) - ('T (SPADLET |attList| NIL) - (DO ((G166190 NIL + (cons |msg| (cons nil nil))) + ('T (setq |attList| nil) + (DO ((G166190 nil (BOOT-EQUAL |item| "%atend"))) - (G166190 NIL) + (G166190 nil) (SEQ (EXIT (PROGN - (SPADLET |msg| (CDR |msg|)) - (SPADLET |item| (CAR |msg|)) - (SPADLET |attList| - (CONS (INTERN |item|) |attList|)))))) - (SPADLET |msg| (CDR |msg|)) - (SPADLET |attList| (CDR |attList|)) - (CONS |msg| (CONS |attList| NIL)))))))) + (setq |msg| (CDR |msg|)) + (setq |item| (CAR |msg|)) + (setq |attList| + (cons (INTERN |item|) |attList|)))))) + (setq |msg| (CDR |msg|)) + (setq |attList| (CDR |attList|)) + (cons |msg| (cons |attList| nil)))))))) ;substituteSegmentedMsg(msg,args) == ; -- this does substitution of the parameters -; l := NIL +; l := nil ; nargs := #args ; for x in segmentedMsgPreprocess msg repeat ; -- x is a list -; CONSP x => +; consp x => ; l := cons(substituteSegmentedMsg(x,args),l) ; c := x.0 ; n := STRINGLENGTH x ; -- x is a special case ; (n > 2) and (c = "%") and (x.1 = "k") => -; l := NCONC(NREVERSE pkey SUBSTRING(x,2,NIL),l) +; l := NCONC(NREVERSE pkey SUBSTRING(x,2,nil),l) ; -- ?name gets replaced by '"Push PF10" or '"Type >b (enter)" ; (x.0 = char "?") and n > 1 and (v := pushOrTypeFuture(INTERN x,nil)) => ; l := NCONC(NREVERSE v,l) @@ -221,12 +221,12 @@ ; a <= nargs => args.(a-1) ; '"???" ; -- now pull out qualifiers -; q := NIL +; q := nil ; for i in 2..(n-1) repeat q := cons(x.i,q) ; -- Note 'f processing must come first. ; if MEMQ(char 'f,q) then ; arg := -; CONSP arg => APPLY(first arg, rest arg) +; consp arg => APPLY(first arg, rest arg) ; arg ; if MEMQ(char 'm,q) then arg := [['"%m",:arg]] ; if MEMQ(char 's,q) then arg := [['"%s",:arg]] @@ -246,7 +246,7 @@ ; --stifled after the first item in the list until the ; --end of the list. (using %n and %y) ; l := -; CONSP(arg) => +; consp(arg) => ; MEMQ(char 'y,q) or (CAR arg = '"%y") or ((LENGTH arg) = 1) => ; APPEND(REVERSE arg, l) ; head := first arg @@ -260,160 +260,160 @@ ; l := cons(x,l) ; addBlanks NREVERSE l -(DEFUN |substituteSegmentedMsg| (|msg| |args|) +(defun |substituteSegmentedMsg| (|msg| |args|) (PROG (|nargs| |c| |n| |v| |a| |q| |arg| |head| |tail| |l|) (declare (special |$texFormatting|)) (RETURN (SEQ (PROGN - (SPADLET |l| NIL) - (SPADLET |nargs| (|#| |args|)) + (setq |l| nil) + (setq |nargs| (|#| |args|)) (DO ((G166215 (|segmentedMsgPreprocess| |msg|) (CDR G166215)) - (|x| NIL)) + (|x| nil)) ((OR (ATOM G166215) - (PROGN (SETQ |x| (CAR G166215)) NIL)) - NIL) + (PROGN (SETQ |x| (CAR G166215)) nil)) + nil) (SEQ (EXIT (COND - ((CONSP |x|) - (SPADLET |l| - (CONS + ((consp |x|) + (setq |l| + (cons (|substituteSegmentedMsg| |x| |args|) |l|))) - ('T (SPADLET |c| (ELT |x| 0)) - (SPADLET |n| (STRINGLENGTH |x|)) + ('T (setq |c| (ELT |x| 0)) + (setq |n| (STRINGLENGTH |x|)) (COND ((AND (> |n| 2) (BOOT-EQUAL |c| '%) (BOOT-EQUAL (ELT |x| 1) '|k|)) - (SPADLET |l| + (setq |l| (NCONC (NREVERSE (|pkey| - (SUBSTRING |x| 2 NIL))) + (SUBSTRING |x| 2 nil))) |l|))) ((AND (BOOT-EQUAL (ELT |x| 0) (|char| '?)) (> |n| 1) - (SPADLET |v| + (setq |v| (|pushOrTypeFuture| (INTERN |x|) - NIL))) - (SPADLET |l| + nil))) + (setq |l| (NCONC (NREVERSE |v|) |l|))) ((AND (BOOT-EQUAL (ELT |x| 0) (|char| '%)) (> |n| 1) (DIGITP (ELT |x| 1))) - (SPADLET |a| (DIG2FIX (ELT |x| 1))) - (SPADLET |arg| + (setq |a| (DIG2FIX (ELT |x| 1))) + (setq |arg| (COND ((<= |a| |nargs|) (ELT |args| (SPADDIFFERENCE |a| 1))) ('T "???"))) - (SPADLET |q| NIL) + (setq |q| nil) (DO ((G166224 (SPADDIFFERENCE |n| 1)) (|i| 2 (QSADD1 |i|))) - ((QSGREATERP |i| G166224) NIL) + ((QSGREATERP |i| G166224) nil) (SEQ (EXIT - (SPADLET |q| - (CONS (ELT |x| |i|) |q|))))) + (setq |q| + (cons (ELT |x| |i|) |q|))))) (COND ((member (|char| '|f|) |q|) - (SPADLET |arg| + (setq |arg| (COND - ((CONSP |arg|) + ((consp |arg|) (APPLY (CAR |arg|) (CDR |arg|))) ('T |arg|))))) (COND ((member (|char| '|m|) |q|) - (SPADLET |arg| - (CONS - (CONS "%m" |arg|) - NIL)))) + (setq |arg| + (cons + (cons "%m" |arg|) + nil)))) (COND ((member (|char| '|s|) |q|) - (SPADLET |arg| - (CONS - (CONS "%s" |arg|) - NIL)))) + (setq |arg| + (cons + (cons "%s" |arg|) + nil)))) (COND ((member (|char| '|p|) |q|) (COND (|$texFormatting| - (SPADLET |arg| + (setq |arg| (|prefix2StringAsTeX| |arg|))) ('T - (SPADLET |arg| + (setq |arg| (|prefix2String| |arg|)))))) (COND ((member (|char| 'P) |q|) (COND (|$texFormatting| - (SPADLET |arg| + (setq |arg| (PROG (G166232) - (SPADLET G166232 NIL) + (setq G166232 nil) (RETURN (DO ((G166237 |arg| (CDR G166237)) - (|x| NIL)) + (|x| nil)) ((OR (ATOM G166237) (PROGN (SETQ |x| (CAR G166237)) - NIL)) + nil)) (NREVERSE0 G166232)) (SEQ (EXIT (SETQ G166232 - (CONS + (cons (|prefix2StringAsTeX| |x|) G166232))))))))) ('T - (SPADLET |arg| + (setq |arg| (PROG (G166247) - (SPADLET G166247 NIL) + (setq G166247 nil) (RETURN (DO ((G166252 |arg| (CDR G166252)) - (|x| NIL)) + (|x| nil)) ((OR (ATOM G166252) (PROGN (SETQ |x| (CAR G166252)) - NIL)) + nil)) (NREVERSE0 G166247)) (SEQ (EXIT (SETQ G166247 - (CONS + (cons (|prefix2String| |x|) G166247)))))))))))) (COND ((AND (member (|char| '|o|) |q|) |$texFormatting|) - (SPADLET |arg| + (setq |arg| (|operationLink| |arg|)))) (COND ((member (|char| '|c|) |q|) - (SPADLET |arg| - (CONS - (CONS "%ce" |arg|) - NIL)))) + (setq |arg| + (cons + (cons "%ce" |arg|) + nil)))) (COND ((member (|char| '|r|) |q|) - (SPADLET |arg| - (CONS - (CONS "%rj" |arg|) - NIL)))) + (setq |arg| + (cons + (cons "%rj" |arg|) + nil)))) (COND ((member (|char| '|l|) |q|) - (SPADLET |l| - (CONS "%l" |l|)))) - (SPADLET |l| + (setq |l| + (cons "%l" |l|)))) + (setq |l| (COND - ((CONSP |arg|) + ((consp |arg|) (COND ((OR (member (|char| '|y|) @@ -424,37 +424,37 @@ (APPEND (REVERSE |arg|) |l|)) ('T - (SPADLET |head| + (setq |head| (CAR |arg|)) - (SPADLET |tail| + (setq |tail| (CDR |arg|)) - (CONS "%y" + (cons "%y" (APPEND (REVERSE |tail|) - (CONS + (cons "%n" - (CONS |head| |l|))))))) - ('T (CONS |arg| |l|)))) + (cons |head| |l|))))))) + ('T (cons |arg| |l|)))) (DO ((G166261 '(|.| |,| ! |:| |;| ?) (CDR G166261)) - (|ch| NIL)) + (|ch| nil)) ((OR (ATOM G166261) (PROGN (SETQ |ch| (CAR G166261)) - NIL)) - NIL) + nil)) + nil) (SEQ (EXIT (COND ((member (|char| |ch|) |q|) - (SPADLET |l| - (CONS |ch| |l|))) - ('T NIL)))))) - ('T (SPADLET |l| (CONS |x| |l|))))))))) + (setq |l| + (cons |ch| |l|))) + ('T nil)))))) + ('T (setq |l| (cons |x| |l|))))))))) (|addBlanks| (NREVERSE |l|))))))) ;addBlanks msg == ; -- adds proper blanks -; null CONSP msg => msg +; null consp msg => msg ; null msg => msg ; LENGTH msg = 1 => msg ; blanksOff := false @@ -475,44 +475,42 @@ ; x := y ; NREVERSE msg1 -(DEFUN |addBlanks| (|msg|) +(defun |addBlanks| (|msg|) (PROG (|blank| |blanksOff| |msg1| |x|) (RETURN (SEQ (COND - ((NULL (CONSP |msg|)) |msg|) + ((NULL (consp |msg|)) |msg|) ((NULL |msg|) |msg|) ((EQL (LENGTH |msg|) 1) |msg|) - ('T (SPADLET |blanksOff| NIL) (SPADLET |x| (CAR |msg|)) + ('T (setq |blanksOff| nil) (setq |x| (CAR |msg|)) (COND ((BOOT-EQUAL |x| "%n") - (SPADLET |blanksOff| 'T) (SPADLET |msg1| NIL)) - ('T (SPADLET |msg1| (LIST |x|)))) - (SPADLET |blank| " ") - (DO ((G166308 (CDR |msg|) (CDR G166308)) (|y| NIL)) + (setq |blanksOff| 'T) (setq |msg1| nil)) + ('T (setq |msg1| (LIST |x|)))) + (setq |blank| " ") + (DO ((G166308 (CDR |msg|) (CDR G166308)) (|y| nil)) ((OR (ATOM G166308) - (PROGN (SETQ |y| (CAR G166308)) NIL)) - NIL) + (PROGN (SETQ |y| (CAR G166308)) nil)) + nil) (SEQ (EXIT (COND ((|member| |y| '("%n" |%n|)) - (SPADLET |blanksOff| 'T)) + (setq |blanksOff| 'T)) ((|member| |y| '("%y" |%y|)) - (SPADLET |blanksOff| NIL)) + (setq |blanksOff| nil)) ('T (COND ((OR (|noBlankAfterP| |x|) (|noBlankBeforeP| |y|) |blanksOff|) - (SPADLET |msg1| (CONS |y| |msg1|))) + (setq |msg1| (cons |y| |msg1|))) ('T - (SPADLET |msg1| - (CONS |y| - (CONS |blank| |msg1|))))) - (SPADLET |x| |y|)))))) + (setq |msg1| + (cons |y| + (cons |blank| |msg1|))))) + (setq |x| |y|)))))) (NREVERSE |msg1|))))))) -;SETANDFILEQ($msgdbListPrims,'(%m %s %ce %rj "%m" "%s" "%ce" "%rj")) - -(SETANDFILEQ |$msgdbListPrims| +(defvar |$msgdbListPrims| '(|%m| |%s| |%ce| |%rj| "%m" "%s" "%ce" "%rj")) ;noBlankBeforeP word== @@ -521,15 +519,15 @@ ; if CVECP word and SIZE word > 1 then ; word.0 = char '% and word.1 = char 'x => return true ; word.0 = char " " => return true -; (CONSP word) and (CAR word in $msgdbListPrims) => true +; (consp word) and (CAR word in $msgdbListPrims) => true ; false -(DEFUN |noBlankBeforeP| (|word|) +(defun |noBlankBeforeP| (|word|) (PROG () (declare (special |$msgdbListPrims| |$msgdbNoBlanksBeforeGroup|)) (RETURN (COND - ((integerp |word|) NIL) + ((integerp |word|) nil) ((|member| |word| |$msgdbNoBlanksBeforeGroup|) 'T) ('T (COND @@ -540,10 +538,10 @@ (RETURN 'T)) ((BOOT-EQUAL (ELT |word| 0) (|char| '| |)) (RETURN 'T))))) (COND - ((AND (CONSP |word|) + ((AND (consp |word|) (|member| (CAR |word|) |$msgdbListPrims|)) 'T) - ('T NIL))))))) + ('T nil))))))) ;noBlankAfterP word== ; INTP word => false @@ -551,19 +549,19 @@ ; if CVECP word and (s := SIZE word) > 1 then ; word.0 = char '% and word.1 = char 'x => return true ; word.(s-1) = char " " => return true -; (CONSP word) and (CAR word in $msgdbListPrims) => true +; (consp word) and (CAR word in $msgdbListPrims) => true ; false -(DEFUN |noBlankAfterP| (|word|) +(defun |noBlankAfterP| (|word|) (PROG (|s|) (declare (special |$msgdbListPrims| |$msgdbNoBlanksAfterGroup|)) (RETURN (COND - ((integerp |word|) NIL) + ((integerp |word|) nil) ((|member| |word| |$msgdbNoBlanksAfterGroup|) 'T) ('T (COND - ((AND (stringp |word|) (> (SPADLET |s| (SIZE |word|)) 1)) + ((AND (stringp |word|) (> (setq |s| (SIZE |word|)) 1)) (COND ((AND (BOOT-EQUAL (ELT |word| 0) (|char| '%)) (BOOT-EQUAL (ELT |word| 1) (|char| '|x|))) @@ -572,56 +570,56 @@ (|char| '| |)) (RETURN 'T))))) (COND - ((AND (CONSP |word|) + ((AND (consp |word|) (|member| (CAR |word|) |$msgdbListPrims|)) 'T) - ('T NIL))))))) + ('T nil))))))) ;cleanUpSegmentedMsg msg == ; -- removes any junk like double blanks ; -- takes a reversed msg and puts it in the correct order -; null CONSP msg => msg +; null consp msg => msg ; blanks := ['" "," "] -; haveBlank := NIL +; haveBlank := nil ; prims := ; '(%b %d %l %i %u %m %ce %rj _ ; "%b" "%d" "%l" "%i" "%m" "%u" "%ce" "%rj") -; msg1 := NIL +; msg1 := nil ; for x in msg repeat ; if haveBlank and ((x in blanks) or (x in prims)) then ; msg1 := CDR msg1 ; msg1 := cons(x,msg1) -; haveBlank := (x in blanks => true; NIL) +; haveBlank := (x in blanks => true; nil) ; msg1 -(DEFUN |cleanUpSegmentedMsg| (|msg|) +(defun |cleanUpSegmentedMsg| (|msg|) (PROG (|blanks| |prims| |msg1| |haveBlank|) (RETURN (SEQ (COND - ((NULL (CONSP |msg|)) |msg|) + ((NULL (consp |msg|)) |msg|) ('T - (SPADLET |blanks| - (CONS " " (CONS '| | NIL))) - (SPADLET |haveBlank| NIL) - (SPADLET |prims| + (setq |blanks| + (cons " " (cons '| | nil))) + (setq |haveBlank| nil) + (setq |prims| '(|%l| |%i| |%u| |%m| |%ce| |%rj| "%l" "%i" "%m" "%u" "%ce" "%rj")) - (SPADLET |msg1| NIL) - (DO ((G166348 |msg| (CDR G166348)) (|x| NIL)) + (setq |msg1| nil) + (DO ((G166348 |msg| (CDR G166348)) (|x| nil)) ((OR (ATOM G166348) - (PROGN (SETQ |x| (CAR G166348)) NIL)) - NIL) + (PROGN (SETQ |x| (CAR G166348)) nil)) + nil) (SEQ (EXIT (PROGN (COND ((AND |haveBlank| (OR (|member| |x| |blanks|) (|member| |x| |prims|))) - (SPADLET |msg1| (CDR |msg1|)))) - (SPADLET |msg1| (CONS |x| |msg1|)) - (SPADLET |haveBlank| + (setq |msg1| (CDR |msg1|)))) + (setq |msg1| (cons |x| |msg1|)) + (setq |haveBlank| (COND ((|member| |x| |blanks|) 'T) - ('T NIL))))))) + ('T nil))))))) |msg1|)))))) ;operationLink name == @@ -629,49 +627,11 @@ ; name, ; escapeSpecialChars STRINGIMAGE name) -(DEFUN |operationLink| (|name|) - (FORMAT NIL "\\lispLink{\\verb!(|oSearch| \"~a\")!}{~a}" +(defun |operationLink| (|name|) + (FORMAT nil "\\lispLink{\\verb!(|oSearch| \"~a\")!}{~a}" |name| (|escapeSpecialChars| (STRINGIMAGE |name|)))) ;---------------------------------------- -;sayPatternMsg(msg,args) == -; msg := segmentKeyedMsg msg -; msg := substituteSegmentedMsg(msg,args) -; sayMSG flowSegmentedMsg(msg,$LINELENGTH,3) - -(DEFUN |sayPatternMsg| (|msg| |args|) - (declare (special $LINELENGTH)) - (PROGN - (SPADLET |msg| (|segmentKeyedMsg| |msg|)) - (SPADLET |msg| (|substituteSegmentedMsg| |msg| |args|)) - (|sayMSG| (|flowSegmentedMsg| |msg| $LINELENGTH 3)))) - -;throwPatternMsg(key,args) == -; sayMSG '" " -; if $testingSystem then sayMSG $testingErrorPrefix -; sayPatternMsg(key,args) -; spadThrow() - -(DEFUN |throwPatternMsg| (|key| |args|) - (declare (special |$testingErrorPrefix| |$testingSystem|)) - (PROGN - (|sayMSG| " ") - (COND (|$testingSystem| (|sayMSG| |$testingErrorPrefix|))) - (|sayPatternMsg| |key| |args|) - (|spadThrow|))) - -;sayKeyedMsgAsTeX(key, args) == -; $texFormatting: fluid := true -; sayKeyedMsgLocal(key, args) - -(DEFUN |sayKeyedMsgAsTeX| (|key| |args|) - (PROG (|$texFormatting|) - (DECLARE (SPECIAL |$texFormatting|)) - (RETURN - (PROGN - (SPADLET |$texFormatting| 'T) - (|sayKeyedMsgLocal| |key| |args|))))) - ;throwKeyedErrorMsg(kind,key,args) == ; BUMPERRORCOUNT kind ; sayMSG '" " @@ -679,14 +639,13 @@ ; sayKeyedMsg(key,args) ; spadThrow() -(DEFUN |throwKeyedErrorMsg| (|kind| |key| |args|) +(defun |throwKeyedErrorMsg| (|kind| |key| |args|) (declare (special |$testingErrorPrefix| |$testingSystem|)) - (PROGN - (BUMPERRORCOUNT |kind|) + (bumperrorcount |kind|) (|sayMSG| " ") - (COND (|$testingSystem| (|sayMSG| |$testingErrorPrefix|))) + (when |$testingSystem| (|sayMSG| |$testingErrorPrefix|)) (|sayKeyedMsg| |key| |args|) - (|spadThrow|))) + (|spadThrow|)) ;throwKeyedMsgSP(key,args,atree) == ; if atree and (sp := getSrcPos(atree)) then @@ -694,66 +653,31 @@ ; srcPosDisplay(sp) ; throwKeyedMsg(key,args) -(DEFUN |throwKeyedMsgSP| (|key| |args| |atree|) +(defun |throwKeyedMsgSP| (|key| |args| |atree|) (PROG (|sp|) (RETURN (PROGN (COND - ((AND |atree| (SPADLET |sp| (|getSrcPos| |atree|))) + ((AND |atree| (setq |sp| (|getSrcPos| |atree|))) (|sayMSG| " ") (|srcPosDisplay| |sp|))) (|throwKeyedMsg| |key| |args|))))) ;throwKeyedMsg(key,args) == -; $saturn => saturnThrowKeyedMsg(key, args) -; throwKeyedMsg1(key, args) - -(DEFUN |throwKeyedMsg| (|key| |args|) - (declare (special |$saturn|)) - (COND - (|$saturn| (|saturnThrowKeyedMsg| |key| |args|)) - ('T (|throwKeyedMsg1| |key| |args|)))) - -;saturnThrowKeyedMsg(key,args) == -; _*STANDARD_-OUTPUT_* : fluid := $texOutputStream -; last := pushSatOutput("line") -; sayString '"\bgroup\color{red}\begin{list}\item{} " -; sayKeyedMsgAsTeX(key,args) -; sayString '"\end{list}\egroup" -; popSatOutput(last) -; spadThrow() - -(DEFUN |saturnThrowKeyedMsg| (|key| |args|) - (PROG (*STANDARD-OUTPUT* |last|) - (DECLARE (SPECIAL *STANDARD-OUTPUT* |$texOutputStream|)) - (RETURN - (PROGN - (SPADLET *STANDARD-OUTPUT* |$texOutputStream|) - (SPADLET |last| (|pushSatOutput| '|line|)) - (|sayString| - "\\bgroup\\color{red}\\begin{list}\\item{} ") - (|sayKeyedMsgAsTeX| |key| |args|) - (|sayString| "\\end{list}\\egroup") - (|popSatOutput| |last|) - (|spadThrow|))))) - -;throwKeyedMsg1(key,args) == ; _*STANDARD_-OUTPUT_* : fluid := $texOutputStream ; sayMSG '" " ; if $testingSystem then sayMSG $testingErrorPrefix ; sayKeyedMsg(key,args) ; spadThrow() -(DEFUN |throwKeyedMsg1| (|key| |args|) - (PROG (*STANDARD-OUTPUT*) - (DECLARE (SPECIAL *STANDARD-OUTPUT* |$testingErrorPrefix| - |$testingSystem| |$texOutputStream|)) - (RETURN - (PROGN - (SPADLET *STANDARD-OUTPUT* |$texOutputStream|) - (|sayMSG| " ") - (COND (|$testingSystem| (|sayMSG| |$testingErrorPrefix|))) - (|sayKeyedMsg| |key| |args|) - (|spadThrow|))))) +(defun |throwKeyedMsg| (|key| |args|) + (let (*standard-output*) + (declare (special *standard-OUTPUT* |$testingErrorPrefix| + |$testingSystem| |$texOutputStream|)) + (setq *standard-output* |$texOutputStream|) + (|sayMSG| " ") + (when |$testingSystem| (|sayMSG| |$testingErrorPrefix|)) + (|sayKeyedMsg| |key| |args|) + (|spadThrow|))) ;throwListOfKeyedMsgs(descKey,descArgs,l) == ; -- idea is that descKey and descArgs are the message describing @@ -769,7 +693,7 @@ ; sayKeyedMsg(key,[n,:args]) ; spadThrow() -(DEFUN |throwListOfKeyedMsgs| (|descKey| |descArgs| |l|) +(defun |throwListOfKeyedMsgs| (|descKey| |descArgs| |l|) (PROG (|key| |args| |n|) (declare (special |$testingErrorPrefix| |$testingSystem|)) (RETURN @@ -779,22 +703,22 @@ (|$testingSystem| (|sayMSG| |$testingErrorPrefix|))) (|sayKeyedMsg| |descKey| |descArgs|) (|sayMSG| " ") - (DO ((G166441 |l| (CDR G166441)) (G166429 NIL) + (DO ((G166441 |l| (CDR G166441)) (G166429 nil) (|i| 1 (QSADD1 |i|))) ((OR (ATOM G166441) - (PROGN (SETQ G166429 (CAR G166441)) NIL) + (PROGN (SETQ G166429 (CAR G166441)) nil) (PROGN (PROGN - (SPADLET |key| (CAR G166429)) - (SPADLET |args| (CADR G166429)) + (setq |key| (CAR G166429)) + (setq |args| (CADR G166429)) G166429) - NIL)) - NIL) + nil)) + nil) (SEQ (EXIT (PROGN - (SPADLET |n| + (setq |n| (STRCONC (|object2String| |i|) ".")) - (|sayKeyedMsg| |key| (CONS |n| |args|)))))) + (|sayKeyedMsg| |key| (cons |n| |args|)))))) (|spadThrow|)))))) ;-- breakKeyedMsg is like throwKeyedMsg except that the user is given @@ -804,7 +728,7 @@ ; sayKeyedMsg(key,args) ; handleLispBreakLoop($BreakMode) -(DEFUN |breakKeyedMsg| (|key| |args|) +(defun |breakKeyedMsg| (|key| |args|) (declare (special |$BreakMode|)) (PROGN (BUMPCOMPERRORCOUNT) @@ -812,219 +736,19 @@ (|handleLispBreakLoop| |$BreakMode|))) ;keyedSystemError(key,args) == -; $saturn => saturnKeyedSystemError(key, args) -; keyedSystemError1(key, args) - -(DEFUN |keyedSystemError| (|key| |args|) - (declare (special |$saturn|)) - (COND - (|$saturn| (|saturnKeyedSystemError| |key| |args|)) - ('T (|keyedSystemError1| |key| |args|)))) - -;saturnKeyedSystemError(key, args) == -; _*STANDARD_-OUTPUT_* : fluid := $texOutputStream -; sayString '"\bgroup\color{red}" -; sayString '"\begin{verbatim}" -; sayKeyedMsg("S2GE0000",NIL) -; BUMPCOMPERRORCOUNT() -; sayKeyedMsgAsTeX(key,args) -; sayString '"\end{verbatim}" -; sayString '"\egroup" -; handleLispBreakLoop($BreakMode) - -(DEFUN |saturnKeyedSystemError| (|key| |args|) - (PROG (*STANDARD-OUTPUT*) - (DECLARE (SPECIAL *STANDARD-OUTPUT* |$BreakMode| |$texOutputStream|)) - (RETURN - (PROGN - (SPADLET *STANDARD-OUTPUT* |$texOutputStream|) - (|sayString| "\\bgroup\\color{red}") - (|sayString| "\\begin{verbatim}") - (|sayKeyedMsg| "Internal Error" NIL) - (BUMPCOMPERRORCOUNT) - (|sayKeyedMsgAsTeX| |key| |args|) - (|sayString| "\\end{verbatim}") - (|sayString| "\\egroup") - (|handleLispBreakLoop| |$BreakMode|))))) - -;keyedSystemError1(key,args) == -; sayKeyedMsg("S2GE0000",NIL) +; sayKeyedMsg("S2GE0000",nil) ; breakKeyedMsg(key,args) -(DEFUN |keyedSystemError1| (|key| |args|) - (PROGN (|sayKeyedMsg| "Internal Error" NIL) (|breakKeyedMsg| |key| |args|))) - -;-- these 2 functions control the mode of saturn output. -;-- having the stream writing functions control this would -;-- be better (eg. sayText, sayCommands) -;pushSatOutput(arg) == -; $saturnMode = arg => arg -; was := $saturnMode -; arg = "verb" => -; $saturnMode := "verb" -; sayString '"\begin{verbatim}" -; was -; arg = "line" => -; $saturnMode := "line" -; sayString '"\end{verbatim}" -; was -; sayString FORMAT(nil, '"What is: ~a", $saturnMode) -; $saturnMode - -(DEFUN |pushSatOutput| (|arg|) - (PROG (|was|) - (declare (special |$saturnMode|)) - (RETURN - (COND - ((BOOT-EQUAL |$saturnMode| |arg|) |arg|) - ('T (SPADLET |was| |$saturnMode|) - (COND - ((BOOT-EQUAL |arg| '|verb|) (SPADLET |$saturnMode| '|verb|) - (|sayString| "\\begin{verbatim}") |was|) - ((BOOT-EQUAL |arg| '|line|) (SPADLET |$saturnMode| '|line|) - (|sayString| "\\end{verbatim}") |was|) - ('T - (|sayString| - (FORMAT NIL "What is: ~a" |$saturnMode|)) - |$saturnMode|))))))) - -;popSatOutput(newmode) == -; newmode = $saturnMode => nil -; newmode = "verb" => -; $saturnMode := "verb" -; sayString '"\begin{verbatim}" -; newmode = "line" => -; $saturnMode := "line" -; sayString '"\end{verbatim}" -; sayString FORMAT(nil, '"What is: ~a", $saturnMode) -; $saturnMode - -(DEFUN |popSatOutput| (|newmode|) - (declare (special |$saturnMode|)) - (COND - ((BOOT-EQUAL |newmode| |$saturnMode|) NIL) - ((BOOT-EQUAL |newmode| '|verb|) (SPADLET |$saturnMode| '|verb|) - (|sayString| "\\begin{verbatim}")) - ((BOOT-EQUAL |newmode| '|line|) (SPADLET |$saturnMode| '|line|) - (|sayString| "\\end{verbatim}")) - ('T - (|sayString| - (FORMAT NIL "What is: ~a" |$saturnMode|)) - |$saturnMode|))) +(defun |keyedSystemError| (|key| |args|) + (|sayKeyedMsg| "Internal Error" nil) + (|breakKeyedMsg| |key| |args|))) ;systemErrorHere functionName == ; keyedSystemError("S2GE0017",[functionName]) -(DEFUN |systemErrorHere| (|functionName|) +(defun |systemErrorHere| (|functionName|) (|keyedSystemError| "Unexpected error in call to system function %1" - (CONS |functionName| NIL))) - -;isKeyedMsgInDb(key,dbName) == -; $msgDatabaseName : fluid := pathname dbName -; fetchKeyedMsg(key,true) - -(DEFUN |isKeyedMsgInDb| (|key| |dbName|) - (PROG (|$msgDatabaseName|) - (DECLARE (SPECIAL |$msgDatabaseName|)) - (RETURN - (PROGN - (SPADLET |$msgDatabaseName| (|pathname| |dbName|)) - (|fetchKeyedMsg| |key| 'T))))) - -;getKeyedMsgInDb(key,dbName) == -; $msgDatabaseName : fluid := pathname dbName -; fetchKeyedMsg(key,false) - -(DEFUN |getKeyedMsgInDb| (|key| |dbName|) - (PROG (|$msgDatabaseName|) - (DECLARE (SPECIAL |$msgDatabaseName|)) - (RETURN - (PROGN - (SPADLET |$msgDatabaseName| (|pathname| |dbName|)) - (|fetchKeyedMsg| |key| NIL))))) - -;sayKeyedMsgFromDb(key,args,dbName) == -; $msgDatabaseName : fluid := pathname dbName -; msg := segmentKeyedMsg getKeyedMsg key -; msg := substituteSegmentedMsg(msg,args) -; if $displayMsgNumber then msg := ['"%b",key,":",'%d,:msg] -;--sayMSG flowSegmentedMsg(msg,$LINELENGTH,3) -; u := flowSegmentedMsg(msg,$LINELENGTH,3) -; sayBrightly u - -(DEFUN |sayKeyedMsgFromDb| (|key| |args| |dbName|) - (PROG (|$msgDatabaseName| |msg| |u|) - (DECLARE (SPECIAL |$msgDatabaseName| $LINELENGTH |$displayMsgNumber|)) - (RETURN - (PROGN - (SPADLET |$msgDatabaseName| (|pathname| |dbName|)) - (SPADLET |msg| (|segmentKeyedMsg| (|fetchKeyedMsg| |key| nil))) - (SPADLET |msg| (|substituteSegmentedMsg| |msg| |args|)) - (COND - (|$displayMsgNumber| - (SPADLET |msg| - (CONS |key| - (CONS '|:| |msg|))))) - (SPADLET |u| (|flowSegmentedMsg| |msg| $LINELENGTH 3)) - (|sayBrightly| |u|))))) - -;returnStLFromKey(key,argL,:optDbN) == -; savedDbN := $msgDatabaseName -; if IFCAR optDbN then -; $msgDatabaseName := pathname CAR optDbN -; text := fetchKeyedMsg(key, false) -; $msgDatabaseName := savedDbN -; text := segmentKeyedMsg text -; text := substituteSegmentedMsg(text,argL) - -(DEFUN |returnStLFromKey| (&REST G166528 &AUX |optDbN| |argL| |key|) - (DSETQ (|key| |argL| . |optDbN|) G166528) - (PROG (|savedDbN| |text|) - (declare (special |$msgDatabaseName|)) - (RETURN - (PROGN - (SPADLET |savedDbN| |$msgDatabaseName|) - (COND - ((IFCAR |optDbN|) - (SPADLET |$msgDatabaseName| (|pathname| (CAR |optDbN|))))) - (SPADLET |text| (|fetchKeyedMsg| |key| NIL)) - (SPADLET |$msgDatabaseName| |savedDbN|) - (SPADLET |text| (|segmentKeyedMsg| |text|)) - (SPADLET |text| (|substituteSegmentedMsg| |text| |argL|)))))) - -;throwKeyedMsgFromDb(key,args,dbName) == -; sayMSG '" " -; if $testingSystem then sayMSG $testingErrorPrefix -; sayKeyedMsgFromDb(key,args,dbName) -; spadThrow() - -(DEFUN |throwKeyedMsgFromDb| (|key| |args| |dbName|) - (declare (special |$testingErrorPrefix| |$testingSystem|)) - (PROGN - (|sayMSG| " ") - (COND (|$testingSystem| (|sayMSG| |$testingErrorPrefix|))) - (|sayKeyedMsgFromDb| |key| |args| |dbName|) - (|spadThrow|))) - -;queryUserKeyedMsg(key,args) == -; -- display message and return reply -; conStream := DEFIOSTREAM ('((DEVICE . CONSOLE) (MODE . INPUT)),120,0) -; sayKeyedMsg(key,args) -; ans := READ_-LINE conStream -; SHUT conStream -; ans - -(DEFUN |queryUserKeyedMsg| (|key| |args|) - (PROG (|conStream| |ans|) - (RETURN - (PROGN - (SPADLET |conStream| - (DEFIOSTREAM '((DEVICE . CONSOLE) (MODE . INPUT)) 120 - 0)) - (|sayKeyedMsg| |key| |args|) - (SPADLET |ans| (|read-line| |conStream|)) - (SHUT |conStream|) - |ans|)))) + (cons |functionName| nil))) ;flowSegmentedMsg(msg, len, offset) == ; -- tries to break a sayBrightly-type input msg into multiple @@ -1042,7 +766,7 @@ ; off := (offset <= 0 => '""; fillerSpaces(offset,'" ")) ; off1:= (offset <= 1 => '""; fillerSpaces(offset-1,'" ")) ; firstLine := true -; CONSP msg => +; consp msg => ; lnl := offset ; if msg is [a,:.] and a in '(%b %d _ "%b" "%d" " ") then ; nl := [off1] @@ -1053,14 +777,14 @@ ; actualMarg := potentialMarg ; if lnl = 99999 then nl := ['%l,:nl] ; lnl := 99999 -; CONSP(f) and CAR(f) in '("%m" %m '%ce "%ce" %rj "%rj") => +; consp(f) and CAR(f) in '("%m" %m '%ce "%ce" %rj "%rj") => ; actualMarg := potentialMarg ; nl := [f,'%l,:nl] ; lnl := 199999 ; f in '("%i" %i ) => ; potentialMarg := potentialMarg + 3 ; nl := [f,:nl] -; CONSP(f) and CAR(f) in '("%t" %t) => +; consp(f) and CAR(f) in '("%t" %t) => ; potentialMarg := potentialMarg + CDR f ; nl := [f,:nl] ; sbl := sayBrightlyLength f @@ -1083,118 +807,118 @@ ; concat nreverse nl ; concat('%l,off,msg) -(DEFUN |flowSegmentedMsg| (|msg| |len| |offset|) +(defun |flowSegmentedMsg| (|msg| |len| |offset|) (PROG (|ISTMP#1| |ce| |a| |potentialMarg| |sbl| |tot| |firstLine| |off1| |off| |actualMarg| |nl| |lnl|) (declare (special |$texFormatting|)) (RETURN (SEQ (COND - ((AND (CONSP |msg|) (EQ (QCDR |msg|) NIL) + ((AND (consp |msg|) (EQ (QCDR |msg|) nil) (PROGN - (SPADLET |ISTMP#1| (QCAR |msg|)) - (AND (CONSP |ISTMP#1|) - (PROGN (SPADLET |ce| (QCAR |ISTMP#1|)) 'T))) + (setq |ISTMP#1| (QCAR |msg|)) + (AND (consp |ISTMP#1|) + (PROGN (setq |ce| (QCAR |ISTMP#1|)) 'T))) (|member| |ce| '(|%ce| "%ce" |%rj| "%rj"))) |msg|) (|$texFormatting| |msg|) - ((AND (CONSP |msg|) (EQ (QCDR |msg|) NIL) + ((AND (consp |msg|) (EQ (QCDR |msg|) nil) (PROGN - (SPADLET |ISTMP#1| (QCAR |msg|)) - (AND (CONSP |ISTMP#1|) - (PROGN (SPADLET |ce| (QCAR |ISTMP#1|)) 'T))) + (setq |ISTMP#1| (QCAR |msg|)) + (AND (consp |ISTMP#1|) + (PROGN (setq |ce| (QCAR |ISTMP#1|)) 'T))) (member |ce| '(|%ce| "%ce") :test #'equal)) |msg|) - ('T (SPADLET |potentialMarg| 0) (SPADLET |actualMarg| 0) - (SPADLET |off| + ('T (setq |potentialMarg| 0) (setq |actualMarg| 0) + (setq |off| (COND ((<= |offset| 0) "") ('T (|fillerSpaces| |offset| " ")))) - (SPADLET |off1| + (setq |off1| (COND ((<= |offset| 1) "") ('T (|fillerSpaces| (SPADDIFFERENCE |offset| 1) " ")))) - (SPADLET |firstLine| 'T) + (setq |firstLine| 'T) (COND - ((CONSP |msg|) (SPADLET |lnl| |offset|) + ((consp |msg|) (setq |lnl| |offset|) (COND - ((AND (CONSP |msg|) - (PROGN (SPADLET |a| (QCAR |msg|)) 'T) + ((AND (consp |msg|) + (PROGN (setq |a| (QCAR |msg|)) 'T) (|member| |a| '(| | " "))) - (SPADLET |nl| (CONS |off1| NIL)) - (SPADLET |lnl| (SPADDIFFERENCE |lnl| 1))) - ('T (SPADLET |nl| (CONS |off| NIL)))) - (DO ((G166564 |msg| (CDR G166564)) (|f| NIL)) + (setq |nl| (cons |off1| nil)) + (setq |lnl| (SPADDIFFERENCE |lnl| 1))) + ('T (setq |nl| (cons |off| nil)))) + (DO ((G166564 |msg| (CDR G166564)) (|f| nil)) ((OR (ATOM G166564) - (PROGN (SETQ |f| (CAR G166564)) NIL)) - NIL) + (PROGN (SETQ |f| (CAR G166564)) nil)) + nil) (SEQ (EXIT (COND ((|member| |f| '("%l" |%l|)) - (SPADLET |actualMarg| |potentialMarg|) + (setq |actualMarg| |potentialMarg|) (COND ((EQL |lnl| 99999) - (SPADLET |nl| (CONS '|%l| |nl|)))) - (SPADLET |lnl| 99999)) - ((AND (CONSP |f|) + (setq |nl| (cons '|%l| |nl|)))) + (setq |lnl| 99999)) + ((AND (consp |f|) (|member| (CAR |f|) '("%m" |%m| '|%ce| "%ce" |%rj| "%rj"))) - (SPADLET |actualMarg| |potentialMarg|) - (SPADLET |nl| - (CONS |f| (CONS '|%l| |nl|))) - (SPADLET |lnl| 199999)) + (setq |actualMarg| |potentialMarg|) + (setq |nl| + (cons |f| (cons '|%l| |nl|))) + (setq |lnl| 199999)) ((|member| |f| '("%i" |%i|)) - (SPADLET |potentialMarg| + (setq |potentialMarg| (PLUS |potentialMarg| 3)) - (SPADLET |nl| (CONS |f| |nl|))) - ((AND (CONSP |f|) + (setq |nl| (cons |f| |nl|))) + ((AND (consp |f|) (|member| (CAR |f|) '("%t" |%t|))) - (SPADLET |potentialMarg| + (setq |potentialMarg| (PLUS |potentialMarg| (CDR |f|))) - (SPADLET |nl| (CONS |f| |nl|))) + (setq |nl| (cons |f| |nl|))) ('T - (SPADLET |sbl| + (setq |sbl| (|sayBrightlyLength| |f|)) - (SPADLET |tot| + (setq |tot| (PLUS (PLUS (PLUS |lnl| |offset|) |sbl|) |actualMarg|)) (COND (|firstLine| - (SPADLET |firstLine| NIL) - (SPADLET |offset| + (setq |firstLine| nil) + (setq |offset| (PLUS |offset| |offset|)) - (SPADLET |off1| + (setq |off1| (STRCONC |off| |off1|)) - (SPADLET |off| + (setq |off| (STRCONC |off| |off|)))) (COND ((OR (<= |tot| |len|) (AND (EQL |sbl| 1) (BOOT-EQUAL |tot| |len|))) - (SPADLET |nl| (CONS |f| |nl|)) - (SPADLET |lnl| (PLUS |lnl| |sbl|))) + (setq |nl| (cons |f| |nl|)) + (setq |lnl| (PLUS |lnl| |sbl|))) ((|member| |f| '(| | " ")) - (SPADLET |nl| - (CONS |f| - (CONS |off1| (CONS '|%l| |nl|)))) - (SPADLET |actualMarg| + (setq |nl| + (cons |f| + (cons |off1| (cons '|%l| |nl|)))) + (setq |actualMarg| |potentialMarg|) - (SPADLET |lnl| + (setq |lnl| (PLUS (PLUS (SPADDIFFERENCE 1) |offset|) |sbl|))) ('T - (SPADLET |nl| - (CONS |f| - (CONS |off| (CONS '|%l| |nl|)))) - (SPADLET |lnl| + (setq |nl| + (cons |f| + (cons |off| (cons '|%l| |nl|)))) + (setq |lnl| (PLUS |offset| |sbl|))))))))) (|concat| (NREVERSE |nl|))) ('T (|concat| '|%l| |off| |msg|))))))))) @@ -1206,11 +930,11 @@ ; not $useCoerceOrCroak => THROW('coerceOrCroaker, 'croaked) ; if not($Coerce) and $reportInterpOnly then ; sayKeyedMsg(key,args) -; sayKeyedMsg("S2IB0009",NIL) +; sayKeyedMsg("S2IB0009",nil) ; null $compilingMap => THROW('loopCompiler,'tryInterpOnly) ; THROW('mapCompiler,'tryInterpOnly) -(DEFUN |keyedMsgCompFailure| (|key| |args|) +(defun |keyedMsgCompFailure| (|key| |args|) (declare (special |$compilingMap| |$reportInterpOnly| |$Coerce| |$useCoerceOrCroak|)) (COND @@ -1220,7 +944,7 @@ ((AND (NULL |$Coerce|) |$reportInterpOnly|) (|sayKeyedMsg| |key| |args|) (|sayKeyedMsg| - "Axiom will attempt to step through and interpret the code." NIL))) + "Axiom will attempt to step through and interpret the code." nil))) (COND ((NULL |$compilingMap|) (THROW '|loopCompiler| '|tryInterpOnly|)) @@ -1235,11 +959,11 @@ ; sayMSG '" " ; srcPosDisplay(sp) ; sayKeyedMsg(key,args) -; sayKeyedMsg("S2IB0009",NIL) +; sayKeyedMsg("S2IB0009",nil) ; null $compilingMap => THROW('loopCompiler,'tryInterpOnly) ; THROW('mapCompiler,'tryInterpOnly) -(DEFUN |keyedMsgCompFailureSP| (|key| |args| |atree|) +(defun |keyedMsgCompFailureSP| (|key| |args| |atree|) (PROG (|sp|) (declare (special |$compilingMap| |$reportInterpOnly| |$Coerce| |$useCoerceOrCroak|)) @@ -1251,12 +975,12 @@ (COND ((AND (NULL |$Coerce|) |$reportInterpOnly|) (COND - ((AND |atree| (SPADLET |sp| (|getSrcPos| |atree|))) + ((AND |atree| (setq |sp| (|getSrcPos| |atree|))) (|sayMSG| " ") (|srcPosDisplay| |sp|))) (|sayKeyedMsg| |key| |args|) (|sayKeyedMsg| "Axiom will attempt to step through and interpret the code." - NIL))) + nil))) (COND ((NULL |$compilingMap|) (THROW '|loopCompiler| '|tryInterpOnly|)) @@ -1268,42 +992,42 @@ ; val' := objValUnwrap(val') ; throwKeyedMsg("S2IC0003",[t1,t2,val']) -(DEFUN |throwKeyedMsgCannotCoerceWithValue| (|val| |t1| |t2|) +(defun |throwKeyedMsgCannotCoerceWithValue| (|val| |t1| |t2|) (PROG (|val'|) (declare (special |$OutputForm|)) (RETURN (COND - ((NULL (SPADLET |val'| + ((NULL (setq |val'| (|coerceInteractive| (mkObj |val| |t1|) |$OutputForm|))) (|throwKeyedMsg| "Cannot convert the value from type %1p to %2p ." - (CONS |t1| (CONS |t2| NIL)))) - ('T (SPADLET |val'| (|objValUnwrap| |val'|)) + (cons |t1| (cons |t2| nil)))) + ('T (setq |val'| (|objValUnwrap| |val'|)) (|throwKeyedMsg| "Cannot convert from type %1p to %2p for value %3m" - (CONS |t1| (CONS |t2| (CONS |val'| NIL))))))))) + (cons |t1| (cons |t2| (cons |val'| nil))))))))) ;--% Some Standard Message Printing Functions -;bright x == ['"%b",:(CONSP(x) and NULL CDR LASTNODE x => x; [x]),'"%d"] +;bright x == ['"%b",:(consp(x) and NULL CDR LASTNODE x => x; [x]),'"%d"] (defun |bright| (|x|) (if (consp |x|) `(" " ,@|x| " ") `(" " ,|x| " "))) ;--bright x == ['%b,:(ATOM x => [x]; x),'%d] ;mkMessage msg == -; msg and (CONSP msg) and ((first msg) in '(%l "%l")) and +; msg and (consp msg) and ((first msg) in '(%l "%l")) and ; ((last msg) in '(%l "%l")) => concat msg ; concat('%l,msg,'%l) -(DEFUN |mkMessage| (|msg|) +(defun |mkMessage| (|msg|) (COND - ((AND |msg| (CONSP |msg|) (|member| (CAR |msg|) '(|%l| "%l")) + ((AND |msg| (consp |msg|) (|member| (CAR |msg|) '(|%l| "%l")) (|member| (|last| |msg|) '(|%l| "%l"))) (|concat| |msg|)) ('T (|concat| '|%l| |msg| '|%l|)))) ;sayMessage msg == sayMSG mkMessage msg -(DEFUN |sayMessage| (|msg|) (|sayMSG| (|mkMessage| |msg|))) +(defun |sayMessage| (|msg|) (|sayMSG| (|mkMessage| |msg|))) ;sayNewLine(:margin) == ; -- Note: this function should *always* be used by sayBrightly and @@ -1314,40 +1038,40 @@ ;;; *** |sayNewLine| REDEFINED -(DEFUN |sayNewLine| (&REST G166644 &AUX |margin|) +(defun |sayNewLine| (&REST G166644 &AUX |margin|) (DSETQ |margin| G166644) (PROG (|n|) (RETURN (PROGN (TERPRI) (COND - ((AND (CONSP |margin|) (EQ (QCDR |margin|) NIL) - (PROGN (SPADLET |n| (QCAR |margin|)) 'T)) + ((AND (consp |margin|) (EQ (QCDR |margin|) nil) + (PROGN (setq |n| (QCAR |margin|)) 'T)) (BLANKS |n|))) - NIL)))) + nil)))) ;sayString x == ; -- Note: this function should *always* be used by sayBrightly and ; -- friends rather than PRINTEXP -- see bindSayBrightly ; PRINTEXP x -(DEFUN |sayString| (|x|) (PRINTEXP |x|)) +(defun |sayString| (|x|) (PRINTEXP |x|)) -;HELP() == sayKeyedMsg("S2GL0019",NIL) +;HELP() == sayKeyedMsg("S2GL0019",nil) ;;; *** HELP REDEFINED -(DEFUN HELP () +(defun HELP () (|sayKeyedMsg| (format nil "Type (resume) to return to Axiom and continue with the next statement. ~ Type (toplevel) to abort all input files and continue with ~ interactive Axiom.") - NIL)) + nil)) ;version() == _*YEARWEEK_* -(DEFUN |version| () +(defun |version| () (declare (special *YEARWEEK*)) *YEARWEEK*) @@ -1355,20 +1079,20 @@ ;brightPrint x == ; $MARG : local := 0 ; for y in x repeat brightPrint0 y -; NIL +; nil -(DEFUN |brightPrint| (|x|) +(defun |brightPrint| (|x|) (PROG ($MARG) (DECLARE (SPECIAL $MARG)) (RETURN (SEQ (PROGN - (SPADLET $MARG 0) - (DO ((G166664 |x| (CDR G166664)) (|y| NIL)) + (setq $MARG 0) + (DO ((G166664 |x| (CDR G166664)) (|y| nil)) ((OR (ATOM G166664) - (PROGN (SETQ |y| (CAR G166664)) NIL)) - NIL) + (PROGN (SETQ |y| (CAR G166664)) nil)) + nil) (SEQ (EXIT (|brightPrint0| |y|)))) - NIL))))) + nil))))) ;brightPrint0 x == ; $texFormatting => brightPrint0AsTeX x @@ -1377,7 +1101,7 @@ ; -- don't try to give the token any special interpretation. Just print ; -- it without the backslash. ; STRINGP x and STRINGLENGTH x > 1 and x.0 = char "\" and x.1 = char "%" => -; sayString SUBSTRING(x,1,NIL) +; sayString SUBSTRING(x,1,nil) ; x = '"%l" => ; sayNewLine() ; for i in 1..$MARG repeat sayString '" " @@ -1393,45 +1117,45 @@ ; x = '"%%" => ; sayString '"%" ; x = '"%b" => -; NULL IS_-CONSOLE CUROUTSTREAM => sayString '" " +; NULL IS_-consOLE CUROUTSTREAM => sayString '" " ; NULL $highlightAllowed => sayString '" " ; sayString $highlightFontOn ; k := blankIndicator x => BLANKS k ; x = '"%d" => -; NULL IS_-CONSOLE CUROUTSTREAM => sayString '" " +; NULL IS_-consOLE CUROUTSTREAM => sayString '" " ; NULL $highlightAllowed => sayString '" " ; sayString $highlightFontOff ; STRINGP x => sayString x ; brightPrintHighlight x -(DEFUN |brightPrint0| (|x|) +(defun |brightPrint0| (|x|) (PROG (|k|) (declare (special |$highlightFontOff| |$highlightAllowed| $MARG |$highlightFontOn| |$texFormatting|)) (RETURN (SEQ (COND (|$texFormatting| (|brightPrint0AsTeX| |x|)) - ('T (COND ((IDENTP |x|) (SPADLET |x| (PNAME |x|)))) + ('T (COND ((IDENTP |x|) (setq |x| (PNAME |x|)))) (COND ((AND (STRINGP |x|) (> (STRINGLENGTH |x|) 1) (BOOT-EQUAL (ELT |x| 0) (|char| '|\\|)) (BOOT-EQUAL (ELT |x| 1) (|char| '%))) - (|sayString| (SUBSTRING |x| 1 NIL))) + (|sayString| (SUBSTRING |x| 1 nil))) ((BOOT-EQUAL |x| "%l") (|sayNewLine|) (DO ((|i| 1 (QSADD1 |i|))) - ((QSGREATERP |i| $MARG) NIL) + ((QSGREATERP |i| $MARG) nil) (SEQ (EXIT (|sayString| " "))))) ((BOOT-EQUAL |x| "%i") - (SPADLET $MARG (PLUS $MARG 3))) + (setq $MARG (PLUS $MARG 3))) ((BOOT-EQUAL |x| "%u") - (SPADLET $MARG (SPADDIFFERENCE $MARG 3)) - (COND ((MINUSP $MARG) (SPADLET $MARG 0)) ('T NIL))) - ((BOOT-EQUAL |x| "%U") (SPADLET $MARG 0)) + (setq $MARG (SPADDIFFERENCE $MARG 3)) + (COND ((MINUSP $MARG) (setq $MARG 0)) ('T nil))) + ((BOOT-EQUAL |x| "%U") (setq $MARG 0)) ((BOOT-EQUAL |x| "%") (|sayString| " ")) ((BOOT-EQUAL |x| "%%") (|sayString| "%")) - ((SPADLET |k| (|blankIndicator| |x|)) (BLANKS |k|)) + ((setq |k| (|blankIndicator| |x|)) (BLANKS |k|)) ((STRINGP |x|) (|sayString| |x|)) ('T (|brightPrintHighlight| |x|))))))))) @@ -1462,29 +1186,29 @@ ; STRINGP x => sayString x ; brightPrintHighlight x -(DEFUN |brightPrint0AsTeX| (|x|) +(defun |brightPrint0AsTeX| (|x|) (PROG (|k|) (declare (special $MARG)) (RETURN (SEQ (COND ((BOOT-EQUAL |x| "%l") (|sayString| "\\\\") - (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| $MARG) NIL) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| $MARG) nil) (SEQ (EXIT (|sayString| "\\ "))))) ((BOOT-EQUAL |x| "%i") - (SPADLET $MARG (PLUS $MARG 3))) + (setq $MARG (PLUS $MARG 3))) ((BOOT-EQUAL |x| "%u") - (SPADLET $MARG (SPADDIFFERENCE $MARG 3)) - (COND ((MINUSP $MARG) (SPADLET $MARG 0)) ('T NIL))) - ((BOOT-EQUAL |x| "%U") (SPADLET $MARG 0)) + (setq $MARG (SPADDIFFERENCE $MARG 3)) + (COND ((MINUSP $MARG) (setq $MARG 0)) ('T nil))) + ((BOOT-EQUAL |x| "%U") (setq $MARG 0)) ((BOOT-EQUAL |x| "%") (|sayString| "\\ ")) ((BOOT-EQUAL |x| "%%") (|sayString| "%")) ;TPD ((BOOT-EQUAL |x| "%b") ;TPD (|sayString| " {\\tt ")) - ((SPADLET |k| (|blankIndicator| |x|)) - (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |k|) NIL) + ((setq |k| (|blankIndicator| |x|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |k|) nil) (SEQ (EXIT (|sayString| "\\ "))))) ;TPD ((BOOT-EQUAL |x| "%d") ;TPD (|sayString| "} ")) @@ -1503,30 +1227,30 @@ ; 1 ; nil -(DEFUN |blankIndicator| (|x|) +(defun |blankIndicator| (|x|) (PROGN - (COND ((IDENTP |x|) (SPADLET |x| (PNAME |x|)))) + (COND ((IDENTP |x|) (setq |x| (PNAME |x|)))) (COND - ((OR (NULL (STRINGP |x|)) (> 1 (MAXINDEX |x|))) NIL) + ((OR (NULL (STRINGP |x|)) (> 1 (MAXINDEX |x|))) nil) ((AND (BOOT-EQUAL (ELT |x| 0) '%) (BOOT-EQUAL (ELT |x| 1) '|x|)) (COND - ((> (MAXINDEX |x|) 1) (PARSE-INTEGER (SUBSTRING |x| 2 NIL))) + ((> (MAXINDEX |x|) 1) (PARSE-INTEGER (SUBSTRING |x| 2 nil))) ('T 1))) - ('T NIL)))) + ('T nil)))) ;brightPrint1 x == ; if x in '(%l "%l") then sayNewLine() ; else if STRINGP x then sayString x ; else brightPrintHighlight x -; NIL +; nil -(DEFUN |brightPrint1| (|x|) +(defun |brightPrint1| (|x|) (PROGN (COND ((|member| |x| '(|%l| "%l")) (|sayNewLine|)) ((STRINGP |x|) (|sayString| |x|)) ('T (|brightPrintHighlight| |x|))) - NIL)) + nil)) ;brightPrintHighlight x == ; $texFormatting => brightPrintHighlightAsTeX x @@ -1556,18 +1280,18 @@ ; brightPrint1 la ; sayString '")" -(DEFUN |brightPrintHighlight| (|x|) +(defun |brightPrintHighlight| (|x|) (PROG (|pn| |key| |rst| |la|) (declare (special $MARG |$texFormatting|)) (RETURN (SEQ (COND (|$texFormatting| (|brightPrintHighlightAsTeX| |x|)) - ((IDENTP |x|) (SPADLET |pn| (PNAME |x|)) + ((IDENTP |x|) (setq |pn| (PNAME |x|)) (|sayString| |pn|)) ((VECP |x|) (|sayString| "UNPRINTABLE")) ((ATOM |x|) (|sayString| (|object2String| |x|))) - ('T (SPADLET |key| (CAR |x|)) (SPADLET |rst| (CDR |x|)) - (COND ((IDENTP |key|) (SPADLET |key| (PNAME |key|)))) + ('T (setq |key| (CAR |x|)) (setq |rst| (CDR |x|)) + (COND ((IDENTP |key|) (setq |key| (PNAME |key|)))) (COND ((BOOT-EQUAL |key| "%m") (|mathprint| |rst|)) @@ -1577,26 +1301,26 @@ ((BOOT-EQUAL |key| "%rj") (|brightPrintRightJustify| |rst|)) ((BOOT-EQUAL |key| "%t") - (SPADLET $MARG (PLUS $MARG (|tabber| |rst|)))) + (setq $MARG (PLUS $MARG (|tabber| |rst|)))) ('T (|sayString| "(") (|brightPrint1| |key|) (COND ((EQ |key| '|TAGGEDreturn|) - (SPADLET |rst| - (CONS (CAR |rst|) - (CONS (CADR |rst|) - (CONS (CADDR |rst|) - (CONS "environment (omitted)" - NIL))))))) - (DO ((G166741 |rst| (CDR G166741)) (|y| NIL)) + (setq |rst| + (cons (CAR |rst|) + (cons (CADR |rst|) + (cons (CADDR |rst|) + (cons "environment (omitted)" + nil))))))) + (DO ((G166741 |rst| (CDR G166741)) (|y| nil)) ((OR (ATOM G166741) - (PROGN (SETQ |y| (CAR G166741)) NIL)) - NIL) + (PROGN (SETQ |y| (CAR G166741)) nil)) + nil) (SEQ (EXIT (PROGN (|sayString| " ") (|brightPrint1| |y|))))) (COND - ((AND |rst| (SPADLET |la| (LASTATOM |rst|))) + ((AND |rst| (setq |la| (LASTATOM |rst|))) (|sayString| " . ") (|brightPrint1| |la|))) (|sayString| ")"))))))))) @@ -1629,16 +1353,16 @@ ; brightPrint1 la ; sayString '")" -(DEFUN |brightPrintHighlightAsTeX| (|x|) +(defun |brightPrintHighlightAsTeX| (|x|) (PROG (|pn| |key| |rst| |la|) (declare (special $MARG)) (RETURN (SEQ (COND - ((IDENTP |x|) (SPADLET |pn| (PNAME |x|)) + ((IDENTP |x|) (setq |pn| (PNAME |x|)) (|sayString| |pn|)) ((ATOM |x|) (|sayString| (|object2String| |x|))) ((VECP |x|) (|sayString| "UNPRINTABLE")) - ('T (SPADLET |key| (CAR |x|)) (SPADLET |rst| (CDR |x|)) + ('T (setq |key| (CAR |x|)) (setq |rst| (CDR |x|)) (COND ((BOOT-EQUAL |key| "%m") (|mathprint| |rst|)) @@ -1649,26 +1373,26 @@ ((BOOT-EQUAL |key| "%ce") (|brightPrintCenter| |rst|)) ((BOOT-EQUAL |key| "%t") - (SPADLET $MARG (PLUS $MARG (|tabber| |rst|)))) + (setq $MARG (PLUS $MARG (|tabber| |rst|)))) ('T (|sayString| "(") (|brightPrint1| |key|) (COND ((EQ |key| '|TAGGEDreturn|) - (SPADLET |rst| - (CONS (CAR |rst|) - (CONS (CADR |rst|) - (CONS (CADDR |rst|) - (CONS "environment (omitted)" - NIL))))))) - (DO ((G166770 |rst| (CDR G166770)) (|y| NIL)) + (setq |rst| + (cons (CAR |rst|) + (cons (CADR |rst|) + (cons (CADDR |rst|) + (cons "environment (omitted)" + nil))))))) + (DO ((G166770 |rst| (CDR G166770)) (|y| nil)) ((OR (ATOM G166770) - (PROGN (SETQ |y| (CAR G166770)) NIL)) - NIL) + (PROGN (SETQ |y| (CAR G166770)) nil)) + nil) (SEQ (EXIT (PROGN (|sayString| " ") (|brightPrint1| |y|))))) (COND - ((AND |rst| (SPADLET |la| (LASTATOM |rst|))) + ((AND |rst| (setq |la| (LASTATOM |rst|))) (|sayString| " . ") (|brightPrint1| |la|))) (|sayString| ")"))))))))) @@ -1678,11 +1402,11 @@ ; num > maxTab => maxTab ; num -(DEFUN |tabber| (|num|) +(defun |tabber| (|num|) (PROG (|maxTab|) (RETURN (PROGN - (SPADLET |maxTab| 50) + (setq |maxTab| 50) (COND ((> |num| |maxTab|) |maxTab|) ('T |num|)))))) ;brightPrintCenter x == @@ -1695,71 +1419,71 @@ ; f := DIVIDE($LINELENGTH - wid,2) ; x := LIST(fillerSpaces(f.0,'" "),x) ; for y in x repeat brightPrint0 y -; NIL -; y := NIL +; nil +; y := nil ; ok := true ; while x and ok repeat -; if CAR(x) in '(%l "%l") then ok := NIL +; if CAR(x) in '(%l "%l") then ok := nil ; else y := cons(CAR x, y) ; x := CDR x ; y := NREVERSE y ; wid := sayBrightlyLength y ; if wid < $LINELENGTH then ; f := DIVIDE($LINELENGTH - wid,2) -; y := CONS(fillerSpaces(f.0,'" "),y) +; y := cons(fillerSpaces(f.0,'" "),y) ; for z in y repeat brightPrint0 z ; if x then ; sayNewLine() ; brightPrintCenter x -; NIL +; nil -(DEFUN |brightPrintCenter| (|x|) +(defun |brightPrintCenter| (|x|) (PROG (|ok| |wid| |f| |y|) (declare (special $LINELENGTH |$texFormatting|)) (RETURN (SEQ (COND (|$texFormatting| (|brightPrintCenterAsTeX| |x|)) - ((ATOM |x|) (SPADLET |x| (|object2String| |x|)) - (SPADLET |wid| (STRINGLENGTH |x|)) + ((ATOM |x|) (setq |x| (|object2String| |x|)) + (setq |wid| (STRINGLENGTH |x|)) (COND ((> $LINELENGTH |wid|) - (SPADLET |f| + (setq |f| (DIVIDE (SPADDIFFERENCE $LINELENGTH |wid|) 2)) - (SPADLET |x| + (setq |x| (LIST (|fillerSpaces| (ELT |f| 0) " ") |x|)))) - (DO ((G166799 |x| (CDR G166799)) (|y| NIL)) + (DO ((G166799 |x| (CDR G166799)) (|y| nil)) ((OR (ATOM G166799) - (PROGN (SETQ |y| (CAR G166799)) NIL)) - NIL) + (PROGN (SETQ |y| (CAR G166799)) nil)) + nil) (SEQ (EXIT (|brightPrint0| |y|)))) - NIL) - ('T (SPADLET |y| NIL) (SPADLET |ok| 'T) - (DO () ((NULL (AND |x| |ok|)) NIL) + nil) + ('T (setq |y| nil) (setq |ok| 'T) + (DO () ((NULL (AND |x| |ok|)) nil) (SEQ (EXIT (PROGN (COND ((|member| (CAR |x|) '(|%l| "%l")) - (SPADLET |ok| NIL)) - ('T (SPADLET |y| (CONS (CAR |x|) |y|)))) - (SPADLET |x| (CDR |x|)))))) - (SPADLET |y| (NREVERSE |y|)) - (SPADLET |wid| (|sayBrightlyLength| |y|)) + (setq |ok| nil)) + ('T (setq |y| (cons (CAR |x|) |y|)))) + (setq |x| (CDR |x|)))))) + (setq |y| (NREVERSE |y|)) + (setq |wid| (|sayBrightlyLength| |y|)) (COND ((> $LINELENGTH |wid|) - (SPADLET |f| + (setq |f| (DIVIDE (SPADDIFFERENCE $LINELENGTH |wid|) 2)) - (SPADLET |y| - (CONS (|fillerSpaces| (ELT |f| 0) + (setq |y| + (cons (|fillerSpaces| (ELT |f| 0) " ") |y|)))) - (DO ((G166816 |y| (CDR G166816)) (|z| NIL)) + (DO ((G166816 |y| (CDR G166816)) (|z| nil)) ((OR (ATOM G166816) - (PROGN (SETQ |z| (CAR G166816)) NIL)) - NIL) + (PROGN (SETQ |z| (CAR G166816)) nil)) + nil) (SEQ (EXIT (|brightPrint0| |z|)))) (COND (|x| (|sayNewLine|) (|brightPrintCenter| |x|))) - NIL)))))) + nil)))))) ;brightPrintCenterAsTeX x == ; ATOM x => @@ -1780,41 +1504,41 @@ ; sayString '"}" ; nil -(DEFUN |brightPrintCenterAsTeX| (|x|) +(defun |brightPrintCenterAsTeX| (|x|) (PROG (|lst| |words|) (RETURN (SEQ (COND ((ATOM |x|) (|sayString| "\\centerline{") (|sayString| |x|) (|sayString| "}")) - ('T (SPADLET |lst| |x|) - (DO () ((NULL |lst|) NIL) + ('T (setq |lst| |x|) + (DO () ((NULL |lst|) nil) (SEQ (EXIT (PROGN - (SPADLET |words| NIL) + (setq |words| nil) (DO () ((NULL (AND |lst| (NULL (BOOT-EQUAL (CAR |lst|) '|%l|)))) - NIL) + nil) (SEQ (EXIT (PROGN - (SPADLET |words| - (CONS (CAR |lst|) |words|)) - (SPADLET |lst| (CDR |lst|)))))) + (setq |words| + (cons (CAR |lst|) |words|)) + (setq |lst| (CDR |lst|)))))) (COND - (|lst| (SPADLET |lst| (CDR |lst|)))) + (|lst| (setq |lst| (CDR |lst|)))) (|sayString| "\\centerline{") - (SPADLET |words| (NREVERSE |words|)) + (setq |words| (NREVERSE |words|)) (DO ((G166868 |words| (CDR G166868)) - (|zz| NIL)) + (|zz| nil)) ((OR (ATOM G166868) (PROGN (SETQ |zz| (CAR G166868)) - NIL)) - NIL) + nil)) + nil) (SEQ (EXIT (|brightPrint0| |zz|)))) (|sayString| "}"))))) - NIL)))))) + nil)))))) ;brightPrintRightJustify x == ; -- right justifies rst within $LINELENGTH, checking for %l's @@ -1824,71 +1548,71 @@ ; wid < $LINELENGTH => ; x := LIST(fillerSpaces($LINELENGTH-wid,'" "),x) ; for y in x repeat brightPrint0 y -; NIL +; nil ; brightPrint0 x -; NIL -; y := NIL +; nil +; y := nil ; ok := true ; while x and ok repeat -; if CAR(x) in '(%l "%l") then ok := NIL +; if CAR(x) in '(%l "%l") then ok := nil ; else y := cons(CAR x, y) ; x := CDR x ; y := NREVERSE y ; wid := sayBrightlyLength y ; if wid < $LINELENGTH then -; y := CONS(fillerSpaces($LINELENGTH-wid,'" "),y) +; y := cons(fillerSpaces($LINELENGTH-wid,'" "),y) ; for z in y repeat brightPrint0 z ; if x then ; sayNewLine() ; brightPrintRightJustify x -; NIL +; nil -(DEFUN |brightPrintRightJustify| (|x|) +(defun |brightPrintRightJustify| (|x|) (PROG (|ok| |wid| |y|) (declare (special $LINELENGTH)) (RETURN (SEQ (COND - ((ATOM |x|) (SPADLET |x| (|object2String| |x|)) - (SPADLET |wid| (STRINGLENGTH |x|)) + ((ATOM |x|) (setq |x| (|object2String| |x|)) + (setq |wid| (STRINGLENGTH |x|)) (COND ((> $LINELENGTH |wid|) - (SPADLET |x| + (setq |x| (LIST (|fillerSpaces| (SPADDIFFERENCE $LINELENGTH |wid|) " ") |x|)) - (DO ((G166891 |x| (CDR G166891)) (|y| NIL)) + (DO ((G166891 |x| (CDR G166891)) (|y| nil)) ((OR (ATOM G166891) - (PROGN (SETQ |y| (CAR G166891)) NIL)) - NIL) + (PROGN (SETQ |y| (CAR G166891)) nil)) + nil) (SEQ (EXIT (|brightPrint0| |y|)))) - NIL) - ('T (|brightPrint0| |x|) NIL))) - ('T (SPADLET |y| NIL) (SPADLET |ok| 'T) - (DO () ((NULL (AND |x| |ok|)) NIL) + nil) + ('T (|brightPrint0| |x|) nil))) + ('T (setq |y| nil) (setq |ok| 'T) + (DO () ((NULL (AND |x| |ok|)) nil) (SEQ (EXIT (PROGN (COND ((|member| (CAR |x|) '(|%l| "%l")) - (SPADLET |ok| NIL)) - ('T (SPADLET |y| (CONS (CAR |x|) |y|)))) - (SPADLET |x| (CDR |x|)))))) - (SPADLET |y| (NREVERSE |y|)) - (SPADLET |wid| (|sayBrightlyLength| |y|)) + (setq |ok| nil)) + ('T (setq |y| (cons (CAR |x|) |y|)))) + (setq |x| (CDR |x|)))))) + (setq |y| (NREVERSE |y|)) + (setq |wid| (|sayBrightlyLength| |y|)) (COND ((> $LINELENGTH |wid|) - (SPADLET |y| - (CONS (|fillerSpaces| + (setq |y| + (cons (|fillerSpaces| (SPADDIFFERENCE $LINELENGTH |wid|) " ") |y|)))) - (DO ((G166908 |y| (CDR G166908)) (|z| NIL)) + (DO ((G166908 |y| (CDR G166908)) (|z| nil)) ((OR (ATOM G166908) - (PROGN (SETQ |z| (CAR G166908)) NIL)) - NIL) + (PROGN (SETQ |z| (CAR G166908)) nil)) + nil) (SEQ (EXIT (|brightPrint0| |z|)))) (COND (|x| (|sayNewLine|) (|brightPrintRightJustify| |x|))) - NIL)))))) + nil)))))) ;-- some hooks for older functions ;--------------------> NEW DEFINITION (see macros.lisp.pamphlet) @@ -1896,14 +1620,14 @@ ;;; *** BRIGHTPRINT REDEFINED -(DEFUN BRIGHTPRINT (|x|) (|brightPrint| |x|)) +(defun BRIGHTPRINT (|x|) (|brightPrint| |x|)) ;--------------------> NEW DEFINITION (see macros.lisp.pamphlet) ;BRIGHTPRINT_-0 x == brightPrint0 x ;;; *** BRIGHTPRINT-0 REDEFINED -(DEFUN BRIGHTPRINT-0 (|x|) (|brightPrint0| |x|)) +(defun BRIGHTPRINT-0 (|x|) (|brightPrint0| |x|)) ;--% Message Formatting Utilities ;sayBrightlyLength l == @@ -1911,7 +1635,7 @@ ; atom l => sayBrightlyLength1 l ; sayBrightlyLength1 first l + sayBrightlyLength rest l -(DEFUN |sayBrightlyLength| (|l|) +(defun |sayBrightlyLength| (|l|) (COND ((NULL |l|) 0) ((ATOM |l|) (|sayBrightlyLength1| |l|)) @@ -1934,7 +1658,7 @@ ; ATOM x => STRINGLENGTH STRINGIMAGE x ; 2 + sayBrightlyLength x -(DEFUN |sayBrightlyLength1| (|x|) +(defun |sayBrightlyLength1| (|x|) (declare (special |$highlightAllowed|)) (COND ;TPD ((|member| |x| '("%b" "%d" |%b| |%d|)) @@ -1957,7 +1681,7 @@ ; -- w will be the field width in which we will display the elements ; m > $LINELENGTH => ; for a in l repeat sayMSG a -; NIL +; nil ; w := MIN(m + 3,$LINELENGTH) ; -- p is the number of elements per line ; p := QUOTIENT($LINELENGTH,w) @@ -1968,61 +1692,61 @@ ; str := STRCONC(str,c,fillerSpaces(w - #c,'" ")) ; REMAINDER(i+1,p) = 0 => (sayMSG str ; str := '"" ) ; if str ^= '"" then sayMSG str -; NIL +; nil -(DEFUN |sayAsManyPerLineAsPossible| (|l|) +(defun |sayAsManyPerLineAsPossible| (|l|) (PROG (|m| |w| |p| |n| |LETTMP#1| |c| |str|) (declare (special $LINELENGTH)) (RETURN (SEQ (PROGN - (SPADLET |l| + (setq |l| (PROG (G166958) - (SPADLET G166958 NIL) + (setq G166958 nil) (RETURN (DO ((G166963 |l| (CDR G166963)) - (|a| NIL)) + (|a| nil)) ((OR (ATOM G166963) (PROGN (SETQ |a| (CAR G166963)) - NIL)) + nil)) (NREVERSE0 G166958)) (SEQ (EXIT (SETQ G166958 - (CONS (|atom2String| |a|) + (cons (|atom2String| |a|) G166958)))))))) - (SPADLET |m| + (setq |m| (PLUS 1 (PROG (G166969) - (SPADLET G166969 -999999) + (setq G166969 -999999) (RETURN (DO ((G166974 |l| (CDR G166974)) - (|a| NIL)) + (|a| nil)) ((OR (ATOM G166974) (PROGN (SETQ |a| (CAR G166974)) - NIL)) + nil)) G166969) (SEQ (EXIT (SETQ G166969 (MAX G166969 (SIZE |a|)))))))))) (COND ((> |m| $LINELENGTH) - (DO ((G166983 |l| (CDR G166983)) (|a| NIL)) + (DO ((G166983 |l| (CDR G166983)) (|a| nil)) ((OR (ATOM G166983) - (PROGN (SETQ |a| (CAR G166983)) NIL)) - NIL) + (PROGN (SETQ |a| (CAR G166983)) nil)) + nil) (SEQ (EXIT (|sayMSG| |a|)))) - NIL) - ('T (SPADLET |w| (MIN (PLUS |m| 3) $LINELENGTH)) - (SPADLET |p| (QUOTIENT $LINELENGTH |w|)) - (SPADLET |n| (|#| |l|)) (SPADLET |str| "") + nil) + ('T (setq |w| (MIN (PLUS |m| 3) $LINELENGTH)) + (setq |p| (QUOTIENT $LINELENGTH |w|)) + (setq |n| (|#| |l|)) (setq |str| "") (DO ((G166999 (SPADDIFFERENCE |n| 1)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| G166999) NIL) + ((QSGREATERP |i| G166999) nil) (SEQ (EXIT (PROGN - (SPADLET |LETTMP#1| |l|) - (SPADLET |c| (CAR |LETTMP#1|)) - (SPADLET |l| (CDR |LETTMP#1|)) - (SPADLET |str| + (setq |LETTMP#1| |l|) + (setq |c| (CAR |LETTMP#1|)) + (setq |l| (CDR |LETTMP#1|)) + (setq |str| (STRCONC |str| |c| (|fillerSpaces| (SPADDIFFERENCE |w| @@ -2032,14 +1756,14 @@ ((EQL (REMAINDER (PLUS |i| 1) |p|) 0) (PROGN (|sayMSG| |str|) - (SPADLET |str| "")))))))) + (setq |str| "")))))))) (COND ((NEQUAL |str| "") (|sayMSG| |str|))) - NIL))))))) + nil))))))) ;say2PerLine l == say2PerLineWidth(l,$LINELENGTH / 2) -(DEFUN |say2PerLine| (|l|) +(defun |say2PerLine| (|l|) (declare (special $LINELENGTH)) (|say2PerLineWidth| |l| (QUOTIENT $LINELENGTH 2))) @@ -2049,18 +1773,18 @@ ; for x in long repeat sayLongOperation x ; sayBrightly '"" -(DEFUN |say2PerLineWidth| (|l| |n|) +(defun |say2PerLineWidth| (|l| |n|) (PROG (|LETTMP#1| |short| |long|) (RETURN (SEQ (PROGN - (SPADLET |LETTMP#1| (|say2Split| |l| NIL NIL |n|)) - (SPADLET |short| (CAR |LETTMP#1|)) - (SPADLET |long| (CADR |LETTMP#1|)) + (setq |LETTMP#1| (|say2Split| |l| nil nil |n|)) + (setq |short| (CAR |LETTMP#1|)) + (setq |long| (CADR |LETTMP#1|)) (|say2PerLineThatFit| |short|) - (DO ((G167033 |long| (CDR G167033)) (|x| NIL)) + (DO ((G167033 |long| (CDR G167033)) (|x| nil)) ((OR (ATOM G167033) - (PROGN (SETQ |x| (CAR G167033)) NIL)) - NIL) + (PROGN (SETQ |x| (CAR G167033)) nil)) + nil) (SEQ (EXIT (|sayLongOperation| |x|)))) (|sayBrightly| "")))))) @@ -2070,20 +1794,20 @@ ; say2Split(l',short,[x,:long],width) ; [nreverse short,nreverse long] -(DEFUN |say2Split| (|l| |short| |long| |width|) +(defun |say2Split| (|l| |short| |long| |width|) (PROG (|x| |l'|) (RETURN (COND - ((AND (CONSP |l|) + ((AND (consp |l|) (PROGN - (SPADLET |x| (QCAR |l|)) - (SPADLET |l'| (QCDR |l|)) + (setq |x| (QCAR |l|)) + (setq |l'| (QCDR |l|)) 'T)) (COND ((> |width| (|sayWidth| |x|)) - (|say2Split| |l'| (CONS |x| |short|) |long| |width|)) - ('T (|say2Split| |l'| |short| (CONS |x| |long|) |width|)))) - ('T (CONS (NREVERSE |short|) (CONS (NREVERSE |long|) NIL))))))) + (|say2Split| |l'| (cons |x| |short|) |long| |width|)) + ('T (|say2Split| |l'| |short| (cons |x| |long|) |width|)))) + ('T (cons (NREVERSE |short|) (cons (NREVERSE |long|) nil))))))) ;sayLongOperation x == ; sayWidth x > $LINELENGTH and (splitListOn(x,"if") is [front,back]) => @@ -2092,21 +1816,21 @@ ; sayBrightly back ; sayBrightly x -(DEFUN |sayLongOperation| (|x|) +(defun |sayLongOperation| (|x|) (PROG (|ISTMP#1| |front| |ISTMP#2| |back|) (declare (special $LINELENGTH)) (RETURN (COND ((AND (> (|sayWidth| |x|) $LINELENGTH) (PROGN - (SPADLET |ISTMP#1| (|splitListOn| |x| '|if|)) - (AND (CONSP |ISTMP#1|) + (setq |ISTMP#1| (|splitListOn| |x| '|if|)) + (AND (consp |ISTMP#1|) (PROGN - (SPADLET |front| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (setq |front| (QCAR |ISTMP#1|)) + (setq |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (consp |ISTMP#2|) (EQ (QCDR |ISTMP#2|) nil) (PROGN - (SPADLET |back| (QCAR |ISTMP#2|)) + (setq |back| (QCAR |ISTMP#2|)) 'T)))))) (|sayBrightly| |front|) (BLANKS (PLUS 6 (|#| (PNAME (ELT |front| 1))))) @@ -2121,17 +1845,17 @@ ; [nreverse y,x] ; nil -(DEFUN |splitListOn| (|x| |key|) +(defun |splitListOn| (|x| |key|) (PROG (|y|) (RETURN (SEQ (COND ((|member| |key| |x|) - (DO () ((NULL (NEQUAL (CAR |x|) |key|)) NIL) + (DO () ((NULL (NEQUAL (CAR |x|) |key|)) nil) (SEQ (EXIT (PROGN - (SPADLET |y| (CONS (CAR |x|) |y|)) - (SPADLET |x| (CDR |x|)))))) - (CONS (NREVERSE |y|) (CONS |x| NIL))) - ('T NIL)))))) + (setq |y| (cons (CAR |x|) |y|)) + (setq |x| (CDR |x|)))))) + (cons (NREVERSE |y|) (cons |x| nil))) + ('T nil)))))) ;say2PerLineThatFit l == ; while l repeat @@ -2144,9 +1868,9 @@ ; sayBrightly '"" ; sayBrightly '"" -(DEFUN |say2PerLineThatFit| (|l|) +(defun |say2PerLineThatFit| (|l|) (declare (special $LINELENGTH)) - (SEQ (DO () ((NULL |l|) NIL) + (SEQ (DO () ((NULL |l|) nil) (SEQ (EXIT (PROGN (|sayBrightlyNT| (CAR |l|)) (|sayBrightlyNT| @@ -2155,9 +1879,9 @@ (|sayDisplayWidth| (CAR |l|))) " ")) (COND - ((SPADLET |l| (CDR |l|)) + ((setq |l| (CDR |l|)) (|sayBrightlyNT| (CAR |l|)) - (SPADLET |l| (CDR |l|)) + (setq |l| (CDR |l|)) (|sayBrightly| "")) ('T (|sayBrightly| ""))))))))) @@ -2165,11 +1889,11 @@ ; null x => 0 ; sayDisplayWidth x -(DEFUN |sayDisplayStringWidth| (|x|) +(defun |sayDisplayStringWidth| (|x|) (COND ((NULL |x|) 0) ('T (|sayDisplayWidth| |x|)))) ;sayDisplayWidth x == -; CONSP x => +; consp x => ; +/[fn y for y in x] where fn y == ; y in '(%b %d "%b" "%d") or y=$quadSymbol => 1 ; k := blankIndicator y => k @@ -2177,26 +1901,26 @@ ; x = "%%" or x = '"%%" => 1 ; # atom2String x -(DEFUN |sayDisplayWidth,fn| (|y|) +(defun |sayDisplayWidth,fn| (|y|) (PROG (|k|) (declare (special |$quadSymbol|)) (RETURN (SEQ (IF (BOOT-EQUAL |y| |$quadSymbol|) (EXIT 1)) - (IF (SPADLET |k| (|blankIndicator| |y|)) (EXIT |k|)) + (IF (setq |k| (|blankIndicator| |y|)) (EXIT |k|)) (EXIT (|sayDisplayWidth| |y|)))))) -(DEFUN |sayDisplayWidth| (|x|) +(defun |sayDisplayWidth| (|x|) (PROG () (RETURN (SEQ (COND - ((CONSP |x|) + ((consp |x|) (PROG (G167123) - (SPADLET G167123 0) + (setq G167123 0) (RETURN - (DO ((G167128 |x| (CDR G167128)) (|y| NIL)) + (DO ((G167128 |x| (CDR G167128)) (|y| nil)) ((OR (ATOM G167128) - (PROGN (SETQ |y| (CAR G167128)) NIL)) + (PROGN (SETQ |y| (CAR G167128)) nil)) G167123) (SEQ (EXIT (SETQ G167123 (PLUS G167123 @@ -2211,20 +1935,20 @@ ; +/[fn y for y in x] where fn y == ; sayWidth y -(DEFUN |sayWidth,fn| (|y|) (|sayWidth| |y|)) +(defun |sayWidth,fn| (|y|) (|sayWidth| |y|)) -(DEFUN |sayWidth| (|x|) +(defun |sayWidth| (|x|) (PROG () (RETURN (SEQ (COND ((ATOM |x|) (|#| (|atom2String| |x|))) ('T (PROG (G167143) - (SPADLET G167143 0) + (setq G167143 0) (RETURN - (DO ((G167148 |x| (CDR G167148)) (|y| NIL)) + (DO ((G167148 |x| (CDR G167148)) (|y| nil)) ((OR (ATOM G167148) - (PROGN (SETQ |y| (CAR G167148)) NIL)) + (PROGN (SETQ |y| (CAR G167148)) nil)) G167143) (SEQ (EXIT (SETQ G167143 (PLUS G167143 @@ -2241,38 +1965,38 @@ ; sayNewLine() ; nil -(DEFUN |pp2Cols| (|al|) +(defun |pp2Cols| (|al|) (PROG (|LETTMP#1| |abb| |name|) (declare (special $LINELENGTH)) (RETURN (SEQ (PROGN - (DO () ((NULL |al|) NIL) + (DO () ((NULL |al|) nil) (SEQ (EXIT (PROGN - (SPADLET |LETTMP#1| |al|) - (SPADLET |abb| (CAAR |LETTMP#1|)) - (SPADLET |name| (CDAR |LETTMP#1|)) - (SPADLET |al| (CDR |LETTMP#1|)) + (setq |LETTMP#1| |al|) + (setq |abb| (CAAR |LETTMP#1|)) + (setq |name| (CDAR |LETTMP#1|)) + (setq |al| (CDR |LETTMP#1|)) (|ppPair| |abb| |name|) (COND ((|canFit2ndEntry| |name| |al|) - (SPADLET |LETTMP#1| |al|) - (SPADLET |abb| (CAAR |LETTMP#1|)) - (SPADLET |name| (CDAR |LETTMP#1|)) - (SPADLET |al| (CDR |LETTMP#1|)) + (setq |LETTMP#1| |al|) + (setq |abb| (CAAR |LETTMP#1|)) + (setq |name| (CDAR |LETTMP#1|)) + (setq |al| (CDR |LETTMP#1|)) (TAB (QUOTIENT $LINELENGTH 2)) (|ppPair| |abb| |name|))) (|sayNewLine|))))) - NIL))))) + nil))))) ;ppPair(abb,name) == ; sayBrightlyNT [:bright abb,fillerSpaces(8-entryWidth abb," "),name] -(DEFUN |ppPair| (|abb| |name|) +(defun |ppPair| (|abb| |name|) (|sayBrightlyNT| (APPEND (|bright| |abb|) - (CONS (|fillerSpaces| - (SPADDIFFERENCE 8 (|entryWidth| |abb|)) '| |) - (CONS |name| NIL))))) + (cons (|fillerSpaces| + (- 8 (|#| (|atom2String| |abb|))) '| |) + (cons |name| nil))))) ;canFit2ndEntry(name,al) == ; wid := ($LINELENGTH/2) - 10 @@ -2281,80 +2005,18 @@ ; entryWidth CDAR al > wid => nil ; 'T -(DEFUN |canFit2ndEntry| (|name| |al|) +(defun |canFit2ndEntry| (|name| |al|) (PROG (|wid|) (declare (special $LINELENGTH)) (RETURN (PROGN - (SPADLET |wid| (SPADDIFFERENCE (QUOTIENT $LINELENGTH 2) 10)) + (setq |wid| (SPADDIFFERENCE (QUOTIENT $LINELENGTH 2) 10)) (COND - ((NULL |al|) NIL) - ((> (|entryWidth| |name|) |wid|) NIL) - ((> (|entryWidth| (CDAR |al|)) |wid|) NIL) + ((NULL |al|) nil) + ((> (|#| (|atom2String| |name|)) |wid|) nil) + ((> (|#| (|atom2String| (CDAR |al|))) |wid|) nil) ('T 'T)))))) -;entryWidth x == # atom2String x - -(DEFUN |entryWidth| (|x|) (|#| (|atom2String| |x|))) - -;center80 text == centerNoHighlight(text,$LINELENGTH,'" ") - -(DEFUN |center80| (|text|) - (declare (special $LINELENGTH)) - (|centerNoHighlight| |text| $LINELENGTH " ")) - -;centerAndHighlight(text,:argList) == -; width := IFCAR argList or $LINELENGTH -; fillchar := IFCAR IFCDR argList or '" " -; wid := entryWidth text + 2 -; wid >= width - 2 => sayBrightly ['%b,text,'%d] -; f := DIVIDE(width - wid - 2,2) -; fill1 := '"" -; for i in 1..(f.0) repeat -; fill1 := STRCONC(fillchar,fill1) -; if f.1 = 0 then fill2 := fill1 else fill2 := STRCONC(fillchar,fill1) -; sayBrightly [fill1,'%b,text,'%d,fill2] -; nil - -(DEFUN |centerAndHighlight| (&REST G167236 &AUX |argList| |text|) - (DSETQ (|text| . |argList|) G167236) - (PROG (|width| |fillchar| |wid| |f| |fill1| |fill2|) - (declare (special $LINELENGTH)) - (RETURN - (SEQ (PROGN - (SPADLET |width| (OR (IFCAR |argList|) $LINELENGTH)) - (SPADLET |fillchar| - (OR (IFCAR (IFCDR |argList|)) " ")) - (SPADLET |wid| (PLUS (|entryWidth| |text|) 2)) - (COND - ((>= |wid| (SPADDIFFERENCE |width| 2)) - (|sayBrightly| |text|)) - ('T - (SPADLET |f| - (DIVIDE (SPADDIFFERENCE - (SPADDIFFERENCE |width| |wid|) 2) - 2)) - (SPADLET |fill1| "") - (DO ((G167221 (ELT |f| 0)) (|i| 1 (QSADD1 |i|))) - ((QSGREATERP |i| G167221) NIL) - (SEQ (EXIT (SPADLET |fill1| - (STRCONC |fillchar| |fill1|))))) - (COND - ((EQL (ELT |f| 1) 0) (SPADLET |fill2| |fill1|)) - ('T (SPADLET |fill2| (STRCONC |fillchar| |fill1|)))) - (|sayBrightly| - (CONS |fill1| - (CONS '| | - (CONS |text| - (CONS '| | (CONS |fill2| NIL)))))) - NIL))))))) - -;centerNoHighlight(text,:argList) == sayBrightly center(text,argList) - -(DEFUN |centerNoHighlight| (&REST G167240 &AUX |argList| |text|) - (DSETQ (|text| . |argList|) G167240) - (|sayBrightly| (|center| |text| |argList|))) - ;center(text,argList) == ; width := IFCAR argList or $LINELENGTH ; fillchar := IFCAR IFCDR argList or '" " @@ -2368,205 +2030,83 @@ ; if f.1 = 0 then fill2 := fill1 else fill2 := STRCONC(fillchar,fill1) ; concat(fill1,text,fill2) -(DEFUN |center| (|text| |argList|) +(defun |center| (|text| |argList|) (PROG (|width| |fillchar| |u| |moreLines| |wid| |f| |fill1| |fill2|) (declare (special $LINELENGTH)) (RETURN (SEQ (PROGN - (SPADLET |width| (OR (IFCAR |argList|) $LINELENGTH)) - (SPADLET |fillchar| + (setq |width| (OR (IFCAR |argList|) $LINELENGTH)) + (setq |fillchar| (OR (IFCAR (IFCDR |argList|)) " ")) (COND - ((SPADLET |u| (|splitSayBrightlyArgument| |text|)) - (SPADLET |text| (CAR |u|)) - (SPADLET |moreLines| (CDR |u|)) |u|)) - (SPADLET |wid| (|sayBrightlyLength| |text|)) + ((setq |u| (splitSayBrightlyArgument |text|)) + (setq |text| (CAR |u|)) + (setq |moreLines| (CDR |u|)) |u|)) + (setq |wid| (|sayBrightlyLength| |text|)) (COND ((>= |wid| (SPADDIFFERENCE |width| 2)) (|sayBrightly| |text|)) ('T - (SPADLET |f| + (setq |f| (DIVIDE (SPADDIFFERENCE (SPADDIFFERENCE |width| |wid|) 2) 2)) - (SPADLET |fill1| "") + (setq |fill1| "") (DO ((G167248 (ELT |f| 0)) (|i| 1 (QSADD1 |i|))) - ((QSGREATERP |i| G167248) NIL) - (SEQ (EXIT (SPADLET |fill1| + ((QSGREATERP |i| G167248) nil) + (SEQ (EXIT (setq |fill1| (STRCONC |fillchar| |fill1|))))) (COND - ((EQL (ELT |f| 1) 0) (SPADLET |fill2| |fill1|)) - ('T (SPADLET |fill2| (STRCONC |fillchar| |fill1|)))) + ((EQL (ELT |f| 1) 0) (setq |fill2| |fill1|)) + ('T (setq |fill2| (STRCONC |fillchar| |fill1|)))) (|concat| |fill1| |text| |fill2|)))))))) -;splitSayBrightly u == -; width:= 0 -; while u and (width:= width + sayWidth first u) < $LINELENGTH repeat -; segment:= [first u,:segment] -; u := rest u -; null u => NREVERSE segment -; segment => [:NREVERSE segment,"%l",:splitSayBrightly(u)] -; u - -(DEFUN |splitSayBrightly| (|u|) - (PROG (|width| |segment|) - (declare (special $LINELENGTH)) - (RETURN - (SEQ (PROGN - (SPADLET |width| 0) - (DO () - ((NULL (AND |u| - (> $LINELENGTH - (SPADLET |width| - (PLUS |width| - (|sayWidth| (CAR |u|))))))) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |segment| - (CONS (CAR |u|) |segment|)) - (SPADLET |u| (CDR |u|)))))) - (COND - ((NULL |u|) (NREVERSE |segment|)) - (|segment| - (APPEND (NREVERSE |segment|) - (CONS '|%l| (|splitSayBrightly| |u|)))) - ('T |u|))))))) - ;splitSayBrightlyArgument u == ; atom u => nil ; while splitListSayBrightly u is [head,:u] repeat result:= [head,:result] ; result => [:NREVERSE result,u] ; [u] -(DEFUN |splitSayBrightlyArgument| (|u|) - (PROG (|ISTMP#1| |head| |result|) - (RETURN - (SEQ (COND - ((ATOM |u|) NIL) - ('T - (DO () - ((NULL (PROGN - (SPADLET |ISTMP#1| - (|splitListSayBrightly| |u|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SPADLET |head| (QCAR |ISTMP#1|)) - (SPADLET |u| (QCDR |ISTMP#1|)) - 'T)))) - NIL) - (SEQ (EXIT (SPADLET |result| (CONS |head| |result|))))) - (COND - (|result| (APPEND (NREVERSE |result|) (CONS |u| NIL))) - ('T (CONS |u| NIL))))))))) - -;splitListSayBrightly u == -; for x in tails u repeat -; y := rest x -; null y => nil -; first y = '%l => -; RPLACD(x,nil) -; ans:= [u,:rest y] -; ans - -(DEFUN |splitListSayBrightly| (|u|) - (PROG (|y| |ans|) - (RETURN - (SEQ (PROGN - (DO ((|x| |u| (CDR |x|))) ((ATOM |x|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |y| (CDR |x|)) - (COND - ((NULL |y|) NIL) - ((BOOT-EQUAL (CAR |y|) '|%l|) - (RPLACD |x| NIL) - (SPADLET |ans| (CONS |u| (CDR |y|))))))))) - |ans|))))) - -;--======================================================================= -;-- Utility Functions -;--======================================================================= -;$htSpecialChars := ['"_#", '"[", '"]", '"%", '"{", '"}", '"_\", -; '"$", '"&", '"^", '"__", '"_~"] - -(SPADLET |$htSpecialChars| - (CONS "#" - (CONS "[" - (CONS "]" - (CONS "%" - (CONS "{" - (CONS "}" - (CONS "\\" - (CONS "$" - (CONS "&" - (CONS "^" - (CONS "_" - (CONS "~" - NIL))))))))))))) - -;$htCharAlist := '( -; ("$" . "\%") -; ("[]" . "\[\]") -; ("{}" . "\{\}") -; ("\\" . "\\\\") -; ("\/" . "\\/" ) -; ("/\" . "/\\" ) ) - -(SPADLET |$htCharAlist| - '(("$" . "\\%") ("[]" . "\\[\\]") ("{}" . "\\{\\}") - ("\\\\" . "\\\\\\\\") ("\\/" . "\\\\/") ("/\\" . "/\\\\"))) - -;escapeSpecialChars s == -; u := LASSOC(s,$htCharAlist) => u -; member(s, $htSpecialChars) => STRCONC('"_\", s) -; null $saturn => s -; ALPHA_-CHAR_-P (s.0) => s -; not (or/[dbSpecialDisplayOpChar? s.i for i in 0..MAXINDEX s]) => s -; buf := '"" -; for i in 0..MAXINDEX s repeat buf := -; dbSpecialDisplayOpChar?(s.i) => STRCONC(buf,'"\verb!",s.i,'"!") -; STRCONC(buf,s.i) -; buf - -(DEFUN |escapeSpecialChars| (|s|) - (PROG (|u| |buf|) - (declare (special |$saturn| |$htSpecialChars| |$htCharAlist|)) - (RETURN - (SEQ (COND - ((SPADLET |u| (LASSOC |s| |$htCharAlist|)) |u|) - ((|member| |s| |$htSpecialChars|) - (STRCONC "\\" |s|)) - ((NULL |$saturn|) |s|) - ((ALPHA-CHAR-P (ELT |s| 0)) |s|) - ((NULL (PROG (G167323) - (SPADLET G167323 NIL) - (RETURN - (DO ((G167329 NIL G167323) - (G167330 (MAXINDEX |s|)) - (|i| 0 (QSADD1 |i|))) - ((OR G167329 (QSGREATERP |i| G167330)) - G167323) - (SEQ (EXIT (SETQ G167323 - (OR G167323 - (|dbSpecialDisplayOpChar?| - (ELT |s| |i|)))))))))) - |s|) - ('T (SPADLET |buf| "") - (DO ((G167338 (MAXINDEX |s|)) (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| G167338) NIL) - (SEQ (EXIT (SPADLET |buf| - (COND - ((|dbSpecialDisplayOpChar?| - (ELT |s| |i|)) - (STRCONC |buf| - "\\verb!" - (ELT |s| |i|) "!")) - ('T - (STRCONC |buf| (ELT |s| |i|)))))))) - |buf|)))))) - -;dbSpecialDisplayOpChar? c == (c = char '_~) - -(DEFUN |dbSpecialDisplayOpChar?| (|c|) (BOOT-EQUAL |c| (|char| '~))) +(defun splitSayBrightlyArgument (u) + (let (t1 head result) + (cond + ((atom u) nil) + (t + (do () + ((null + (progn + (setq t1 (splitListSayBrightly u)) + (and (consp t1) + (progn + (setq head (qcar t1)) + (setq u (qcdr t1)) + t)))) + nil) + (setq result (cons head result))) + (if result + (append (nreverse result) (cons u nil)) + (cons u nil)))))) + +(defun splitListSayBrightly (u) + (let (y ans) + (do ((x u (cdr x))) + ((atom x) nil) + (setq y (cdr x)) + (cond + ((null y) nil) + ((eq (car y) '|%l|) + (rplacd x nil) + (setq ans (cons u (cdr y)))))) + ans)) + +(defun |queryUserKeyedMsg| (key args) + "Display message and return reply" + (let (conStream ans) + (setq conStream (defiostream '((device . console) (mode . input)) 120 0)) + (|sayKeyedMsg| key args) + (setq ans (|read-line| conStream)) + (shut conStream) + ans)) \end{chunk} \eject diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet index c7136af..14898ea 100644 --- a/src/interp/util.lisp.pamphlet +++ b/src/interp/util.lisp.pamphlet @@ -266,8 +266,7 @@ After this function is called the image is clean and can be saved. NIL)) (COND ((NEQUAL $OLDLINE 'END_UNIT) - (|centerAndHighlight| $OLDLINE $LINELENGTH - " ") + (format t "~v:@<~a~>" $linelength $oldline) (|sayKeyedMsg| "is incorrect. Re-issue the command now to see the message." NIL)) -- 1.7.5.4