From b46e734e79d560940aa85ac371698534e4fbb986 Mon Sep 17 00:00:00 2001 From: Tim Daly Date: Fri, 27 Feb 2015 20:41:47 -0500 Subject: books/bookvol5 rewrite code into better form Some of the code is compiler generated. We rewrite it into more readable form. --- books/bookvol5.pamphlet | 643 ++++++++++++++++----------------------- changelog | 2 + patch | 5 +- src/axiom-website/patches.html | 4 +- 4 files changed, 273 insertions(+), 381 deletions(-) diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 581b271..6a796fd 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -26037,17 +26037,17 @@ in practice. \usesdollar{printSynonyms}{linelength} \begin{chunk}{defun printSynonyms} (defun |printSynonyms| (patterns) - (prog (ls t1) + (let (ls t1) (declare (special |$CommandSynonymAlist| $linelength)) - (|centerAndHighlight| '|System Command Synonyms| + (|centerAndHighlight| '|System Command Synonyms| $linelength (|specialChar| '|hbar|)) - (setq ls + (setq ls (|filterListOfStringsWithFn| patterns (do ((t2 (|synonymsForUserLevel| |$CommandSynonymAlist|) (cdr t2))) ((atom t2) (nreverse0 t1)) (push (cons (princ-to-string (caar t2)) (cdar t2)) t1)) #'car)) - (|printLabelledList| ls "user" "synonyms" ")" patterns))) + (|printLabelledList| ls "user" "synonyms" ")" patterns))) \end{chunk} @@ -52917,6 +52917,19 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \end{chunk} +\subsection{HTPAGE STRUCTURE} +This is a list with the fields +\begin{enumerate} +\item name +\item Domain Conditions +\item Domain Variable Alist +\item Domain Pvar Subst List +\item Radio Button Alist +\item Input Area Alist +\item Property List +\item Description +\end{enumerate} + \defun{htpName}{htpName} \begin{chunk}{defun htpName} (defun |htpName| (htPage) (elt htPage 0)) @@ -53006,7 +53019,8 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htpInputAreaAlist}{htpInputAreaAlist} \begin{chunk}{defun htpInputAreaAlist} -(defun |htpInputAreaAlist| (htPage) (elt htPage 5)) +(defun |htpInputAreaAlist| (htPage) + (elt htPage 5)) \end{chunk} @@ -53021,119 +53035,93 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \begin{chunk}{defun htpAddInputAreaProp} (defun |htpAddInputAreaProp| (htPage label prop) (setelt htPage 5 - (cons (cons label (cons nil (cons nil (cons nil prop)))) - (elt htPage 5)))) + (cons + (cons label (cons nil (cons nil (cons nil prop)))) + (elt htPage 5)))) \end{chunk} \defun{htpPropertyList}{htpPropertyList} \begin{chunk}{defun htpPropertyList} -(defun |htpPropertyList| (htPage) (elt htPage 6)) +(defun |htpPropertyList| (htPage) + (elt htPage 6)) \end{chunk} \defun{htpProperty}{htpProperty} \begin{chunk}{defun htpProperty} (defun |htpProperty| (htPage propName) - (LASSOC propName (elt htPage 6))) + (lassoc propName (elt htPage 6))) \end{chunk} \defun{htpSetProperty}{htpSetProperty} \begin{chunk}{defun htpSetProperty} (defun |htpSetProperty| (htPage propName val) - (prog (pair) - (return - (progn - (setq pair (|assoc| propName (elt htPage 6))) - (cond - (pair (rplacd pair val)) - (t - (setelt htPage 6 - (cons (cons propName val) (elt htPage 6))))))))) + (let (pair) + (setq pair (|assoc| propName (elt htPage 6))) + (cond + (pair (rplacd pair val)) + (t (setelt htPage 6 (cons (cons propName val) (elt htPage 6))))))) \end{chunk} \defun{htpLabelInputString}{htpLabelInputString} \begin{chunk}{defun htpLabelInputString} (defun |htpLabelInputString| (htPage label) - (prog (props s) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond - ((and props (stringp (setq s (elt props 0)))) - (cond - ((equal s "") s) - (t (|trimString| s)))) - (t nil)))))) + (let (props s) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when (and props (stringp (setq s (elt props 0)))) + (if (equal s "") s (|trimString| s))))) \end{chunk} \defun{htpLabelFilteredInputString}{htpLabelFilteredInputString} \begin{chunk}{defun htpLabelFilteredInputString} (defun |htpLabelFilteredInputString| (htPage label) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond - (props (cond - ((and (> (|#| props) 5) (elt props 6)) - (funcall (symbol-function (elt props 6)) - (elt props 0))) - (t (|replacePercentByDollar| (elt props 0))))) - (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props + (cond + ((and (> (|#| props) 5) (elt props 6)) + (funcall (symbol-function (elt props 6)) (elt props 0))) + (t (|replacePercentByDollar| (elt props 0))))))) \end{chunk} \defun{replacePercentByDollar,fn}{replacePercentByDollar,fn} \begin{chunk}{defun replacePercentByDollar,fn} (defun |replacePercentByDollar,fn| (s i n) - (prog (m) - (return - (SEQ (if (> i n) (EXIT "")) - (if (> (setq m (|charPosition| #\% s i)) - n) - (EXIT (SUBSTRING s i nil))) - (EXIT (STRCONC (SUBSTRING s i (- m i)) - "$" - (|replacePercentByDollar,fn| s (1+ m) - n))))))) + (let (m) + (cond + ((> i n) "") + ((> (setq m (|charPosition| #\% s i)) n) (substring s i nil)) + (t (strconc (substring s i (- m i)) "$" + (|replacePercentByDollar,fn| s (1+ m) n)))))) \end{chunk} \defun{replacePercentByDollar}{replacePercentByDollar} \begin{chunk}{defun replacePercentByDollar} (defun |replacePercentByDollar| (s) - (|replacePercentByDollar,fn| s 0 (maxindex s))) + (|replacePercentByDollar,fn| s 0 (maxindex s))) \end{chunk} \defun{htpSetLabelInputString}{htpSetLabelInputString} \begin{chunk}{defun htpSetLabelInputString} (defun |htpSetLabelInputString| (htPage label val) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond - (props (setelt props 0 (stringimage val))) - (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (setelt props 0 (stringimage val))))) \end{chunk} \defun{htpLabelSpadValue}{htpLabelSpadValue} \begin{chunk}{defun htpLabelSpadValue} (defun |htpLabelSpadValue| (htPage label) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond (props (elt props 1)) (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (elt props 1)))) \end{chunk} @@ -53149,84 +53137,68 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htpLabelErrorMsg}{htpLabelErrorMsg} \begin{chunk}{defun htpLabelErrorMsg} (defun |htpLabelErrorMsg| (htPage label) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond (props (elt props 2)) (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (elt props 2)))) \end{chunk} \defun{htpSetLabelErrorMsg}{htpSetLabelErrorMsg} \begin{chunk}{defun htpSetLabelErrorMsg} (defun |htpSetLabelErrorMsg| (htPage label val) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond (props (setelt props 2 val)) (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (setelt props 2 val)))) \end{chunk} \defun{htpLabelType}{htpLabelType} \begin{chunk}{defun htpLabelType} (defun |htpLabelType| (htPage label) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond (props (elt props 3)) (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (elt props 3)))) \end{chunk} \defun{htpLabelDefault}{htpLabelDefault} \begin{chunk}{defun htpLabelDefault} (defun |htpLabelDefault| (htPage label) - (prog (msg props) - (return + (let (msg props) + (cond + ((setq msg (|htpLabelInputString| htPage label)) (cond - ((setq msg (|htpLabelInputString| htPage label)) - (cond - ((equal msg "t") 1) - ((equal msg "nil") 0) - (t msg))) - (t - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond (props (elt props 4)) (t nil))))))) + ((equal msg "t") 1) + ((equal msg "nil") 0) + (t msg))) + (t + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (elt props 4)))))) \end{chunk} \defun{htpLabelSpadType}{htpLabelSpadType} \begin{chunk}{defun htpLabelSpadType} (defun |htpLabelSpadType| (htPage label) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond (props (elt props 5)) (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (elt props 5)))) \end{chunk} \defun{htpLabelFilter}{htpLabelFilter} \begin{chunk}{defun htpLabelFilter} (defun |htpLabelFilter| (htPage label) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond (props (elt props 6)) (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (elt props 6)))) \end{chunk} \defun{htpPageDescription}{htpPageDescription} \begin{chunk}{defun htpPageDescription} -(defun |htpPageDescription| (htPage) (elt htPage 7)) +(defun |htpPageDescription| (htPage) + (elt htPage 7)) \end{chunk} @@ -53241,7 +53213,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \begin{chunk}{defun htpAddToPageDescription} (defun |htpAddToPageDescription| (htPage pageDescrip) (setelt htPage 7 - (NCONC (NREVERSE (COPY-LIST pageDescrip)) (elt htPage 7)))) + (nconc (nreverse (copy-list pageDescrip)) (elt htPage 7)))) \end{chunk} @@ -53253,7 +53225,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (|$newPage| nil) ((consp line) (setq |$htLineList| - (NCONC (NREVERSE (|mapStringize| (COPY-LIST line))) + (nconc (nreverse (|mapStringize| (COPY-LIST line))) |$htLineList|))) (t (setq |$htLineList| @@ -53350,19 +53322,17 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htShowPageNoScroll}{show the page which has been computed} \begin{chunk}{defun htShowPageNoScroll} (defun |htShowPageNoScroll| () - (prog (line) - (declare (special |$htLineList| |$curPage| |$newPage|)) - (return - (progn - (|htSayStandard| "\\autobuttons") - (|htpSetPageDescription| |$curPage| - (NREVERSE (|htpPageDescription| |$curPage|))) - (setq |$newPage| nil) - (setq |$htLineList| nil) - (|htMakePage| (|htpPageDescription| |$curPage|)) - (setq line (apply #'CONCAT (NREVERSE |$htLineList|))) - (|issueHT| line) - (|endHTPage|))))) + (let (line) + (declare (special |$htLineList| |$curPage| |$newPage|)) + (|htSayStandard| "\\autobuttons") + (|htpSetPageDescription| |$curPage| + (nreverse (|htpPageDescription| |$curPage|))) + (setq |$newPage| nil) + (setq |$htLineList| nil) + (|htMakePage| (|htpPageDescription| |$curPage|)) + (setq line (apply #'concat (nreverse |$htLineList|))) + (|issueHT| line) + (|endHTPage|))) \end{chunk} @@ -53450,10 +53420,9 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htQuote}{htQuote} \begin{chunk}{defun htQuote} (defun |htQuote| (s) - (progn - (|iht| "\"") - (|iht| s) - (|iht| "\""))) + (|iht| "\"") + (|iht| s) + (|iht| "\"")) \end{chunk} @@ -53976,12 +53945,9 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htProcessDomainConditions}{htProcessDomainConditions} \begin{chunk}{defun htProcessDomainConditions} (defun |htProcessDomainConditions| (condList) - (declare (special |$curPage|)) - (progn - (|htpSetDomainConditions| |$curPage| - (|renamePatternVariables| condList)) - (|htpSetDomainVariableAlist| |$curPage| - (|computeDomainVariableAlist|)))) + (declare (special |$curPage|)) + (|htpSetDomainConditions| |$curPage| (|renamePatternVariables| condList)) + (|htpSetDomainVariableAlist| |$curPage| (|computeDomainVariableAlist|))) \end{chunk} @@ -54271,25 +54237,19 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htProcessDoneButton}{htProcessDoneButton} \begin{chunk}{defun htProcessDoneButton} -(defun |htProcessDoneButton| (G166950) - (prog (label func) - (return - (progn - (setq label (car G166950)) - (setq func (cadr G166950)) - (|iht| "\\newline\\vspace{1}\\centerline{") - (cond - ((equal label "Continue") - (|htMakeButton| "\\lispdownlink" - '|\\ContinueBitmap| func)) - ((equal label "Push to enter names") - (|htMakeButton| "\\lispdownlink" - "\\ControlBitmap{clicktoset}" func)) - (t - (|htMakeButton| "\\lispdownlink" - (CONCAT "\\box{" label "}") - func))) - (|iht| "} "))))) +(defun |htProcessDoneButton| (arg) + (let (label func) + (setq label (car arg)) + (setq func (cadr arg)) + (|iht| "\\newline\\vspace{1}\\centerline{") + (cond + ((equal label "Continue") + (|htMakeButton| "\\lispdownlink" '|\\ContinueBitmap| func)) + ((equal label "Push to enter names") + (|htMakeButton| "\\lispdownlink" "\\ControlBitmap{clicktoset}" func)) + (t + (|htMakeButton| "\\lispdownlink" (concat "\\box{" label "}") func))) + (|iht| "} "))) \end{chunk} @@ -54403,21 +54363,18 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htProcessDoitButton}{htProcessDoitButton} \begin{chunk}{defun htProcessDoitButton} -(defun |htProcessDoitButton| (G167017) - (prog (label command func fun) - (return - (progn - (setq label (car G167017)) - (setq command (cadr G167017)) - (setq func (caddr G167017)) - (setq fun (|mkCurryFun| func (cons command nil))) - (|iht| "\\newline\\vspace{1}\\centerline{") - (|htMakeButton| "\\lispcommand" - (CONCAT "\\box{" label "}") - fun) - (|iht| "} ") - (|iht| "\\vspace{2}{Select \\ \\UpButton{} \\ to go back one page.}") - (|iht| "\\newline{Select \\ \\ExitButton{QuitPage} \\ to remove this window.}"))))) +(defun |htProcessDoitButton| (arg) + (let (label command func fun) + (setq label (car arg)) + (setq command (cadr arg)) + (setq func (caddr arg)) + (setq fun (|mkCurryFun| func (cons command nil))) + (|iht| "\\newline\\vspace{1}\\centerline{") + (|htMakeButton| "\\lispcommand" (concat "\\box{" label "}") fun) + (|iht| "} ") + (|iht| "\\vspace{2}{Select \\ \\UpButton{} \\ to go back one page.}") + (|iht| + "\\newline{Select \\ \\ExitButton{QuitPage} \\ to remove this window.}"))) \end{chunk} @@ -54772,7 +54729,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{quoteString}{quoteString} \begin{chunk}{defun quoteString} (defun |quoteString| (string) - (CONCAT "\"" string "\"")) + (concat "\"" string "\"")) \end{chunk} @@ -54791,10 +54748,9 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htEscapeString}{htEscapeString} \begin{chunk}{defun htEscapeString} (defun |htEscapeString| (str) - (declare (special |$funnyBacks| |$funnyQuote|)) - (progn - (setq str (SUBSTITUTE |$funnyQuote| #\" str)) - (SUBSTITUTE |$funnyBacks| #\\ str))) + (declare (special |$funnyBacks| |$funnyQuote|)) + (setq str (substitute |$funnyQuote| #\" str)) + (substitute |$funnyBacks| #\\ str)) \end{chunk} @@ -54809,14 +54765,11 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htSetVars}{htSetVars} \begin{chunk}{defun htSetVars} (defun |htSetVars| () - (declare (special |$setOptions| |$lastTree| |$path|)) - (progn - (setq |$path| nil) - (setq |$lastTree| nil) - (cond - ((NEQUAL 0 (LASTATOM |$setOptions|)) - (|htMarkTree| |$setOptions| 0))) - (|htShowSetTree| |$setOptions|))) + (declare (special |$setOptions| |$lastTree| |$path|)) + (setq |$path| nil) + (setq |$lastTree| nil) + (when (nequal 0 (lastatom |$setOptions|)) (|htMarkTree| |$setOptions| 0)) + (|htShowSetTree| |$setOptions|)) \end{chunk} @@ -54947,74 +54900,57 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htShowSetTreeValue}{htShowSetTreeValue} \begin{chunk}{defun htShowSetTreeValue} (defun |htShowSetTreeValue| (setData) - (prog (st) - (return - (progn - (setq st (elt setData 3)) - (cond - ((eq st 'function) - (|object2String| (FUNCALL (elt setData 4) '|%display%|))) - ((eq st 'integer) - (|object2String| (|eval| (elt setData 4)))) - ((eq st 'string) - (|object2String| (|eval| (elt setData 4)))) - ((eq st 'literals) - (|object2String| - (|translateTrueFalse2YesNo| (|eval| (elt setData 4))))) - ((eq st 'tree) "...") - (t (|systemError|))))))) + (let (st) + (setq st (elt setData 3)) + (cond + ((eq st 'function) + (|object2String| (funcall (elt setData 4) '|%display%|))) + ((eq st 'integer) + (|object2String| (|eval| (elt setData 4)))) + ((eq st 'string) + (|object2String| (|eval| (elt setData 4)))) + ((eq st 'literals) + (|object2String| (|translateTrueFalse2YesNo| (|eval| (elt setData 4))))) + ((eq st 'tree) "...") + (t (|systemError|))))) \end{chunk} \defun{mkSetTitle}{mkSetTitle} \begin{chunk}{defun mkSetTitle} (defun |mkSetTitle| () - (declare (special |$path|)) - (STRCONC "Command {\\em )set " - (|listOfStrings2String| |$path|) "}")) + (declare (special |$path|)) + (strconc "Command {\\em )set " (|listOfStrings2String| |$path|) "}")) \end{chunk} \defun{listOfStrings2String}{listOfStrings2String} \begin{chunk}{defun listOfStrings2String} (defun |listOfStrings2String| (u) - (cond - ((null u) "") - (t - (STRCONC (|listOfStrings2String| (cdr u)) " " - (|stringize| (car u)))))) + (cond + ((null u) "") + (t (strconc (|listOfStrings2String| (cdr u)) " " (|stringize| (car u)))))) \end{chunk} \defun{htShowSetPage}{htShowSetPage} \begin{chunk}{defun htShowSetPage} (defun |htShowSetPage| (htPage branch) - (prog (setTree setData st) - (declare (special |$path|)) - (return - (progn - (setq setTree (|htpProperty| htPage '|setTree|)) - (setq |$path| - (cons branch - (TAKE (- (LASTATOM setTree)) - |$path|))) - (setq setData (|assoc| branch setTree)) - (cond - ((null setData) (|systemError| "No Set Data")) - (t (setq st (elt setData 3)) - (cond - ((eq st 'function) - (|htShowFunctionPage| htPage setData)) - ((eq st 'integer) - (|htShowIntegerPage| htPage setData)) - ((eq st 'literals) - (|htShowLiteralsPage| htPage setData)) - ((eq st 'tree) - (|htShowSetTree| (elt setData 5))) - ((eq st 'string) - (|htSetNotAvailable| htPage - ")set compiler")) - (t (|systemError| "Unknown data type"))))))))) + (let (setTree setData st) + (declare (special |$path|)) + (setq setTree (|htpProperty| htPage '|setTree|)) + (setq |$path| (cons branch (take (- (lastatom setTree)) |$path|))) + (setq setData (|assoc| branch setTree)) + (cond + ((null setData) (|systemError| "No Set Data")) + (t (setq st (elt setData 3)) + (cond + ((eq st 'function) (|htShowFunctionPage| htPage setData)) + ((eq st 'integer) (|htShowIntegerPage| htPage setData)) + ((eq st 'literals) (|htShowLiteralsPage| htPage setData)) + ((eq st 'tree) (|htShowSetTree| (elt setData 5))) + ((eq st 'string) (|htSetNotAvailable| htPage ")set compiler")) + (t (|systemError| "Unknown data type"))))))) \end{chunk} @@ -55078,11 +55014,9 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htSetLiteral}{htSetLiteral} \begin{chunk}{defun htSetLiteral} (defun |htSetLiteral| (htPage val) - (progn - (|htInitPage| "Set Command" nil) - (set (|htpProperty| htPage '|variable|) - (|translateYesNo2TrueFalse| val)) - (|htKill| htPage val))) + (|htInitPage| "Set Command" nil) + (set (|htpProperty| htPage '|variable|) (|translateYesNo2TrueFalse| val)) + (|htKill| htPage val)) \end{chunk} @@ -55097,14 +55031,9 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (|htInitPage| (|mkSetTitle|) (|htpPropertyList| htPage))) (|htpSetProperty| page '|variable| (elt setData 4)) - (|bcHt| (cons "\\centerline{Set {\\em " - (cons (elt setData 0) - (cons "}}\\newline" nil)))) + (|bcHt| (list "\\centerline{Set {\\em " (elt setData 0) "}}\\newline")) (setq message (elt setData 1)) - (|bcHt| (cons "{\\em Description: } " - (cons message - (cons "\\newline\\vspace{1} " - nil)))) + (|bcHt| (list "{\\em Description: } " message "\\newline\\vspace{1} ")) (setq t1 (elt setData 5)) (setq |$htInitial| (car t1)) (setq |$htFinal| (cadr t1)) @@ -55127,13 +55056,9 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (|htMakePage| (cons '(|domainConditions| (|Satisfies| S chkRange)) (cons (cons '|bcStrings| - (cons (cons 5 - (cons (|eval| (elt setData 4)) - (cons '|value| (cons 'S nil)))) - nil)) + (list (list 5 (|eval| (elt setData 4)) '|value| 'S))) nil))) - (|htSetvarDoneButton| "Select to Set Value" - '|htSetInteger|) + (|htSetvarDoneButton| "Select to Set Value" '|htSetInteger|) (|htShowPage|))))) \end{chunk} @@ -55262,51 +55187,33 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htSetFunCommand}{htSetFunCommand} \begin{chunk}{defun htSetFunCommand} (defun |htSetFunCommand| (htPage) - (prog (variable checker value) - (return - (progn - (setq variable (|htpProperty| htPage '|variable|)) - (setq checker (|htpProperty| htPage '|checker|)) - (setq value - (|htCheck| checker - (|htpLabelInputString| htPage '|value|))) - (set variable value) - (|htSetFunCommandContinue| htPage value))))) + (let (variable checker value) + (setq variable (|htpProperty| htPage '|variable|)) + (setq checker (|htpProperty| htPage '|checker|)) + (setq value (|htCheck| checker (|htpLabelInputString| htPage '|value|))) + (set variable value) + (|htSetFunCommandContinue| htPage value))) \end{chunk} \defun{htSetFunCommandContinue}{htSetFunCommandContinue} \begin{chunk}{defun htSetFunCommandContinue} (defun |htSetFunCommandContinue| (htPage value) - (prog (parts t2 t3 predicate restParts continue) - (return - (progn - (setq parts (|htpProperty| htPage '|parts|)) - (setq continue - (cond - ((null parts) nil) - ((and (consp parts) - (progn - (setq t2 (QCAR parts)) - (and (consp t2) - (eq (QCAR t2) '|break|) - (progn - (setq t3 (QCDR t2)) - (AND (consp t3) - (eq (QCDR t3) nil) - (progn - (setq predicate - (QCAR t3)) - t))))) - (progn - (setq restParts (QCDR parts)) - t)) - (|eval| predicate)) - (t t))) - (cond - (continue (|htpSetProperty| htPage '|parts| restParts) - (|htShowFunctionPageContinued| htPage)) - (t (|htKill| htPage value))))))) + (let (parts continue) + (setq parts (|htpProperty| htPage '|parts|)) + (setq continue + (cond + ((null parts) nil) + ((and (consp parts) + (consp (qcar parts)) (eq (qcaar parts) '|break|) + (consp (qcdar parts)) (eq (qcddar parts) nil)) + (|eval| (qcadar parts))) + (t t))) + (cond + (continue + (|htpSetProperty| htPage '|parts| (qcdr parts)) + (|htShowFunctionPageContinued| htPage)) + (t (|htKill| htPage value))))) \end{chunk} @@ -55598,20 +55505,13 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htSetHistory}{htSetHistory} \begin{chunk}{defun htSetHistory} (defun |htSetHistory| (htPage) - (prog (msg data) - (return - (progn - (setq msg + (let (msg data) + (setq msg '|when the history facility is on (yes), results of computations are saved in memory|) - (setq data - (cons '|history| - (cons msg - (cons '|history| - (cons 'literals - (cons '|$HiFiAccess| - (cons '(|on| |off| |yes| |no|) - nil))))))) - (|htShowLiteralsPage| htPage data))))) + (setq data + (list '|history| msg '|history| 'literals '|$HiFiAccess| + '(|on| |off| |yes| |no|))) + (|htShowLiteralsPage| htPage data))) \end{chunk} @@ -55652,34 +55552,33 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htSetCache}{htSetCache} \begin{chunk}{defun htSetCache} -(defun |htSetCache| (&REST G167749 &AUX options htPage) - (declare (special |$valueList| |$path|)) - (setq htPage (car G167749)) - (setq options (cdr G167749)) - (progn - (setq |$path| '(|functions| |cache|)) - (setq htPage (|htInitPage| (|mkSetTitle|) nil)) - (setq |$valueList| nil) - (|htMakePage| - '((|text| - "Use this system command to cause the AXIOM interpreter to `remember' " - "past values of interpreter functions. " - "To remember a past value of a function, the interpreter " - "sets up a {\\em cache} for that function based on argument values. " - "When a value is cached for a given argument value, its value is gotten " - "from the cache and not recomputed. Caching can often save much " - "computing time, particularly with recursive functions or functions that " - "are expensive to compute and that are called repeatedly " - "with the same argument." "\\vspace{1}\\newline ") - (|domainConditions| (|Satisfies| S chkNameList)) - (|text| +(defun |htSetCache| (&REST arg &AUX options htPage) + (declare (special |$valueList| |$path|)) + (setq htPage (car arg)) + (setq options (cdr arg)) + (setq |$path| '(|functions| |cache|)) + (setq htPage (|htInitPage| (|mkSetTitle|) nil)) + (setq |$valueList| nil) + (|htMakePage| + '((|text| + "Use this system command to cause the AXIOM interpreter to `remember' " + "past values of interpreter functions. " + "To remember a past value of a function, the interpreter " + "sets up a {\\em cache} for that function based on argument values. " + "When a value is cached for a given argument value, its value is gotten " + "from the cache and not recomputed. Caching can often save much " + "computing time, particularly with recursive functions or functions that " + "are expensive to compute and that are called repeatedly " + "with the same argument." "\\vspace{1}\\newline ") + (|domainConditions| (|Satisfies| S chkNameList)) + (|text| "Enter below a list of interpreter functions you would like specially cached. " - "Use the name {\\em all} to give a default setting for all " - "interpreter functions. " "\\vspace{1}\\newline " - "Enter {\\em all} or a list of names (separate names by blanks):") - (|inputStrings| ("" "" 60 "all" names S)) - (|doneButton| "Push to enter names" |htCacheAddChoice|))) - (|htShowPage|))) + "Use the name {\\em all} to give a default setting for all " + "interpreter functions. " "\\vspace{1}\\newline " + "Enter {\\em all} or a list of names (separate names by blanks):") + (|inputStrings| ("" "" 60 "all" names S)) + (|doneButton| "Push to enter names" |htCacheAddChoice|))) + (|htShowPage|)) \end{chunk} @@ -55913,24 +55812,21 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htSystemVariables,gn}{htSystemVariables,gn} \begin{chunk}{defun htSystemVariables,gn} (defun |htSystemVariables,gn| (t1 al) - (prog (class key options) - (declare (special |$heading| |$levels|)) - (return - (SEQ (progn - (setq class (caddr t1)) - (setq key (cadddr t1)) - (setq options (cadr (cddddr t1))) - t1) - (if (null (member class |$levels|)) (EXIT al)) - (if (or (or (eq key 'literals) - (eq key 'integer)) - (eq key 'string)) - (EXIT (cons (cons |$heading| t1) al))) - (if (eq key 'tree) - (EXIT (|htSystemVariables,fn| options al nil))) - (if (eq key 'function) - (EXIT (cons (cons |$heading| t1) al))) - (EXIT (|systemError| key)))))) + (let (class key options) + (declare (special |$heading| |$levels|)) + (setq class (caddr t1)) + (setq key (cadddr t1)) + (setq options (cadr (cddddr t1))) + (cond + ((null (member class |$levels|)) al) + ((or (or (eq key 'literals) (eq key 'integer)) + (eq key 'string)) + (cons (cons |$heading| t1) al)) + ((eq key 'tree) + (|htSystemVariables,fn| options al nil)) + ((eq key 'function) + (cons (cons |$heading| t1) al)) + (t (|systemError| key))))) \end{chunk} @@ -55976,13 +55872,8 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| '((|domainConditions| (|isDomain| INT (|Integer|))))) (EXIT (|htMakePage| - (cons (cons '|bcStrings| - (cons - (cons 5 - (cons (STRINGIMAGE val) - (cons name (cons 'INT nil)))) - nil)) - nil)))))) + (list + (cons '|bcStrings| (list (list 5 (stringimage val) name 'int))))))))) (if (eq class 'string) (EXIT (|htSay| "{\\em " val "}\\space{1}"))) @@ -56157,38 +56048,32 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htSetSystemVariableKind}{htSetSystemVariableKind} \begin{chunk}{defun htSetSystemVariableKind} -(defun |htSetSystemVariableKind| (htPage G168009) - (prog (variable name fun value) - (return - (progn - (setq variable (car G168009)) - (setq name (cadr G168009)) - (setq fun (caddr G168009)) - (setq value (|htpLabelInputString| htPage name)) - (cond - ((and (stringp value) fun) - (setq value (funcall fun value)))) - (set variable value) - (|htSystemVariables|))))) +(defun |htSetSystemVariableKind| (htPage arg) + (let (variable name fun value) + (setq variable (car arg)) + (setq name (cadr arg)) + (setq fun (caddr arg)) + (setq value (|htpLabelInputString| htPage name)) + (when (and (stringp value) fun) (setq value (funcall fun value))) + (set variable value) + (|htSystemVariables|))) \end{chunk} \defun{htSetSystemVariable}{htSetSystemVariable} \begin{chunk}{defun htSetSystemVariable} -(defun |htSetSystemVariable| (htPage G168030) - (declare (ignore htPage)) - (prog (name value) - (return - (progn - (setq name (car G168030)) - (setq value (cadr G168030)) - (setq value - (cond - ((eq value '|on|) t) - ((eq value '|off|) nil) - (t value))) - (set name value) - (|htSystemVariables|))))) +(defun |htSetSystemVariable| (htPage arg) + (declare (ignore htPage)) + (let (name value) + (setq name (car arg)) + (setq value (cadr arg)) + (setq value + (cond + ((eq value '|on|) t) + ((eq value '|off|) nil) + (t value))) + (set name value) + (|htSystemVariables|))) \end{chunk} diff --git a/changelog b/changelog index c4f8c0e..d0f2609 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20150227 tpd src/axiom-website/patches.html 20150227.02.tpd.patch +20150227 tpd books/bookvol5 rewrite code into better form 20150227 tpd src/axiom-website/patches.html 20150227.01.tpd.patch 20150227 tpd books/bookvol5 fix syntax errors 20150217 tpd src/axiom-website/patches.html 20150217.01.tpd.patch diff --git a/patch b/patch index 034fa53..344a313 100644 --- a/patch +++ b/patch @@ -1,2 +1,5 @@ -books/bookvol5 fix syntax errors +books/bookvol5 rewrite code into better form + +Some of the code is compiler generated. +We rewrite it into more readable form. diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d99d6e9..e909b4d 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -4993,7 +4993,9 @@ Dockerfile fix bug 7299: update docker image to include gcc
20150217.01.tpd.patch books/bookvolbib Add Abra99 reference and paper to collection
20150227.01.tpd.patch -books/bookvol5 fix syntax errors +books/bookvol5 fix syntax errors
+20150227.02.tpd.patch +books/bookvol5 rewrite code into better form
-- 1.7.5.4