diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index a125289..022a512 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -19700,6 +19700,27 @@ deleting entries from u assumes that the first element is useless \end{chunk} +\defun{removeBackslashes}{removeBackslashes} +\calls{removeBackslashes}{charPosition} +\calls{removeBackslashes}{removeBackslashes} +\calls{removeBackslashes}{strconc} +\calls{removeBackslashes}{length} +\refsdollar{removeBackslashes}{charBack} +\begin{chunk}{defun removeBackslashes} +(defun |removeBackslashes| (s) + (let (k) + (declare (special |$charBack|)) + (cond + ((string= s "") "") + ((> (|#| s) (setq k (|charPosition| |$charBack| s 0))) + (if (eql k 0) + (|removeBackslashes| (substring s 1 nil)) + (strconc (substring s 0 k) + (|removeBackslashes| (substring s (1+ k) nil))))) + (t s)))) + +\end{chunk} + \defun{checkTexht}{checkTexht} \calls{checkTexht}{ifcar} \calls{checkTexht}{checkDocError} @@ -20513,6 +20534,758 @@ This returns a line beginning with right brace \end{chunk} +\defun{checkSplitBrace}{checkSplitBrace} +\calls{checkSplitBrace}{charp} +\calls{checkSplitBrace}{length} +\calls{checkSplitBrace}{checkSplitBackslash} +\calls{checkSplitBrace}{checkSplitBrace} +\calls{checkSplitBrace}{checkSplitOn} +\calls{checkSplitBrace}{checkSplitPunctuation} +\begin{chunk}{defun checkSplitBrace} +(defun |checkSplitBrace| (x) + (let (m u) + (cond + ((charp x) (list x)) + ((eql (|#| x) 1) (list (elt x 0))) + ((and (setq u (|checkSplitBackslash| x)) (cdr u)) + (let (result) + (loop for y in u do (append result (|checkSplitBrace| y))) + result)) + (t + (setq m (maxindex x)) + (cond + ((and (setq u (|checkSplitOn| x)) (cdr u)) + (let (result) + (loop for y in u do (append result (|checkSplitBrace| y))) + result)) + ((and (setq u (|checkSplitPunctuation| x)) (cdr u)) + (let (result) + (loop for y in u do (append result (|checkSplitBrace| y))) + result)) + (t (list x))))))) + +\end{chunk} + +\defun{checkSplitBackslash}{checkSplitBackslash} +\calls{checkSplitBackslash}{checkSplitBackslash} +\calls{checkSplitBackslash}{maxindex} +\calls{checkSplitBackslash}{charPosition} +\refsdollar{checkSplitBackslash}{charBack} +\begin{chunk}{defun checkSplitBackslash} +(defun |checkSplitBackslash| (x) + (let (m k u v) + (declare (special |$charBack|)) + (cond + ((null (stringp x)) (list x)) + (t + (setq m (maxindex x)) + (cond + ((> m (setq k (|charPosition| |$charBack| x 0))) + (cond + ((or (eql m 1) (alpha-char-p (elt x (1+ k)))) ;starts with backslash so + (if (> m (setq k (|charPosition| |$charBack| x 1))) + ; yes, another backslash + (cons (substring x 0 k) (|checkSplitBackslash| (substring x k nil))) + ; no, just return the line + (list x))) + ((eql k 0) + ; starts with backspace but x.1 is not a letter; break it up + (cons (substring x 0 2) + (|checkSplitBackslash| (substring x 2 nil)))) + (t + (setq u (substring x 0 k)) + (setq v (substring x k 2)) + (if (= (1+ k) m) + (list u v) + (cons u + (cons v + (|checkSplitBackslash| + (substring x (+ k 2) nil)))))))) + (t (list x))))))) + +\end{chunk} + +\defun{checkSplitPunctuation}{checkSplitPunctuation} +\calls{checkSplitPunctuation}{charp} +\calls{checkSplitPunctuation}{maxindex} +\calls{checkSplitPunctuation}{checkSplitPunctuation} +\calls{checkSplitPunctuation}{charPosition} +\calls{checkSplitPunctuation}{hget} +\refsdollar{checkSplitPunctuation}{charDash} +\refsdollar{checkSplitPunctuation}{htMacroTable} +\refsdollar{checkSplitPunctuation}{charQuote} +\refsdollar{checkSplitPunctuation}{charPeriod} +\refsdollar{checkSplitPunctuation}{charSemiColon} +\refsdollar{checkSplitPunctuation}{charComma} +\refsdollar{checkSplitPunctuation}{charBack} +\begin{chunk}{defun checkSplitPunctuation} +(defun |checkSplitPunctuation| (x) + (let (m lastchar v k u) + (declare (special |$charDash| |$htMacroTable| |$charBack| |$charQuote| + |$charComma| |$charSemiColon| |$charPeriod|)) + (cond + ((charp x) (list x)) + (t + (setq m (maxindex x)) + (cond + ((> 1 m) (list x)) + (t + (setq lastchar (elt x m)) + (cond + ((and (equal lastchar |$charPeriod|) + (equal (elt x (1- m)) |$charPeriod|)) + (cond + ((eql m 1) (list x)) + ((and (> m 3) (equal (elt x (- m 2)) |$charPeriod|)) + (append (|checkSplitPunctuation| (substring x 0 (- m 2))) + (list "..."))) + (t + (append (|checkSplitPunctuation| (substring x 0 (1- m))) + (list ".."))))) + ((or (equal lastchar |$charPeriod|) + (equal lastchar |$charSemiColon|) + (equal lastchar |$charComma|)) + (list (substring x 0 m) lastchar)) + ((and (> m 1) (equal (elt x (1- m)) |$charQuote|)) + (list (substring x 0 (1- m)) (substring x (1- m) nil))) + ((> m (setq k (|charPosition| |$charBack| x 0))) + (cond + ((eql k 0) + (cond + ((or (eql m 1) (hget |$htMacroTable| x) (alpha-char-p (elt x 1))) + (list x)) + (t + (setq v (substring x 2 nil)) + (cons (substring x 0 2) (|checkSplitPunctuation| v))))) + (t + (setq u (substring x 0 k)) + (setq v (substring x k nil)) + (append (|checkSplitPunctuation| u) + (|checkSplitPunctuation| v))))) + ((> m (setq k (|charPosition| |$charDash| x 1))) + (setq u (substring x (1+ k) nil)) + (cons (substring x 0 k) + (cons |$charDash| (|checkSplitPunctuation| u)))) + (t + (list x))))))))) + +\end{chunk} + +\defun{checkSplitOn}{checkSplitOn} +\calls{checkSplitOn}{checkSplitOn} +\calls{checkSplitOn}{charp} +\calls{checkSplitOn}{maxindex} +\calls{checkSplitOn}{charPosition} +\refsdollar{checkSplitOn}{charBack} +\refsdollar{checkSplitOn}{charSplitList} +\begin{chunk}{defun checkSplitOn} +(defun |checkSplitOn| (x) + (let (m char k z) + (declare (special |$charBack| |$charSplitList|)) + (cond + ((charp x) (list x)) + (t + (setq z |$charSplitList|) + (setq m (maxindex x)) + (loop while z + do + (setq char (car z)) + (cond + ((and (eql m 0) (equal (elt x 0) char)) + (return (setq k -1))) + (t + (setq k (|charPosition| char x 0)) + (cond + ((and (> k 0) (equal (elt x (1- k)) |$charBack|)) (list x)) + ((<= k m) (return k))))) + (pop z)) + (cond + ((null z) (list x)) + ((eql k -1) (list char)) + ((eql k 0) (list char (substring x 1 nil))) + ((eql k (maxindex x)) (list (substring x 0 k) char)) + (t + (cons (substring x 0 k) + (cons char (|checkSplitOn| (substring x (1+ k) nil)))))))))) + +\end{chunk} + +\defun{checkNumOfArgs}{checkNumOfArgs} +A nil return implies that the argument list length does not match +\calls{checkNumOfArgs}{opOf} +\calls{checkNumOfArgs}{constructor?} +\calls{checkNumOfArgs}{abbreviation?} +\calls{checkNumOfArgs}{getdatabase} +\begin{chunk}{defun checkNumOfArgs} +(defun |checkNumOfArgs| (conform) + (let (conname) + (setq conname (|opOf| conform)) + (when (or (|constructor?| conname) (setq conname (|abbreviation?| conname))) + (|#| (getdatabase conname 'constructorargs))))) + +\end{chunk} + +\defun{checkRemoveComments}{checkRemoveComments} +\calls{checkRemoveComments}{checkTrimCommented} +\begin{chunk}{defun checkRemoveComments} +(defun |checkRemoveComments| (lines) + (let (line acc) + (loop while lines + do + (setq line (|checkTrimCommented| (car lines))) + (when (>= (|firstNonBlankPosition| line) 0) (push line acc)) + (pop lines)) + (nreverse acc))) + +\end{chunk} + +\defun{checkTrimCommented}{checkTrimCommented} +\calls{checkTrimCommented}{length} +\calls{checkTrimCommented}{htcharPosition} +\calls{checkTrimCommented}{nequal} +\begin{chunk}{defun checkTrimCommented} +(defun |checkTrimCommented| (line) + (let (n k) + (setq n (|#| line)) + (setq k (|htcharPosition| (|char| '%) line 0)) + (cond + ((eql k 0) "") + ((or (>= k (1- n)) (nequal (elt line (1+ k)) #\%)) line) + ((> (|#| line) k) (substring line 0 k)) + (t line)))) + +\end{chunk} + +\defun{htcharPosition}{htcharPosition} +\calls{htcharPosition}{length} +\calls{htcharPosition}{charPosition} +\calls{htcharPosition}{nequal} +\calls{htcharPosition}{htcharPosition} +\refsdollar{htcharPosition}{charBack} +\begin{chunk}{defun htcharPosition} +(defun |htcharPosition| (char line i) + (let (m k) + (declare (special |$charBack|)) + (setq m (|#| line)) + (setq k (|charPosition| char line i)) + (cond + ((eql k m) k) + ((> k 0) + (if (nequal (elt line (1- k)) |$charBack|) + k + (|htcharPosition| char line (1+ k)))) + (t 0)))) + +\end{chunk} + +\defun{checkAddMacros}{checkAddMacros} +\calls{checkAddMacros}{lassoc} +\calls{checkAddMacros}{nreverse} +\refsdollar{checkAddMacros}{HTmacs} +\begin{chunk}{defun checkAddMacros} +(defun |checkAddMacros| (u) + (let (x verbatim y acc) + (declare (special |$HTmacs|)) + (loop while u + do + (setq x (car u)) + (setq acc + (cond + ((string= x "\\end{verbatim}") + (setq verbatim nil) + (cons x acc)) + (verbatim + (cons x acc)) + ((string= x "\\begin{verbatim}") + (setq verbatim t) + (cons x acc)) + ((setq y (lassoc x |$HTmacs|)) + (append y acc)) + (t (cons x acc)))) + (pop u)) + (nreverse acc))) + +\end{chunk} + +\defun{checkIndentedLines}{checkIndentedLines} +\calls{checkIndentedLines}{firstNonBlankPosition} +\calls{checkIndentedLines}{strconc} +\refsdollar{checkIndentedLines}{charFauxNewline} +\begin{chunk}{defun checkIndentedLines} +(defun |checkIndentedLines| (u margin) + (let (k s verbatim u2) + (declare (special |$charFauxNewline|)) + (loop for x in u + do + (setq k (|firstNonBlankPosition| x)) + (cond + ((eql k -1) + (if verbatim + (setq u2 (append u2 (list |$charFauxNewline|))) + (setq u2 (append u2 (list "\\blankline "))))) + (t + (setq s (substring x k nil)) + (cond + ((string= s "\\begin{verbatim}") + (setq verbatim t) + (setq u2 (append u2 (list s)))) + ((string= s "\\end{verbatim}") + (setq verbatim nil) + (setq u2 (append u2 (list s)))) + (verbatim + (setq u2 (append u2 (list (substring x margin nil))))) + ((eql margin k) + (setq u2 (append u2 (list s)))) + (t + (setq u2 + (append u2 + (list (strconc "\\indented{" (stringimage (- k margin)) + "}{" (|checkAddSpaceSegments| s 0) "}"))))))))) + u2)) + +\end{chunk} + +\defun{newString2Words}{newString2Words} +\calls{newString2Words}{newWordFrom} +\calls{newString2Words}{nreverse0} +\begin{chunk}{defun newString2Words} +(defun |newString2Words| (z) + (let (m tmp1 w i result) + (cond + ((null (stringp z)) (list z)) + (t + (setq m (maxindex z)) + (cond + ((eql m -1) nil) + (t + (setq i 0) + (do () ; [w while newWordFrom(l,i,m) is [w,i]] + ((null (progn + (setq tmp1 (|newWordFrom| z i m)) + (and (consp tmp1) + (progn + (setq w (qcar tmp1)) + (and (consp (qcdr tmp1)) + (eq (qcddr tmp1) nil) + (progn + (setq i (qcadr tmp1)) + t)))))) + (nreverse0 result)) + (setq result (cons (qcar tmp1) result))))))))) + +\end{chunk} + +\defun{newWordFrom}{newWordFrom} +\refsdollar{newWordFrom}{stringFauxNewline} +\refsdollar{newWordFrom}{charBlank} +\refsdollar{newWordFrom}{charFauxNewline} +\begin{chunk}{defun newWordFrom} +(defun |newWordFrom| (z i m) + (let (ch done buf) + (declare (special |$charFauxNewline| |$charBlank| |$stringFauxNewline|)) + (loop while (and (<= i m) (char= (elt z i) #\space)) do (incf i)) + (cond + ((> i m) nil) + (t + (setq buf "") + (setq ch (elt z i)) + (cond + ((equal ch |$charFauxNewline|) + (list |$stringFauxNewline| (1+ i))) + (t + (setq done nil) + (loop while (and (<= i m) (null done)) + do + (setq ch (elt z i)) + (cond + ((or (equal ch |$charBlank|) (equal ch |$charFauxNewline|)) + (setq done t)) + (t + (setq buf (strconc buf ch)) + (setq i (1+ i))))) + (list buf i))))))) + +\end{chunk} + +\defun{checkGetArgs}{checkGetArgs} +\calls{checkGetArgs}{maxindex} +\calls{checkGetArgs}{firstNonBlankPosition} +\calls{checkGetArgs}{checkGetArgs} +\calls{checkGetArgs}{stringPrefix?} +\calls{checkGetArgs}{getMatchingRightPren} +\calls{checkGetArgs}{charPosition} +\calls{checkGetArgs}{nequal} +\calls{checkGetArgs}{trimString} +\refsdollar{checkGetArgs}{charComma} +\begin{chunk}{defun checkGetArgs} +(defun |checkGetArgs| (u) + (let (m k acc i) + (declare (special |$charComma|)) + (cond + ((null (stringp u)) nil) + (t + (setq m (maxindex u)) + (setq k (|firstNonBlankPosition| u)) + (cond + ((> k 0) + (|checkGetArgs| (substring u k nil))) + ((|stringPrefix?| "\\spad{" u) + (setq k (or (|getMatchingRightPren| u 6 #\{ #\}) m)) + (|checkGetArgs| (substring u 6 (- k 6)))) + ((> (setq i (|charPosition| #\( u 0)) m) + nil) + ((nequal (elt u m) #\)) + nil) + (t + (do () + ((null (> m (setq k (|charPosition| |$charComma| u (1+ i))))) nil) + (setq acc + (cons (|trimString| (substring u (1+ i) (1- (- k i)))) acc)) + (setq i k)) + (nreverse (cons (substring u (1+ i) (1- (- m i))) acc)))))))) + +\end{chunk} + +\defun{checkAddSpaceSegments}{checkAddSpaceSegments} +\calls{checkAddSpaceSegments}{checkAddSpaceSegments} +\calls{checkAddSpaceSegments}{maxindex} +\calls{checkAddSpaceSegments}{charPosition} +\calls{checkAddSpaceSegments}{strconc} +\refsdollar{checkAddSpaceSegments}{charBlank} +\begin{chunk}{defun checkAddSpaceSegments} +(defun |checkAddSpaceSegments| (u k) + (let (m i j n) + (declare (special |$charBlank|)) + (setq m (maxindex u)) + (setq i (|charPosition| |$charBlank| u k)) + (cond + ((> i m) u) + (t + (setq j i) + (loop while (and (incf j) (char= (elt u j) #\space))) + (setq n (- j i)) ; number of blanks + (if (> n 1) + (strconc (substring u 0 i) "\\space{" (stringimage n) "}" + (|checkAddSpaceSegments| (substring u (+ i n) nil) 0)) + (|checkAddSpaceSegments| u j)))))) + +\end{chunk} + +\defun{checkTrim}{checkTrim} +\calls{checkTrim}{charPosition} +\calls{checkTrim}{nequal} +\calls{checkTrim}{systemError} +\calls{checkTrim}{checkDocError} +\refsdollar{checkTrim}{charBlank} +\refsdollar{checkTrim}{x} +\refsdollar{checkTrim}{charPlus} +\begin{chunk}{defun checkTrim} +(defun |checkTrim| (|$x| lines) + (declare (special |$x|)) + (labels ( + (trim (s) + (let (k) + (declare (special |$charBlank|)) + (setq k (wherePP s)) + (substring s (+ k 2) nil))) + (wherePP (u) + (let (k) + (declare (special |$charPlus|)) + (setq k (|charPosition| |$charPlus| u 0)) + (if (or (eql k (|#| u)) + (nequal (|charPosition| |$charPlus| u (1+ k)) (1+ k))) + (|systemError| " Improper comment found") + k)))) + (let (j s) + (setq s (list (wherePP (car lines)))) + (loop for x in (rest lines) + do + (setq j (wherePP x)) + (unless (member j s) + (|checkDocError| (list |$x| " has varying indentation levels")) + (setq s (cons j s)))) + (loop for y in lines + collect (trim y))))) + +\end{chunk} + +\defun{checkExtract}{checkExtract} +\calls{checkExtract}{firstNonBlankPosition} +\calls{checkExtract}{substring?} +\calls{checkExtract}{charPosition} +\calls{checkExtract}{length} +\begin{chunk}{defun checkExtract} +(defun |checkExtract| (header lines) + (let (line u margin firstLines m k j i acc) + (loop while lines + do + (setq line (car lines)) + (setq k (|firstNonBlankPosition| line)) ; gives margin of description + (if (|substring?| header line k) + (return nil) + (setq lines (cdr lines)))) + (cond + ((null lines) nil) + (t + (setq u (car lines)) + (setq j (|charPosition| #\: u k)) + (setq margin k) + (setq firstLines + (if (nequal (setq k (|firstNonBlankPosition| u (1+ j))) -1) + (cons (substring u (1+ j) nil) (cdr lines)) + (cdr lines))) + ; now look for another header; if found skip all rest of these lines + (setq acc nil) + (loop for line in firstLines + do + (setq m (|#| line)) + (cond + ((eql (setq k (|firstNonBlankPosition| line)) -1) '|skip|) + ((> k margin) '|skip|) + ((null (upper-case-p (elt line k))) '|skip|) + ((equal (setq j (|charPosition| #\: line k)) m) '|skip|) + ((> j (setq i (|charPosition| #\space line (1+ k)))) '|skip|) + (t (return nil))) + (setq acc (cons line acc))) + (nreverse acc))))) + +\end{chunk} + +\defun{checkFixCommonProblem}{checkFixCommonProblem} +\calls{checkFixCommonProblem}{member} +\calls{checkFixCommonProblem}{ifcar} +\calls{checkFixCommonProblem}{ifcdr} +\calls{checkFixCommonProblem}{nequal} +\calls{checkFixCommonProblem}{checkDocError} +\refsdollar{checkFixCommonProblem}{charLbrace} +\refsdollar{checkFixCommonProblem}{HTspadmacros} +\begin{chunk}{defun checkFixCommonProblem} +(defun |checkFixCommonProblem| (u) + (let (x next acc) + (declare (special |$charLbrace| |$HTspadmacros|)) + (loop while u + do + (setq x (car u)) + (cond + ((and (equal x |$charLbrace|) + (|member| (setq next (ifcar (cdr u))) |$HTspadmacros|) + (nequal (ifcar (ifcdr (cdr u))) |$charLbrace|)) + (|checkDocError| (list "Reversing " next " and left brace")) + (setq acc (cons |$charLbrace| (cons next |acc|))) + (setq u (cddr u))) + (t + (setq acc (cons x acc)) + (setq u (cdr u))))) + (nreverse acc))) + +\end{chunk} + +\defun{checkDecorate}{checkDecorate} +\calls{checkDecorate}{checkDocError} +\calls{checkDecorate}{member} +\calls{checkDecorate}{checkAddBackSlashes} +\calls{checkDecorate}{hasNoVowels} +\refsdollar{checkDecorate}{checkingXmptex?} +\refsdollar{checkDecorate}{charExclusions} +\refsdollar{checkDecorate}{argl} +\refsdollar{checkDecorate}{charBack} +\refsdollar{checkDecorate}{charRbrace} +\refsdollar{checkDecorate}{charLbrace} +\begin{chunk}{defun checkDecorate} +(defun |checkDecorate| (u) + (let (x count mathSymbolsOk spadflag verbatim v xcount acc) + (declare (special |$charLbrace| |$charRbrace| |$charBack| |$argl| + |$charExclusions| |$checkingXmptex?|)) + (setq count 0) + (loop while u + do + (setq x (car u)) + (cond + ((null verbatim) + (cond + ((string= x "\\em") + (cond + ((> count 0) + (setq mathSymbolsOk (1- count)) + (setq spadflag (1- count))) + (t + (|checkDocError| (list "\\em must be enclosed in braces")))))) + (when (|member| x '("\\spadpaste" "\\spad" "\\spadop")) + (setq mathSymbolsOk count)) + (cond + ((|member| x '("\\s" "\\spadtype" "\\spadsys" "\\example" "\\andexample" + "\\spadop" "\\spad" "\\spadignore" "\\spadpaste" + "\\spadcommand" "\\footnote")) + (setq spadflag count)) + ((equal x |$charLbrace|) + (setq count (1+ count))) + ((equal x |$charRbrace|) + (setq count (1- count)) + (when (eql mathSymbolsOk count) (setq mathSymbolsOk nil)) + (when (eql spadflag count) (setq spadflag nil))) + ((and (null |mathSymbolsOk|) + (|member| x '("+" "*" "=" "==" "->"))) + (when |$checkingXmptex?| + (|checkDocError| + (list '|Symbol | x " appearing outside \\spad{}"))))))) + (setq acc + (cond + ((string= x "\\end{verbatim}") + (setq verbatim nil) + (cons x acc)) + (verbatim (cons x acc)) + ((string= x "\\begin{verbatim}") + (setq verbatim t) + (cons x acc)) + ((and (string= x "\\begin") + (equal (car (setq v (ifcdr u))) |$charLbrace|) + (string= (car (setq v (ifcdr v))) "detail") + (equal (car (setq v (ifcdr v))) |$charRbrace|)) + (setq u v) + (cons "\\blankline " acc)) + ((and (string= x "\\end") + (equal (car (setq v (ifcdr u))) |$charLbrace|) + (string= (car (setq v (ifcdr v))) "detail") + (equal (car (setq v (ifcdr v))) |$charRbrace|)) + (setq u v) + acc) + ((or (char= x #\$) (string= x "$")) + (cons "\\$" acc)) + ((or (char= x #\%) (string= x "%")) + (cons "\\%" acc)) + ((or (char= x #\,) (string= x ",")) + (cons ",{}" acc)) + ((string= x "\\spad") + (cons "\\spad" acc)) + ((and (stringp x) (digitp (elt x 0))) + (cons x acc)) + ((and (null spadflag) + (or (and (charp x) + (alpha-char-p x) + (null (member x |$charExclusions|))) + (|member| x |$argl|))) + (cons |$charRbrace| (cons x (cons |$charLbrace| (cons "\\spad" acc))))) + ((and (null spadflag) + (or (and (stringp x) + (null (equal (elt x 0) |$charBack|)) + (digitp (elt x (maxindex x)))) + (|member| x '("true" "false")))) + (cons |$charRbrace| (cons x (cons |$charLbrace| (cons "\\spad" acc))))) + (t + (setq xcount (|#| x)) + (cond + ((and (eql xcount 3) + (char= (elt x 1) #\t) + (char= (elt x 2) #\h)) + (cons "th" (cons |$charRbrace| + (cons (elt x 0) (cons |$charLbrace| (cons "\\spad" acc)))))) + ((and (eql xcount 4) + (char= (elt x 1) #\-) + (char= (elt x 2) #\t) + (char= (elt x 3) #\h)) + (cons "-th" (cons |$charRbrace| + (cons (elt x 0) (cons |$charLbrace| (cons "\\spad" acc)))))) + ((or (and (eql xcount 2) + (char= (elt x 1) #\i)) + (and (null spadflag) + (> xcount 0) + (> 4 xcount) + (null (|member| x '("th" "rd" "st"))) + (|hasNoVowels| x))) + (cons |$charRbrace| + (cons x (cons |$charLbrace| (cons "\\spad" acc))))) + (t + (cons (|checkAddBackSlashes| x) acc)))))) + (setq u (cdr u))) + (nreverse acc))) + +\end{chunk} + +\defun{hasNoVowels}{hasNoVowels} +\calls{hasNoVowels}{maxindex} +\begin{chunk}{defun hasNoVowels} +(defun |hasNoVowels| (x) + (labels ( + (isVowel (c) + (or (eq c #\a) (eq c #\e) (eq c #\i) (eq c #\o) (eq c #\u) + (eq c #\A) (eq c #\E) (eq c #\I) (eq c #\O) (eq c #\U)))) + (let (max) + (setq max (maxindex x)) + (cond + ((char= (elt x max) #\y) nil) + (t + (let ((result t)) + (loop for i from 0 to max + do (setq result (and result (null (isVowel (elt x i)))))) + result)))))) + +\end{chunk} + +\defun{checkAddBackSlashes}{checkAddBackSlashes} +\calls{checkAddBackSlashes}{strconc} +\calls{checkAddBackSlashes}{maxindex} +\calls{checkAddBackSlashes}{checkAddBackSlashes} +\refsdollar{checkAddBackSlashes}{charBack} +\refsdollar{checkAddBackSlashes}{charEscapeList} +\begin{chunk}{defun checkAddBackSlashes} +(defun |checkAddBackSlashes| (s) + (let (c m char insertIndex k) + (declare (special |$charBack| |$charEscapeList|)) + (cond + ((or (and (charp s) (setq c s)) + (and (eql (|#| s) 1) (setq c (elt s 0)))) + (if (member s |$charEscapeList|) + (strconc |$charBack| c) + s)) + (t + (setq k 0) + (setq m (maxindex s)) + (setq insertIndex nil) + (loop while (< k m) + do + (setq char (elt s k)) + (cond + ((char= char |$charBack|) (setq k (+ k 2))) + ((member char |$charEscapeList|) (return (setq insertIndex k)))) + (setq k (1+ k))) + (cond + (insertIndex + (|checkAddBackSlashes| + (strconc (substring s 0 insertIndex) |$charBack| (elt s k) + (substring s (1+ insertIndex) nil)))) + (T s)))))) + +\end{chunk} + +\defun{checkAddSpaces}{checkAddSpaces} +\refsdollar{checkAddSpaces}{charBlank} +\refsdollar{checkAddSpaces}{charFauxNewline} +\begin{chunk}{defun checkAddSpaces} +(defun |checkAddSpaces| (u) + (let (u2 space) + (declare (special |$charBlank| |$charFauxNewline|)) + (cond + ((null u) nil) + ((null (cdr u)) u) + (t + (setq space |$charBlank|) + (setq i 0) + (loop for f in u + do + (incf i) + (when (string= f "\\begin{verbatim}") + (setq space |$charFauxNewline|) + (unless u2 (setq u2 (list space)))) + (if (> i 1) + (setq u2 (append u2 (list space f))) + (setq u2 (append u2 (list f)))) + (when (string= f "\\end{verbatim}") + (setq u2 (append u2 (list space))) + (setq space |$charBlank|))) + u2)))) + +\end{chunk} + \chapter{Utility Functions} \defun{translabel}{translabel} @@ -24451,34 +25224,51 @@ The current input line. \getchunk{defun canReturn} \getchunk{defun char-eq} \getchunk{defun char-ne} +\getchunk{defun checkAddBackSlashes} +\getchunk{defun checkAddMacros} \getchunk{defun checkAddPeriod} +\getchunk{defun checkAddSpaceSegments} \getchunk{defun checkAlphabetic} \getchunk{defun checkAndDeclare} \getchunk{defun checkArguments} \getchunk{defun checkBalance} \getchunk{defun checkBeginEnd} \getchunk{defun checkComments} +\getchunk{defun checkDecorate} \getchunk{defun checkDecorateForHt} \getchunk{defun checkDocError} \getchunk{defun checkDocError1} \getchunk{defun checkDocMessage} +\getchunk{defun checkExtract} +\getchunk{defun checkFixCommonProblem} +\getchunk{defun checkGetArgs} \getchunk{defun checkGetMargin} \getchunk{defun checkGetParse} \getchunk{defun checkHTargs} \getchunk{defun checkIeEg} \getchunk{defun checkIeEgfun} +\getchunk{defun checkIndentedLines} \getchunk{defun checkLookForLeftBrace} \getchunk{defun checkLookForRightBrace} +\getchunk{defun checkNumOfArgs} \getchunk{defun checkTexht} \getchunk{defun checkRecordHash} +\getchunk{defun checkRemoveComments} \getchunk{defun checkRewrite} \getchunk{defun checkSayBracket} \getchunk{defun checkSkipBlanks} \getchunk{defun checkSkipIdentifierToken} \getchunk{defun checkSkipOpToken} \getchunk{defun checkSkipToken} +\getchunk{defun checkAddSpaces} +\getchunk{defun checkSplitBackslash} +\getchunk{defun checkSplitBrace} +\getchunk{defun checkSplitOn} +\getchunk{defun checkSplitPunctuation} \getchunk{defun checkSplit2Words} \getchunk{defun checkTransformFirsts} +\getchunk{defun checkTrim} +\getchunk{defun checkTrimCommented} \getchunk{defun checkWarning} \getchunk{defun coerce} \getchunk{defun coerceable} @@ -24690,8 +25480,10 @@ The current input line. \getchunk{defun hasAplExtension} \getchunk{defun hasFormalMapVariable} \getchunk{defun hasFullSignature} +\getchunk{defun hasNoVowels} \getchunk{defun hasSigInTargetCategory} \getchunk{defun hasType} +\getchunk{defun htcharPosition} \getchunk{defun indent-pos} \getchunk{defun infixtok} @@ -24765,10 +25557,12 @@ The current input line. \getchunk{defun mustInstantiate} \getchunk{defun ncINTERPFILE} +\getchunk{defun newWordFrom} \getchunk{defun next-char} \getchunk{defun next-line} \getchunk{defun next-tab-loc} \getchunk{defun next-token} +\getchunk{defun newString2Words} \getchunk{defun new2OldLisp} \getchunk{defun nonblankloc} \getchunk{defun NRTassocIndex} @@ -25012,6 +25806,7 @@ The current input line. \getchunk{defun recordHeaderDocumentation} \getchunk{defun recordSignatureDocumentation} \getchunk{defun replaceExitEtc} +\getchunk{defun removeBackslashes} \getchunk{defun removeSuperfluousMapping} \getchunk{defun replaceVars} \getchunk{defun resolve} diff --git a/changelog b/changelog index 6bc01a7..10747b4 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20111130 tpd src/axiom-website/patches.html 20111130.02.tpd.patch +20111130 tpd src/interp/Makefile remove c-doc.lisp +20111130 tpd src/interp/c-doc.lisp removed +20111130 tpd books/bookvol9 treeshake and merge c-doc.lisp 20111130 tpd src/axiom-website/patches.html 20111130.01.tpd.patch 20111130 tpd src/algebra/Makefile fix .input file algebra extraction 20111130 tpd books/tangle.lisp fix .input file algebra extraction diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index bced459..fdc473b 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3700,5 +3700,7 @@ books/bookvol9 treeshake compiler
src/axiom-website/litprog.html literate program example
20111130.01.tpd.patch books/tangle.lisp fix .input file algebra extraction
+20111130.02.tpd.patch +books/bookvol9 treeshake and merge c-doc.lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 3f253dc..5fb5754 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -181,7 +181,6 @@ OBJS= ${OUT}/vmlisp.${O} \ ${OUT}/template.${O} ${OUT}/termrw.${O} \ ${OUT}/fortcall.${O} \ ${OUT}/parsing.${O} \ - ${OUT}/c-doc.${O} \ ${OUT}/c-util.${O} ${OUT}/profile.${O} \ ${OUT}/category.${O} \ ${OUT}/functor.${O} \ @@ -1515,30 +1514,6 @@ ${MID}/cattable.lisp: ${IN}/cattable.lisp.pamphlet @ -\subsection{c-doc.lisp} -<>= -${OUT}/c-doc.${O}: ${MID}/c-doc.lisp - @ echo 136 making ${OUT}/c-doc.${O} from ${MID}/c-doc.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/c-doc.lisp"' \ - ':output-file "${OUT}/c-doc.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/c-doc.lisp"' \ - ':output-file "${OUT}/c-doc.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/c-doc.lisp: ${IN}/c-doc.lisp.pamphlet - @ echo 137 making ${MID}/c-doc.lisp from ${IN}/c-doc.lisp.pamphlet - @ (cd ${MID} ; \ - echo '(tangle "${IN}/c-doc.lisp.pamphlet" "*" "c-doc.lisp")' \ - | ${OBJ}/${SYS}/bin/lisp ) - -@ - \subsection{clam.lisp} <>= ${OUT}/clam.${O}: ${MID}/clam.lisp @@ -3039,9 +3014,6 @@ clean: <> <> -<> -<> - <> <> diff --git a/src/interp/c-doc.lisp.pamphlet b/src/interp/c-doc.lisp.pamphlet deleted file mode 100644 index 7b18450..0000000 --- a/src/interp/c-doc.lisp.pamphlet +++ /dev/null @@ -1,4110 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp c-doc.lisp} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\begin{chunk}{*} - -(IN-PACKAGE "BOOT" ) - -;batchExecute() == -; _/RF_-1 '(GENCON INPUT) - -(DEFUN |batchExecute| () (/RF-1 '(GENCON INPUT))) - -;getDoc(conName,op,modemap) == -; [dc,target,sl,pred,D] := simplifyModemap modemap -; sig := [target,:sl] -; null atom dc => -; sig := SUBST('$,dc,sig) -; sig := SUBLISLIS($FormalMapVariableList,rest dc,sig) -; getDocForDomain(conName,op,sig) -; if argList := IFCDR getOfCategoryArgument pred then -; SUBLISLIS($FormalMapArgumentList,argList,sig) -; sig := SUBST('$,dc,sig) -; getDocForCategory(conName,op,sig) - -(DEFUN |getDoc| (|conName| |op| |modemap|) - (PROG (|LETTMP#1| |dc| |target| |sl| |pred| D |argList| |sig|) - (declare (special |$FormalMapArgumentList|)) - (RETURN - (PROGN - (SPADLET |LETTMP#1| (|simplifyModemap| |modemap|)) - (SPADLET |dc| (CAR |LETTMP#1|)) - (SPADLET |target| (CADR |LETTMP#1|)) - (SPADLET |sl| (CADDR |LETTMP#1|)) - (SPADLET |pred| (CADDDR |LETTMP#1|)) - (SPADLET D (CAR (CDDDDR |LETTMP#1|))) - (SPADLET |sig| (CONS |target| |sl|)) - (COND - ((NULL (ATOM |dc|)) (SPADLET |sig| (MSUBST '$ |dc| |sig|)) - (SPADLET |sig| - (SUBLISLIS |$FormalMapVariableList| (CDR |dc|) - |sig|)) - (|getDocForDomain| |conName| |op| |sig|)) - ('T - (COND - ((SPADLET |argList| - (IFCDR (|getOfCategoryArgument| |pred|))) - (SUBLISLIS |$FormalMapArgumentList| |argList| |sig|))) - (SPADLET |sig| (MSUBST '$ |dc| |sig|)) - (|getDocForCategory| |conName| |op| |sig|))))))) - -;getOfCategoryArgument pred == -; pred is [fn,:.] and MEMQ(fn,'(AND OR NOT)) => -; or/[getOfCategoryArgument x for x in rest pred] -; pred is ['ofCategory,'_*1,form] => form -; nil - -(DEFUN |getOfCategoryArgument| (|pred|) - (PROG (|fn| |ISTMP#1| |ISTMP#2| |form|) - (RETURN - (SEQ (COND - ((AND (CONSP |pred|) - (PROGN (SPADLET |fn| (QCAR |pred|)) 'T) - (member |fn| '(AND OR NOT))) - (PROG (G166100) - (SPADLET G166100 NIL) - (RETURN - (DO ((G166106 NIL G166100) - (G166107 (CDR |pred|) (CDR G166107)) - (|x| NIL)) - ((OR G166106 (ATOM G166107) - (PROGN (SETQ |x| (CAR G166107)) NIL)) - G166100) - (SEQ (EXIT (SETQ G166100 - (OR G166100 - (|getOfCategoryArgument| |x|))))))))) - ((AND (CONSP |pred|) (EQ (QCAR |pred|) '|ofCategory|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |pred|)) - (AND (CONSP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) '*1) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |form| (QCAR |ISTMP#2|)) - 'T)))))) - |form|) - ('T NIL)))))) - -;getDocForCategory(name,op,sig) == -; getOpDoc(constructor? name,op,sig) or -; or/[getOpDoc(constructor? x,op,sig) for x in whatCatCategories name] - -(DEFUN |getDocForCategory| (|name| |op| |sig|) - (PROG () - (RETURN - (SEQ (OR (|getOpDoc| (|constructor?| |name|) |op| |sig|) - (PROG (G166122) - (SPADLET G166122 NIL) - (RETURN - (DO ((G166128 NIL G166122) - (G166129 (|whatCatCategories| |name|) - (CDR G166129)) - (|x| NIL)) - ((OR G166128 (ATOM G166129) - (PROGN (SETQ |x| (CAR G166129)) NIL)) - G166122) - (SEQ (EXIT (SETQ G166122 - (OR G166122 - (|getOpDoc| (|constructor?| |x|) - |op| |sig|))))))))))))) - -;getDocForDomain(name,op,sig) == -; getOpDoc(constructor? name,op,sig) or -; or/[getOpDoc(constructor? x,op,sig) for x in whatCatExtDom name] - -(DEFUN |getDocForDomain| (|name| |op| |sig|) - (PROG () - (RETURN - (SEQ (OR (|getOpDoc| (|constructor?| |name|) |op| |sig|) - (PROG (G166140) - (SPADLET G166140 NIL) - (RETURN - (DO ((G166146 NIL G166140) - (G166147 (|whatCatExtDom| |name|) - (CDR G166147)) - (|x| NIL)) - ((OR G166146 (ATOM G166147) - (PROGN (SETQ |x| (CAR G166147)) NIL)) - G166140) - (SEQ (EXIT (SETQ G166140 - (OR G166140 - (|getOpDoc| (|constructor?| |x|) - |op| |sig|))))))))))))) - -;getOpDoc(abb,op,:sigPart) == -; u := LASSOC(op,GETDATABASE(abb,'DOCUMENTATION)) -; $argList : local := $FormalMapVariableList -; _$: local := '_$ -; sigPart is [sig] => or/[d for [s,:d] in u | sig = s] -; u - -(DEFUN |getOpDoc| (&REST G166194 &AUX |sigPart| |op| |abb|) - (DSETQ (|abb| |op| . |sigPart|) G166194) - (PROG (|$argList| $ |u| |sig| |s| |d|) - (DECLARE (SPECIAL |$argList| $ |$FormalMapVariableList|)) - (RETURN - (SEQ (PROGN - (SPADLET |u| - (LASSOC |op| (GETDATABASE |abb| 'DOCUMENTATION))) - (SPADLET |$argList| |$FormalMapVariableList|) - (SPADLET $ '$) - (COND - ((AND (CONSP |sigPart|) (EQ (QCDR |sigPart|) NIL) - (PROGN (SPADLET |sig| (QCAR |sigPart|)) 'T)) - (PROG (G166163) - (SPADLET G166163 NIL) - (RETURN - (DO ((G166171 NIL G166163) - (G166172 |u| (CDR G166172)) - (G166158 NIL)) - ((OR G166171 (ATOM G166172) - (PROGN - (SETQ G166158 (CAR G166172)) - NIL) - (PROGN - (PROGN - (SPADLET |s| (CAR G166158)) - (SPADLET |d| (CDR G166158)) - G166158) - NIL)) - G166163) - (SEQ (EXIT (COND - ((BOOT-EQUAL |sig| |s|) - (SETQ G166163 (OR G166163 |d|)))))))))) - ('T |u|))))))) - -;readForDoc fn == -; $bootStrapMode: local:= true -; _/RQ_-LIB_-1 [fn,'SPAD] - -(DEFUN |readForDoc| (|fn|) - (PROG (|$bootStrapMode|) - (DECLARE (SPECIAL |$bootStrapMode|)) - (RETURN - (PROGN - (SPADLET |$bootStrapMode| 'T) - (/RQ-LIB-1 (CONS |fn| (CONS 'SPAD NIL))))))) - - -;finalizeDocumentation() == -; unusedCommentLineNumbers := [x for (x := [n,:r]) in $COMBLOCKLIST | r] -; docList := SUBST("$","%",transDocList($op,$docList)) -; if u := [sig for [sig,:doc] in docList | null doc] then -; for y in u repeat -; y = 'constructor => noHeading := true -; y is [x,b] and b is [='attribute,:r] => -; attributes := [[x,:r],:attributes] -; signatures := [y,:signatures] -; name := CAR $lisplibForm -; if noHeading or signatures or attributes or unusedCommentLineNumbers then -; sayKeyedMsg("S2CD0001",NIL) -; bigcnt := 1 -; if noHeading or signatures or attributes then -; sayKeyedMsg("S2CD0002",[STRCONC(STRINGIMAGE bigcnt,'"."),name]) -; bigcnt := bigcnt + 1 -; litcnt := 1 -; if noHeading then -; sayKeyedMsg("S2CD0003", -; [STRCONC('"(",STRINGIMAGE litcnt,'")"),name]) -; litcnt := litcnt + 1 -; if signatures then -; sayKeyedMsg("S2CD0004", -; [STRCONC('"(",STRINGIMAGE litcnt,'")")]) -; litcnt := litcnt + 1 -; for [op,sig] in signatures repeat -; s := formatOpSignature(op,sig) -; sayMSG -; atom s => ['%x9,s] -; ['%x9,:s] -; if attributes then -; sayKeyedMsg("S2CD0005", -; [STRCONC('"(",STRINGIMAGE litcnt,'")")]) -; litcnt := litcnt + 1 -; for x in attributes repeat -; a := form2String x -; sayMSG -; atom a => ['%x9,a] -; ['%x9,:a] -; if unusedCommentLineNumbers then -; sayKeyedMsg("S2CD0006",[STRCONC(STRINGIMAGE bigcnt,'"."),name]) -; for [n,r] in unusedCommentLineNumbers repeat -; sayMSG ['" ",:bright n,'" ",r] -; hn [[:fn(sig,$e),:doc] for [sig,:doc] in docList] where -; fn(x,e) == -; atom x => [x,nil] -; if #x > 2 then x := TAKE(2,x) -; SUBLISLIS($FormalMapVariableList,rest $lisplibForm, -; macroExpand(x,e)) -; hn u == -; -- ((op,sig,doc), ...) --> ((op ((sig doc) ...)) ...) -; opList := REMDUP ASSOCLEFT u -; [[op,:[[sig,doc] for [op1,sig,doc] in u | op = op1]] for op in opList] - -;(DEFUN |finalizeDocumentation,hn| (|u|) -; (PROG (|opList| |op1| |sig| |doc|) -; (RETURN -; (SEQ (SPADLET |opList| (REMDUP (ASSOCLEFT |u|))) -; (EXIT (PROG (G166360) -; (SPADLET G166360 NIL) -; (RETURN -; (DO ((G166369 |opList| (CDR G166369)) -; (|op| NIL)) -; ((OR (ATOM G166369) -; (PROGN (SETQ |op| (CAR G166369)) NIL)) -; (NREVERSE0 G166360)) -; (SEQ (EXIT (SETQ G166360 -; (CONS -; (CONS |op| -; (PROG (G166381) -; (SPADLET G166381 NIL) -; (RETURN -; (DO -; ((G166388 |u| -; (CDR G166388)) -; (G166346 NIL)) -; ((OR (ATOM G166388) -; (PROGN -; (SETQ G166346 -; (CAR G166388)) -; NIL) -; (PROGN -; (PROGN -; (SPADLET |op1| -; (CAR G166346)) -; (SPADLET |sig| -; (CADR G166346)) -; (SPADLET |doc| -; (CADDR G166346)) -; G166346) -; NIL)) -; (NREVERSE0 G166381)) -; (SEQ -; (EXIT -; (COND -; ((BOOT-EQUAL |op| -; |op1|) -; (SETQ G166381 -; (CONS -; (CONS |sig| -; (CONS |doc| -; NIL)) -; G166381)))))))))) -; G166360)))))))))))) -; -;(DEFUN |finalizeDocumentation,fn| (|x| |e|) -; (declare (special |$lisplibForm| |$FormalMapVariableList|)) -; (SEQ (IF (ATOM |x|) (EXIT (CONS |x| (CONS NIL NIL)))) -; (IF (> (|#| |x|) 2) (SPADLET |x| (TAKE 2 |x|)) NIL) -; (EXIT (SUBLISLIS |$FormalMapVariableList| (CDR |$lisplibForm|) -; (|macroExpand| |x| |e|))))) -; -;(defun |finalizeDocumentation| () -; (prog (|unusedCommentLineNumbers| |docList| |u| |noHeading| |x| -; |ISTMP#1| |b| |attributes| |signatures| |name| |bigcnt| -; |op| |s| |litcnt| |a| |n| |r| |sig| |doc|) -; (declare (special |$e| |$lisplibForm| |$docList| |$op| $COMBLOCKLIST)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |unusedCommentLineNumbers| -; (PROG (G166423) -; (SPADLET G166423 NIL) -; (RETURN -; (DO ((G166430 $COMBLOCKLIST -; (CDR G166430)) -; (|x| NIL)) -; ((OR (ATOM G166430) -; (PROGN -; (SETQ |x| (CAR G166430)) -; NIL) -; (PROGN -; (PROGN -; (SPADLET |n| (CAR |x|)) -; (SPADLET |r| (CDR |x|)) -; |x|) -; NIL)) -; (NREVERSE0 G166423)) -; (SEQ (EXIT (COND -; (|r| -; (SETQ G166423 -; (CONS |x| G166423)))))))))) -; (SPADLET |docList| -; (MSUBST '$ '% (|transDocList| |$op| |$docList|))) -; (COND -; ((SPADLET |u| -; (PROG (G166443) -; (SPADLET G166443 NIL) -; (RETURN -; (DO ((G166450 |docList| (CDR G166450)) -; (G166312 NIL)) -; ((OR (ATOM G166450) -; (PROGN -; (SETQ G166312 -; (CAR G166450)) -; NIL) -; (PROGN -; (PROGN -; (SPADLET |sig| -; (CAR G166312)) -; (SPADLET |doc| -; (CDR G166312)) -; G166312) -; NIL)) -; (NREVERSE0 G166443)) -; (SEQ (EXIT -; (COND -; ((NULL |doc|) -; (SETQ G166443 -; (CONS |sig| G166443)))))))))) -; (DO ((G166467 |u| (CDR G166467)) (|y| NIL)) -; ((OR (ATOM G166467) -; (PROGN (SETQ |y| (CAR G166467)) NIL)) -; NIL) -; (SEQ (EXIT (COND -; ((BOOT-EQUAL |y| '|constructor|) -; (SPADLET |noHeading| 'T)) -; ((AND (CONSP |y|) -; (PROGN -; (SPADLET |x| (QCAR |y|)) -; (SPADLET |ISTMP#1| (QCDR |y|)) -; (AND (CONSP |ISTMP#1|) -; (EQ (QCDR |ISTMP#1|) NIL) -; (PROGN -; (SPADLET |b| -; (QCAR |ISTMP#1|)) -; 'T))) -; (CONSP |b|) -; (EQUAL (QCAR |b|) '|attribute|) -; (PROGN -; (SPADLET |r| (QCDR |b|)) -; 'T)) -; (SPADLET |attributes| -; (CONS (CONS |x| |r|) -; |attributes|))) -; ('T -; (SPADLET |signatures| -; (CONS |y| |signatures|))))))) -; (SPADLET |name| (CAR |$lisplibForm|)) -; (COND -; ((OR |noHeading| |signatures| |attributes| -; |unusedCommentLineNumbers|) -; (|sayKeyedMsg| 'S2CD0001 NIL) (SPADLET |bigcnt| 1) -; (COND -; ((OR |noHeading| |signatures| |attributes|) -; (|sayKeyedMsg| 'S2CD0002 -; (CONS (STRCONC (STRINGIMAGE |bigcnt|) -; ".") -; (CONS |name| NIL))) -; (SPADLET |bigcnt| (PLUS |bigcnt| 1)) -; (SPADLET |litcnt| 1) -; (COND -; (|noHeading| -; (|sayKeyedMsg| 'S2CD0003 -; (CONS (STRCONC "(" -; (STRINGIMAGE |litcnt|) -; ")") -; (CONS |name| NIL))) -; (SPADLET |litcnt| (PLUS |litcnt| 1)))) -; (COND -; (|signatures| -; (|sayKeyedMsg| 'S2CD0004 -; (CONS (STRCONC "(" -; (STRINGIMAGE |litcnt|) -; ")") -; NIL)) -; (SPADLET |litcnt| (PLUS |litcnt| 1)) -; (DO ((G166479 |signatures| -; (CDR G166479)) -; (G166329 NIL)) -; ((OR (ATOM G166479) -; (PROGN -; (SETQ G166329 (CAR G166479)) -; NIL) -; (PROGN -; (PROGN -; (SPADLET |op| (CAR G166329)) -; (SPADLET |sig| -; (CADR G166329)) -; G166329) -; NIL)) -; NIL) -; (SEQ (EXIT -; (PROGN -; (SPADLET |s| -; (|formatOpSignature| |op| |sig|)) -; (|sayMSG| -; (COND -; ((ATOM |s|) -; (CONS '|%x9| (CONS |s| NIL))) -; ('T (CONS '|%x9| |s|)))))))))) -; (COND -; (|attributes| -; (|sayKeyedMsg| 'S2CD0005 -; (CONS (STRCONC "(" -; (STRINGIMAGE |litcnt|) -; ")") -; NIL)) -; (SPADLET |litcnt| (PLUS |litcnt| 1)) -; (DO ((G166491 |attributes| -; (CDR G166491)) -; (|x| NIL)) -; ((OR (ATOM G166491) -; (PROGN -; (SETQ |x| (CAR G166491)) -; NIL)) -; NIL) -; (SEQ (EXIT -; (PROGN -; (SPADLET |a| (|form2String| |x|)) -; (|sayMSG| -; (COND -; ((ATOM |a|) -; (CONS '|%x9| (CONS |a| NIL))) -; ('T (CONS '|%x9| |a|))))))))) -; ('T NIL)))) -; (COND -; (|unusedCommentLineNumbers| -; (|sayKeyedMsg| 'S2CD0006 -; (CONS (STRCONC (STRINGIMAGE |bigcnt|) -; ".") -; (CONS |name| NIL))) -; (DO ((G166501 |unusedCommentLineNumbers| -; (CDR G166501)) -; (G166338 NIL)) -; ((OR (ATOM G166501) -; (PROGN -; (SETQ G166338 (CAR G166501)) -; NIL) -; (PROGN -; (PROGN -; (SPADLET |n| (CAR G166338)) -; (SPADLET |r| (CADR G166338)) -; G166338) -; NIL)) -; NIL) -; (SEQ (EXIT (|sayMSG| -; (CONS " " -; (APPEND (|bright| |n|) -; (CONS " " -; (CONS |r| NIL))))))))) -; ('T NIL))) -; ('T NIL)))) -; (|finalizeDocumentation,hn| -; (PROG (G166513) -; (SPADLET G166513 NIL) -; (RETURN -; (DO ((G166519 |docList| (CDR G166519)) -; (G166408 NIL)) -; ((OR (ATOM G166519) -; (PROGN -; (SETQ G166408 (CAR G166519)) -; NIL) -; (PROGN -; (PROGN -; (SPADLET |sig| (CAR G166408)) -; (SPADLET |doc| (CDR G166408)) -; G166408) -; NIL)) -; (NREVERSE0 G166513)) -; (SEQ (EXIT (SETQ G166513 -; (CONS -; (APPEND -; (|finalizeDocumentation,fn| -; |sig| |$e|) -; |doc|) -; G166513))))))))))))) - -;--======================================================================= -;-- Transformation of ++ comments -;--======================================================================= - -;transDoc(conname,doclist) == -;--$exposeFlag and not isExposedConstructor conname => nil -;--skip over unexposed constructors when checking system files -; $x: local := nil -; rlist := REVERSE doclist -; for [$x,:lines] in rlist repeat -; $attribute? : local := $x is [.,[key]] and key = 'attribute -; null lines => -; $attribute? => nil -; checkDocError1 ['"Not documented!!!!"] -; u := checkTrim($x,(STRINGP lines => [lines]; $x = 'constructor => first lines; lines)) -; $argl : local := nil --set by checkGetArgs -;-- tpd: related domain information doesn't exist -;-- if v := checkExtract('"Related Domains:",u) then -;-- $lisplibRelatedDomains:=[w for x in gn(v) | w := fn(x)] where -;-- gn(v) == --note: unabbrev checks for correct number of arguments -;-- s := checkExtractItemList v -;-- parse := ncParseFromString s --is a single conform or a tuple -;-- null parse => nil -;-- parse is ['Tuple,:r] => r -;-- [parse] -;-- fn(x) == -;-- expectedNumOfArgs := checkNumOfArgs x -;-- null expectedNumOfArgs => -;-- checkDocError ['"Unknown constructor name?: ",opOf x] -;-- x -;-- expectedNumOfArgs ^= (n := #(IFCDR x)) => -;-- n = 0 => checkDocError1 -;-- ['"You must give arguments to the _"Related Domain_": ",x] -;-- checkDocError -;-- ['"_"Related Domain_" has wrong number of arguments: ",x] -;-- nil -;-- n=0 and atom x => [x] -;-- x -; longline := -; $x = 'constructor => -; v :=checkExtract('"Description:",u) or u and -; checkExtract('"Description:", -; [STRCONC('"Description: ",first u),:rest u]) -; transformAndRecheckComments('constructor,v or u) -; transformAndRecheckComments($x,u) -; acc := [[$x,longline],:acc] --processor assumes a list of lines -; NREVERSE acc - -;(DEFUN |transDoc| (|conname| |doclist|) -; (PROG (|$x| |$attribute?| |$argl| |rlist| |lines| |ISTMP#1| |ISTMP#2| -; |key| |u| |v| |longline| |acc|) -; (DECLARE (SPECIAL |$x| |$attribute?| |$argl|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |$x| NIL) -; (SPADLET |rlist| (REVERSE |doclist|)) -; (DO ((G166623 |rlist| (CDR G166623)) (G166606 NIL)) -; ((OR (ATOM G166623) -; (PROGN (SETQ G166606 (CAR G166623)) NIL) -; (PROGN -; (PROGN -; (SPADLET |$x| (CAR G166606)) -; (SPADLET |lines| (CDR G166606)) -; G166606) -; NIL)) -; NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |$attribute?| -; (AND (CONSP |$x|) -; (PROGN -; (SPADLET |ISTMP#1| (QCDR |$x|)) -; (AND (CONSP |ISTMP#1|) -; (EQ (QCDR |ISTMP#1|) NIL) -; (PROGN -; (SPADLET |ISTMP#2| -; (QCAR |ISTMP#1|)) -; (AND (CONSP |ISTMP#2|) -; (EQ (QCDR |ISTMP#2|) NIL) -; (PROGN -; (SPADLET |key| -; (QCAR |ISTMP#2|)) -; 'T))))) -; (BOOT-EQUAL |key| '|attribute|))) -; (COND -; ((NULL |lines|) -; (COND -; (|$attribute?| NIL) -; ('T -; (|checkDocError1| -; (CONS -; "Not documented!!!!" -; NIL))))) -; ('T -; (SPADLET |u| -; (|checkTrim| |$x| -; (COND -; ((STRINGP |lines|) -; (CONS |lines| NIL)) -; ((BOOT-EQUAL |$x| -; '|constructor|) -; (CAR |lines|)) -; ('T |lines|)))) -; (SPADLET |$argl| NIL) -; (SPADLET |longline| -; (COND -; ((BOOT-EQUAL |$x| -; '|constructor|) -; (SPADLET |v| -; (OR -; (|checkExtract| -; "Description:" -; |u|) -; (AND |u| -; (|checkExtract| -; "Description:" -; (CONS -; (STRCONC -; "Description: " -; (CAR |u|)) -; (CDR |u|)))))) -; (|transformAndRecheckComments| -; '|constructor| -; (OR |v| |u|))) -; ('T -; (|transformAndRecheckComments| -; |$x| |u|)))) -; (SPADLET |acc| -; (CONS -; (CONS |$x| -; (CONS |longline| NIL)) -; |acc|)))))))) -; (NREVERSE |acc|)))))) - -;checkExtractItemList l == --items are separated by commas or end of line -; acc := nil --l is list of remaining lines -; while l repeat --stop when you get to a line with a colon -; m := MAXINDEX first l -; k := charPosition(char '_:,first l,0) -; k <= m => return nil -; acc := [first l,:acc] -; l := rest l -; "STRCONC"/[x for x in NREVERSE acc] - -(DEFUN |checkExtractItemList| (|l|) - (PROG (|m| |k| |acc|) - (RETURN - (SEQ (PROGN - (SPADLET |acc| NIL) - (DO () ((NULL |l|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |m| (MAXINDEX (CAR |l|))) - (SPADLET |k| - (|charPosition| (|char| '|:|) - (CAR |l|) 0)) - (COND - ((<= |k| |m|) (RETURN NIL)) - ('T - (SPADLET |acc| (CONS (CAR |l|) |acc|)) - (SPADLET |l| (CDR |l|)))))))) - (PROG (G166663) - (SPADLET G166663 "") - (RETURN - (DO ((G166668 (NREVERSE |acc|) (CDR G166668)) - (|x| NIL)) - ((OR (ATOM G166668) - (PROGN (SETQ |x| (CAR G166668)) NIL)) - G166663) - (SEQ (EXIT (SETQ G166663 (STRCONC G166663 |x|)))))))))))) - -;--NREVERSE("append"/[fn string for string in acc]) where -;-- fn(string) == -;-- m := MAXINDEX string -;-- acc := nil -;-- i := 0 -;-- while i < m and (k := charPosition(char '_,,string,i)) < m repeat -;-- if (t := trimString SUBSTRING(string,i,k-i)) ^= '"" then acc := [t,:acc] -;-- i := k + 1 -;-- if i < m then -;-- if (t := trimString SUBSTRING(string,i,k-i)) ^= '"" then acc := [t,:acc] -;-- acc -;transformAndRecheckComments(name,lines) == -; $checkingXmptex? := false -; $x : local := name -; $name : local := 'GlossaryPage -; $origin : local := 'gloss -; $recheckingFlag : local := false -; $exposeFlagHeading : local := ['"--------",name,'"---------"] -; if null $exposeFlag then sayBrightly $exposeFlagHeading -; u := checkComments(name,lines) -; $recheckingFlag := true -; checkRewrite(name,[u]) -; $recheckingFlag := false -; u - -;(DEFUN |transformAndRecheckComments| (|name| |lines|) -; (PROG (|$x| |$name| |$origin| |$recheckingFlag| |$exposeFlagHeading| |u|) -; (DECLARE (SPECIAL |$x| |$name| |$origin| |$recheckingFlag| -; |$exposeFlagHeading| |$exposeFlag| |$checkingXmptex?|)) -; (RETURN -; (PROGN -; (SPADLET |$checkingXmptex?| NIL) -; (SPADLET |$x| |name|) -; (SPADLET |$name| '|GlossaryPage|) -; (SPADLET |$origin| '|gloss|) -; (SPADLET |$recheckingFlag| NIL) -; (SPADLET |$exposeFlagHeading| -; (CONS "--------" -; (CONS |name| -; (CONS "---------" NIL)))) -; (COND -; ((NULL |$exposeFlag|) (|sayBrightly| |$exposeFlagHeading|))) -; (SPADLET |u| (|checkComments| |name| |lines|)) -; (SPADLET |$recheckingFlag| 'T) -; (|checkRewrite| |name| (CONS |u| NIL)) -; (SPADLET |$recheckingFlag| NIL) -; |u|)))) - -;checkRewrite(name,lines) == main where --similar to checkComments from c-doc -; main == -; $checkErrorFlag: local := true -; margin := 0 -; lines := checkRemoveComments lines -; u := lines -; if $checkingXmptex? then -; u := [checkAddIndented(x,margin) for x in u] -; $argl := checkGetArgs first u --set $argl -; u2 := nil -; verbatim := nil -; for x in u repeat -; w := newString2Words x -; verbatim => -; w and first w = '"\end{verbatim}" => -; verbatim := false -; u2 := append(u2, w) -; u2 := append(u2, [x]) -; w and first w = '"\begin{verbatim}" => -; verbatim := true -; u2 := append(u2, w) -; u2 := append(u2, w) -; u := u2 -; u := checkAddSpaces u -; u := checkSplit2Words u -; u := checkAddMacros u -; u := checkTexht u -;-- checkBalance u -; okBefore := null $checkErrorFlag -; checkArguments u -; if $checkErrorFlag then u := checkFixCommonProblem u -; checkRecordHash u -;-- u := checkTranVerbatim u -; checkDecorateForHt u - -;(DEFUN |checkRewrite| (|name| |lines|) -; (PROG (|$checkErrorFlag| |margin| |w| |verbatim| |u2| |okBefore| |u|) -; (DECLARE (SPECIAL |$checkErrorFlag| |$argl| |$checkingXmptex?|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |$checkErrorFlag| 'T) -; (SPADLET |margin| 0) -; (SPADLET |lines| (|checkRemoveComments| |lines|)) -; (SPADLET |u| |lines|) -; (COND -; (|$checkingXmptex?| -; (SPADLET |u| -; (PROG (G166716) -; (SPADLET G166716 NIL) -; (RETURN -; (DO ((G166721 |u| (CDR G166721)) -; (|x| NIL)) -; ((OR (ATOM G166721) -; (PROGN -; (SETQ |x| (CAR G166721)) -; NIL)) -; (NREVERSE0 G166716)) -; (SEQ (EXIT -; (SETQ G166716 -; (CONS -; (|checkAddIndented| |x| -; |margin|) -; G166716)))))))))) -; (SPADLET |$argl| (|checkGetArgs| (CAR |u|))) -; (SPADLET |u2| NIL) -; (SPADLET |verbatim| NIL) -; (DO ((G166732 |u| (CDR G166732)) (|x| NIL)) -; ((OR (ATOM G166732) -; (PROGN (SETQ |x| (CAR G166732)) NIL)) -; NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |w| (|newString2Words| |x|)) -; (COND -; (|verbatim| -; (COND -; ((AND |w| -; (BOOT-EQUAL (CAR |w|) -; "\\end{verbatim}")) -; (SPADLET |verbatim| NIL) -; (SPADLET |u2| (APPEND |u2| |w|))) -; ('T -; (SPADLET |u2| -; (APPEND |u2| (CONS |x| NIL)))))) -; ((AND |w| -; (BOOT-EQUAL (CAR |w|) -; "\\begin{verbatim}")) -; (SPADLET |verbatim| 'T) -; (SPADLET |u2| (APPEND |u2| |w|))) -; ('T (SPADLET |u2| (APPEND |u2| |w|)))))))) -; (SPADLET |u| |u2|) -; (SPADLET |u| (|checkAddSpaces| |u|)) -; (SPADLET |u| (|checkSplit2Words| |u|)) -; (SPADLET |u| (|checkAddMacros| |u|)) -; (SPADLET |u| (|checkTexht| |u|)) -; (SPADLET |okBefore| (NULL |$checkErrorFlag|)) -; (|checkArguments| |u|) -; (COND -; (|$checkErrorFlag| -; (SPADLET |u| (|checkFixCommonProblem| |u|)))) -; (|checkRecordHash| |u|) -; (|checkDecorateForHt| |u|)))))) - -;checkTexht u == -; count := 0 -; acc := nil -; while u repeat -; x := first u -; if x = '"\texht" and (u := IFCDR u) then -; if not (IFCAR u = $charLbrace) then -; checkDocError '"First left brace after \texht missing" -; count := 1 -- drop first argument including braces of \texht -; while ((y := IFCAR (u := rest u))^= $charRbrace or count > 1) repeat -; if y = $charLbrace then count := count + 1 -; if y = $charRbrace then count := count - 1 -; x := IFCAR (u := rest u) -- drop first right brace of 1st arg -; if x = '"\httex" and (u := IFCDR u) and (IFCAR u = $charLbrace) then -; acc := [IFCAR u,:acc] --left brace: add it -; while (y := IFCAR (u := rest u)) ^= $charRbrace repeat (acc := [y,:acc]) -; acc := [IFCAR u,:acc] --right brace: add it -; x := IFCAR (u := rest u) --left brace: forget it -; while IFCAR (u := rest u) ^= $charRbrace repeat 'skip -; x := IFCAR (u := rest u) --forget right brace: move to next char -; acc := [x,:acc] -; u := rest u -; NREVERSE acc - -;(DEFUN |checkTexht| (|u|) -; (PROG (|count| |y| |x| |acc|) -; (declare (special |$charRbrace| |$charLbrace|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |count| 0) -; (SPADLET |acc| NIL) -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |x| (CAR |u|)) -; (COND -; ((AND (BOOT-EQUAL |x| -; "\\texht") -; (SPADLET |u| (IFCDR |u|))) -; (COND -; ((NULL (BOOT-EQUAL (IFCAR |u|) -; |$charLbrace|)) -; (|checkDocError| -; "First left brace after \\texht missing"))) -; (SPADLET |count| 1) -; (DO () -; ((NULL -; (OR -; (NEQUAL -; (SPADLET |y| -; (IFCAR (SPADLET |u| (CDR |u|)))) -; |$charRbrace|) -; (> |count| 1))) -; NIL) -; (SEQ (EXIT -; (PROGN -; (COND -; ((BOOT-EQUAL |y| -; |$charLbrace|) -; (SPADLET |count| -; (PLUS |count| 1)))) -; (COND -; ((BOOT-EQUAL |y| -; |$charRbrace|) -; (SPADLET |count| -; (SPADDIFFERENCE |count| 1))) -; ('T NIL)))))) -; (SPADLET |x| -; (IFCAR (SPADLET |u| (CDR |u|)))))) -; (COND -; ((AND (BOOT-EQUAL |x| -; "\\httex") -; (SPADLET |u| (IFCDR |u|)) -; (BOOT-EQUAL (IFCAR |u|) -; |$charLbrace|)) -; (SPADLET |acc| (CONS (IFCAR |u|) |acc|)) -; (DO () -; ((NULL -; (NEQUAL -; (SPADLET |y| -; (IFCAR (SPADLET |u| (CDR |u|)))) -; |$charRbrace|)) -; NIL) -; (SEQ (EXIT -; (SPADLET |acc| (CONS |y| |acc|))))) -; (SPADLET |acc| (CONS (IFCAR |u|) |acc|)) -; (SPADLET |x| -; (IFCAR (SPADLET |u| (CDR |u|)))) -; (DO () -; ((NULL -; (NEQUAL -; (IFCAR (SPADLET |u| (CDR |u|))) -; |$charRbrace|)) -; NIL) -; (SEQ (EXIT '|skip|))) -; (SPADLET |x| -; (IFCAR (SPADLET |u| (CDR |u|)))))) -; (SPADLET |acc| (CONS |x| |acc|)) -; (SPADLET |u| (CDR |u|)))))) -; (NREVERSE |acc|)))))) - -;checkRecordHash u == -; while u repeat -; x := first u -; if STRINGP x and x.0 = $charBack then -; if MEMBER(x,$HTlinks) and (u := checkLookForLeftBrace IFCDR u) -; and (u := checkLookForRightBrace IFCDR u) -; and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then -; htname := intern IFCAR u -; entry := HGET($htHash,htname) or [nil] -; HPUT($htHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) -; else if MEMBER(x,$HTlisplinks) and (u := checkLookForLeftBrace IFCDR u) -; and (u := checkLookForRightBrace IFCDR u) -; and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then -; htname := intern checkGetLispFunctionName checkGetStringBeforeRightBrace u -; entry := HGET($lispHash,htname) or [nil] -; HPUT($lispHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) -; else if ((p := MEMBER(x,'("\gloss" "\spadglos"))) -; or (q := MEMBER(x,'("\glossSee" "\spadglosSee")))) -; and (u := checkLookForLeftBrace IFCDR u) -; and (u := IFCDR u) then -; if q then -; u := checkLookForRightBrace u -; u := checkLookForLeftBrace IFCDR u -; u := IFCDR u -; htname := intern checkGetStringBeforeRightBrace u -; entry := HGET($glossHash,htname) or [nil] -; HPUT($glossHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) -; else if x = '"\spadsys" and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then -; s := checkGetStringBeforeRightBrace u -; if s.0 = char '_) then s := SUBSTRING(s,1,nil) -; parse := checkGetParse s -; null parse => checkDocError ['"Unparseable \spadtype: ",s] -; not MEMBER(opOf parse,$currentSysList) => -; checkDocError ['"Bad system command: ",s] -; atom parse or not (parse is ['set,arg]) => 'ok ---assume ok -; not spadSysChoose($setOptions,arg) => -; checkDocError ['"Incorrect \spadsys: ",s] -; entry := HGET($sysHash,htname) or [nil] -; HPUT($sysHash,htname,[first entry,:[[$name,:$origin],:rest entry]]) -; else if x = '"\spadtype" and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then -; s := checkGetStringBeforeRightBrace u -; parse := checkGetParse s -; null parse => checkDocError ['"Unparseable \spadtype: ",s] -; n := checkNumOfArgs parse -; null n => checkDocError ['"Unknown \spadtype: ", s] -; atom parse and n > 0 => 'skip -; null (key := checkIsValidType parse) => -; checkDocError ['"Unknown \spadtype: ", s] -; atom key => 'ok -; checkDocError ['"Wrong number of arguments: ",form2HtString key] -; else if MEMBER(x,'("\spadop" "\keyword")) and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then -; x := intern checkGetStringBeforeRightBrace u -; not (GET(x,'Led) or GET(x,'Nud)) => -; checkDocError ['"Unknown \spadop: ",x] -; u := rest u -; 'done - -;(DEFUN |checkRecordHash| (|u|) -; (PROG (|p| |q| |htname| |ISTMP#1| |arg| |entry| |s| |parse| |n| |key| |x|) -; (declare (special |$origin| |$name| |$sysHash| |$setOptions| |$glossHash| -; |$currentSysList| |$lispHash| |$HTlisplinks| |$htHash| -; |$HTlinks| |$charBack|)) -; (RETURN -; (SEQ (PROGN -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |x| (CAR |u|)) -; (COND -; ((AND (STRINGP |x|) -; (BOOT-EQUAL (ELT |x| 0) -; |$charBack|)) -; (COND -; ((AND (|member| |x| |$HTlinks|) -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| -; (|checkLookForRightBrace| -; (IFCDR |u|))) -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| (IFCDR |u|))) -; (SPADLET |htname| -; (|intern| (IFCAR |u|))) -; (SPADLET |entry| -; (OR -; (HGET |$htHash| |htname|) -; (CONS NIL NIL))) -; (HPUT |$htHash| |htname| -; (CONS (CAR |entry|) -; (CONS (CONS |$name| |$origin|) -; (CDR |entry|))))) -; ((AND (|member| |x| |$HTlisplinks|) -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| -; (|checkLookForRightBrace| -; (IFCDR |u|))) -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| (IFCDR |u|))) -; (SPADLET |htname| -; (|intern| -; (|checkGetLispFunctionName| -; (|checkGetStringBeforeRightBrace| -; |u|)))) -; (SPADLET |entry| -; (OR -; (HGET |$lispHash| |htname|) -; (CONS NIL NIL))) -; (HPUT |$lispHash| |htname| -; (CONS (CAR |entry|) -; (CONS (CONS |$name| |$origin|) -; (CDR |entry|))))) -; ((AND (OR -; (SPADLET |p| -; (|member| |x| -; '("\\gloss" "\\spadglos"))) -; (SPADLET |q| -; (|member| |x| -; '("\\glossSee" -; "\\spadglosSee")))) -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| (IFCDR |u|))) -; (COND -; (|q| -; (SPADLET |u| -; (|checkLookForRightBrace| |u|)) -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| (IFCDR |u|)))) -; (SPADLET |htname| -; (|intern| -; (|checkGetStringBeforeRightBrace| -; |u|))) -; (SPADLET |entry| -; (OR -; (HGET |$glossHash| -; |htname|) -; (CONS NIL NIL))) -; (HPUT |$glossHash| |htname| -; (CONS (CAR |entry|) -; (CONS (CONS |$name| |$origin|) -; (CDR |entry|))))) -; ((AND (BOOT-EQUAL |x| -; "\\spadsys") -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| (IFCDR |u|))) -; (SPADLET |s| -; (|checkGetStringBeforeRightBrace| -; |u|)) -; (COND -; ((BOOT-EQUAL (ELT |s| 0) -; (|char| '|)|)) -; (SPADLET |s| -; (SUBSTRING |s| 1 NIL)))) -; (SPADLET |parse| -; (|checkGetParse| |s|)) -; (COND -; ((NULL |parse|) -; (|checkDocError| -; (CONS -; "Unparseable \\spadtype: " -; (CONS |s| NIL)))) -; ((NULL -; (|member| (|opOf| |parse|) -; |$currentSysList|)) -; (|checkDocError| -; (CONS -; "Bad system command: " -; (CONS |s| NIL)))) -; ((OR (ATOM |parse|) -; (NULL -; (AND (CONSP |parse|) -; (EQ (QCAR |parse|) '|set|) -; (PROGN -; (SPADLET |ISTMP#1| -; (QCDR |parse|)) -; (AND (CONSP |ISTMP#1|) -; (EQ (QCDR |ISTMP#1|) NIL) -; (PROGN -; (SPADLET |arg| -; (QCAR |ISTMP#1|)) -; 'T)))))) -; '|ok|) -; ((NULL -; (|spadSysChoose| |$setOptions| -; |arg|)) -; (PROGN -; (|checkDocError| -; (CONS -; "Incorrect \\spadsys: " -; (CONS |s| NIL))) -; (SPADLET |entry| -; (OR (HGET |$sysHash| |htname|) -; (CONS NIL NIL))) -; (HPUT |$sysHash| |htname| -; (CONS (CAR |entry|) -; (CONS (CONS |$name| |$origin|) -; (CDR |entry|)))))))) -; ((AND (BOOT-EQUAL |x| -; "\\spadtype") -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| (IFCDR |u|))) -; (SPADLET |s| -; (|checkGetStringBeforeRightBrace| -; |u|)) -; (SPADLET |parse| -; (|checkGetParse| |s|)) -; (COND -; ((NULL |parse|) -; (|checkDocError| -; (CONS -; "Unparseable \\spadtype: " -; (CONS |s| NIL)))) -; ('T -; (SPADLET |n| -; (|checkNumOfArgs| |parse|)) -; (COND -; ((NULL |n|) -; (|checkDocError| -; (CONS -; "Unknown \\spadtype: " -; (CONS |s| NIL)))) -; ((AND (ATOM |parse|) (> |n| 0)) -; '|skip|) -; ((NULL -; (SPADLET |key| -; (|checkIsValidType| |parse|))) -; (|checkDocError| -; (CONS -; "Unknown \\spadtype: " -; (CONS |s| NIL)))) -; ((ATOM |key|) '|ok|) -; ('T -; (|checkDocError| -; (CONS -; "Wrong number of arguments: " -; (CONS (|form2HtString| |key|) -; NIL)))))))) -; ((AND (|member| |x| -; '("\\spadop" "\\keyword")) -; (SPADLET |u| -; (|checkLookForLeftBrace| -; (IFCDR |u|))) -; (SPADLET |u| (IFCDR |u|))) -; (SPADLET |x| -; (|intern| -; (|checkGetStringBeforeRightBrace| -; |u|))) -; (COND -; ((NULL -; (OR (GETL |x| '|Led|) -; (GETL |x| '|Nud|))) -; (|checkDocError| -; (CONS -; "Unknown \\spadop: " -; (CONS |x| NIL)))))) -; ('T NIL)))) -; (SPADLET |u| (CDR |u|)))))) -; '|done|))))) -; -;;checkGetParse s == ncParseFromString removeBackslashes s -; -;(DEFUN |checkGetParse| (|s|) -; (|ncParseFromString| (|removeBackslashes| |s|))) -; -;removeBackslashes s == -; s = '"" => '"" -; (k := charPosition($charBack,s,0)) < #s => -; k = 0 => removeBackslashes SUBSTRING(s,1,nil) -; STRCONC(SUBSTRING(s,0,k),removeBackslashes SUBSTRING(s,k + 1,nil)) -; s - -(DEFUN |removeBackslashes| (|s|) - (PROG (|k|) - (declare (special |$charBack|)) - (RETURN - (COND - ((BOOT-EQUAL |s| "") "") - ((> (|#| |s|) (SPADLET |k| (|charPosition| |$charBack| |s| 0))) - (COND - ((EQL |k| 0) (|removeBackslashes| (SUBSTRING |s| 1 NIL))) - ('T - (STRCONC (SUBSTRING |s| 0 |k|) - (|removeBackslashes| - (SUBSTRING |s| (PLUS |k| 1) NIL)))))) - ('T |s|))))) - -;checkNumOfArgs conform == -; conname := opOf conform -; constructor? conname or (conname := abbreviation? conname) => -; #GETDATABASE(conname,'CONSTRUCTORARGS) -; nil --signals error - -(DEFUN |checkNumOfArgs| (|conform|) - (PROG (|conname|) - (RETURN - (PROGN - (SPADLET |conname| (|opOf| |conform|)) - (COND - ((OR (|constructor?| |conname|) - (SPADLET |conname| (|abbreviation?| |conname|))) - (|#| (GETDATABASE |conname| 'CONSTRUCTORARGS))) - ('T NIL)))))) - -;checkIsValidType form == main where -;--returns ok if correct, form is wrong number of arguments, nil if unknown -; main == -; atom form => 'ok -; [op,:args] := form -; conname := (constructor? op => op; abbreviation? op) -; null conname => nil -; fn(form,GETDATABASE(conname,'COSIG)) -; fn(form,coSig) == -; #form ^= #coSig => form -; or/[null checkIsValidType x for x in rest form for flag in rest coSig | flag] -; => nil -; 'ok - -(DEFUN |checkIsValidType,fn| (|form| |coSig|) - (PROG () - (RETURN - (SEQ (IF (NEQUAL (|#| |form|) (|#| |coSig|)) (EXIT |form|)) - (IF (PROG (G166927) - (SPADLET G166927 NIL) - (RETURN - (DO ((G166935 NIL G166927) - (G166936 (CDR |form|) (CDR G166936)) - (|x| NIL) - (G166937 (CDR |coSig|) (CDR G166937)) - (|flag| NIL)) - ((OR G166935 (ATOM G166936) - (PROGN (SETQ |x| (CAR G166936)) NIL) - (ATOM G166937) - (PROGN (SETQ |flag| (CAR G166937)) NIL)) - G166927) - (SEQ (EXIT (COND - (|flag| (SETQ G166927 - (OR G166927 - (NULL - (|checkIsValidType| |x|))))))))))) - (EXIT NIL)) - (EXIT '|ok|))))) - -(DEFUN |checkIsValidType| (|form|) - (PROG (|op| |args| |conname|) - (RETURN - (COND - ((ATOM |form|) '|ok|) - ('T (SPADLET |op| (CAR |form|)) (SPADLET |args| (CDR |form|)) - (SPADLET |conname| - (COND - ((|constructor?| |op|) |op|) - ('T (|abbreviation?| |op|)))) - (COND - ((NULL |conname|) NIL) - ('T - (|checkIsValidType,fn| |form| - (GETDATABASE |conname| 'COSIG))))))))) - -;checkGetLispFunctionName s == -; n := #s -; (k := charPosition(char '_|,s,1)) and k < n and -; (j := charPosition(char '_|,s,k + 1)) and j < n => SUBSTRING(s,k + 1,j-k-1) -; checkDocError ['"Ill-formed lisp expression : ",s] -; 'illformed - -(DEFUN |checkGetLispFunctionName| (|s|) - (PROG (|n| |k| |j|) - (RETURN - (PROGN - (SPADLET |n| (|#| |s|)) - (COND - ((AND (SPADLET |k| (|charPosition| (|char| '|\||) |s| 1)) - (> |n| |k|) - (SPADLET |j| - (|charPosition| (|char| '|\||) |s| - (PLUS |k| 1))) - (> |n| |j|)) - (SUBSTRING |s| (PLUS |k| 1) - (SPADDIFFERENCE (SPADDIFFERENCE |j| |k|) 1))) - ('T - (|checkDocError| - (CONS "Ill-formed lisp expression : " - (CONS |s| NIL))) - '|illformed|)))))) - -;checkGetStringBeforeRightBrace u == -; acc := nil -; while u repeat -; x := first u -; x = $charRbrace => return "STRCONC"/(NREVERSE acc) -; acc := [x,:acc] -; u := rest u - -(DEFUN |checkGetStringBeforeRightBrace| (|u|) - (PROG (|x| |acc|) - (declare (special |$charRbrace|)) - (RETURN - (SEQ (PROGN - (SPADLET |acc| NIL) - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |x| (CAR |u|)) - (COND - ((BOOT-EQUAL |x| |$charRbrace|) - (RETURN - (PROG (G166979) - (SPADLET G166979 "") - (RETURN - (DO - ((G166984 (NREVERSE |acc|) - (CDR G166984)) - (G166968 NIL)) - ((OR (ATOM G166984) - (PROGN - (SETQ G166968 - (CAR G166984)) - NIL)) - G166979) - (SEQ - (EXIT - (SETQ G166979 - (STRCONC G166979 G166968))))))))) - ('T (SPADLET |acc| (CONS |x| |acc|)) - (SPADLET |u| (CDR |u|))))))))))))) - -;-- checkTranVerbatim u == -;-- acc := nil -;-- while u repeat -;-- x := first u -;-- x = '"\begin" and checkTranVerbatimMiddle u is [middle,:r] => -;-- acc := [$charRbrace,:middle,$charLbrace,'"\spadpaste",:acc] -;-- u := r -;-- if x = '"\spadcommand" then x := '"\spadpaste" -;-- acc := [x,:acc] -;-- u := rest u -;-- NREVERSE acc -;-- -;-- checkTranVerbatimMiddle u == -;-- (y := IFCAR (v := IFCDR u)) = $charLbrace and -;-- (y := IFCAR (v := IFCDR v)) = '"verbatim" and -;-- (y := IFCAR (v := IFCDR v)) = $charRbrace => -;-- w := IFCDR v -;-- middle := nil -;-- while w and (z := first w) ^= '"\end" repeat -;-- middle := [z,:middle] -;-- w := rest w -;-- if (y := IFCAR (w := IFCDR w)) = $charLbrace and -;-- (y := IFCAR (w := IFCDR w)) = '"verbatim" and -;-- (y := IFCAR (w := IFCDR w)) = $charRbrace then -;-- u := IFCDR w -;-- else -;-- checkDocError '"Missing \end{verbatim}" -;-- u := w -;-- [middle,:u] -;-- -;-- checkTranVerbatim1 u == -;-- acc := nil -;-- while u repeat -;-- x := first u -;-- x = '"\begin" and (y := IFCAR (v := IFCDR u)) = $charLbrace and -;-- (y := IFCAR (v := IFCDR v)) = '"verbatim" and -;-- (y := IFCAR (v := IFCDR v)) = $charRbrace => -;-- w := IFCDR v -;-- middle := nil -;-- while w and (z := first w) ^= '"\end" repeat -;-- middle := [z,:middle] -;-- w := rest w -;-- if (y := IFCAR (w := IFCDR w)) = $charLbrace and -;-- (y := IFCAR (w := IFCDR w)) = '"verbatim" and -;-- (y := IFCAR (w := IFCDR w)) = $charRbrace then -;-- u := IFCDR w -;-- acc := [$charRbrace,:middle,$charLbrace,'"\spadpaste",:acc] -;-- if x = '"\spadcommand" then x := '"\spadpaste" -;-- acc := [x,:acc] -;-- u := rest u -;-- NREVERSE acc -;appendOver [head,:tail] == -; acc := LASTNODE head -; for x in tail repeat -; end := LASTNODE x -; RPLACD(acc,x) -; acc := end -; head - -(DEFUN |appendOver| (G167000) - (PROG (|head| |tail| |end| |acc|) - (RETURN - (SEQ (PROGN - (SPADLET |head| (CAR G167000)) - (SPADLET |tail| (CDR G167000)) - (SPADLET |acc| (LASTNODE |head|)) - (DO ((G167015 |tail| (CDR G167015)) (|x| NIL)) - ((OR (ATOM G167015) - (PROGN (SETQ |x| (CAR G167015)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |end| (LASTNODE |x|)) - (RPLACD |acc| |x|) - (SPADLET |acc| |end|))))) - |head|))))) - -;checkRemoveComments lines == -; while lines repeat -; do -; line := checkTrimCommented first lines -; if firstNonBlankPosition line >= 0 then acc := [line,:acc] -; lines := rest lines -; NREVERSE acc - -(DEFUN |checkRemoveComments| (|lines|) - (PROG (|line| |acc|) - (RETURN - (SEQ (PROGN - (DO () ((NULL |lines|) NIL) - (SEQ (EXIT (PROGN - (|do| (PROGN - (SPADLET |line| - (|checkTrimCommented| - (CAR |lines|))) - (COND - ((>= - (|firstNonBlankPosition| - |line|) - 0) - (SPADLET |acc| - (CONS |line| |acc|))) - ('T NIL)))) - (SPADLET |lines| (CDR |lines|)))))) - (NREVERSE |acc|)))))) - -;checkTrimCommented line == -; n := #line -; k := htcharPosition(char '_%,line,0) -; --line beginning with % is a comment -; k = 0 => '"" -; --remarks beginning with %% are comments -; k >= n - 1 or line.(k + 1) ^= char '_% => line -; k < #line => SUBSTRING(line,0,k) -; line - -(DEFUN |checkTrimCommented| (|line|) - (PROG (|n| |k|) - (RETURN - (PROGN - (SPADLET |n| (|#| |line|)) - (SPADLET |k| (|htcharPosition| (|char| '%) |line| 0)) - (COND - ((EQL |k| 0) "") - ((OR (>= |k| (SPADDIFFERENCE |n| 1)) - (NEQUAL (ELT |line| (PLUS |k| 1)) (|char| '%))) - |line|) - ((> (|#| |line|) |k|) (SUBSTRING |line| 0 |k|)) - ('T |line|)))))) - -;htcharPosition(char,line,i) == -; m := #line -; k := charPosition(char,line,i) -; k = m => k -; k > 0 => -; line.(k - 1) ^= $charBack => k -; htcharPosition(char,line,k + 1) -; 0 - -(DEFUN |htcharPosition| (|char| |line| |i|) - (PROG (|m| |k|) - (declare (special |$charBack|)) - (RETURN - (PROGN - (SPADLET |m| (|#| |line|)) - (SPADLET |k| (|charPosition| |char| |line| |i|)) - (COND - ((BOOT-EQUAL |k| |m|) |k|) - ((> |k| 0) - (COND - ((NEQUAL (ELT |line| (SPADDIFFERENCE |k| 1)) |$charBack|) - |k|) - ('T (|htcharPosition| |char| |line| (PLUS |k| 1))))) - ('T 0)))))) - -;checkAddMacros u == -; acc := nil -; verbatim := false -; while u repeat -; x := first u -; acc := -; x = '"\end{verbatim}" => -; verbatim := false -; [x, :acc] -; verbatim => [x, :acc] -; x = '"\begin{verbatim}" => -; verbatim := true -; [x, :acc] -; y := LASSOC(x,$HTmacs) => [:y,:acc] -; [x,:acc] -; u := rest u -; NREVERSE acc - -(DEFUN |checkAddMacros| (|u|) - (PROG (|x| |verbatim| |y| |acc|) - (declare (special |$HTmacs|)) - (RETURN - (SEQ (PROGN - (SPADLET |acc| NIL) - (SPADLET |verbatim| NIL) - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |x| (CAR |u|)) - (SPADLET |acc| - (COND - ((BOOT-EQUAL |x| - "\\end{verbatim}") - (SPADLET |verbatim| NIL) - (CONS |x| |acc|)) - (|verbatim| (CONS |x| |acc|)) - ((BOOT-EQUAL |x| - "\\begin{verbatim}") - (SPADLET |verbatim| 'T) - (CONS |x| |acc|)) - ((SPADLET |y| - (LASSOC |x| |$HTmacs|)) - (APPEND |y| |acc|)) - ('T (CONS |x| |acc|)))) - (SPADLET |u| (CDR |u|)))))) - (NREVERSE |acc|)))))) - -;checkComments(nameSig,lines) == main where -; main == -; $checkErrorFlag: local := false -; margin := checkGetMargin lines -; if (null BOUNDP '$attribute? or null $attribute?) -; and nameSig ^= 'constructor then lines := -; [checkTransformFirsts(first nameSig,first lines,margin),:rest lines] -; u := checkIndentedLines(lines, margin) -; $argl := checkGetArgs first u --set $argl -; u2 := nil -; verbatim := nil -; for x in u repeat -; w := newString2Words x -; verbatim => -; w and first w = '"\end{verbatim}" => -; verbatim := false -; u2 := append(u2, w) -; u2 := append(u2, [x]) -; w and first w = '"\begin{verbatim}" => -; verbatim := true -; u2 := append(u2, w) -; u2 := append(u2, w) -; u := u2 -; u := checkAddSpaces u -; u := checkIeEg u -; u := checkSplit2Words u -; checkBalance u -; okBefore := null $checkErrorFlag -; checkArguments u -; if $checkErrorFlag then u := checkFixCommonProblem u -; v := checkDecorate u -; res := "STRCONC"/[y for y in v] -; res := checkAddPeriod res -; if $checkErrorFlag then pp res -; res - -;(DEFUN |checkComments| (|nameSig| |lines|) -; (PROG (|$checkErrorFlag| |margin| |w| |verbatim| |u2| |okBefore| |u| -; |v| |res|) -; (DECLARE (SPECIAL |$checkErrorFlag| |$argl| |$attribute?|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |$checkErrorFlag| NIL) -; (SPADLET |margin| (|checkGetMargin| |lines|)) -; (COND -; ((AND (OR (NULL (BOUNDP '|$attribute?|)) -; (NULL |$attribute?|)) -; (NEQUAL |nameSig| '|constructor|)) -; (SPADLET |lines| -; (CONS (|checkTransformFirsts| (CAR |nameSig|) -; (CAR |lines|) |margin|) -; (CDR |lines|))))) -; (SPADLET |u| (|checkIndentedLines| |lines| |margin|)) -; (SPADLET |$argl| (|checkGetArgs| (CAR |u|))) -; (SPADLET |u2| NIL) -; (SPADLET |verbatim| NIL) -; (DO ((G167097 |u| (CDR G167097)) (|x| NIL)) -; ((OR (ATOM G167097) -; (PROGN (SETQ |x| (CAR G167097)) NIL)) -; NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |w| (|newString2Words| |x|)) -; (COND -; (|verbatim| -; (COND -; ((AND |w| -; (BOOT-EQUAL (CAR |w|) -; "\\end{verbatim}")) -; (SPADLET |verbatim| NIL) -; (SPADLET |u2| (APPEND |u2| |w|))) -; ('T -; (SPADLET |u2| -; (APPEND |u2| (CONS |x| NIL)))))) -; ((AND |w| -; (BOOT-EQUAL (CAR |w|) -; "\\begin{verbatim}")) -; (SPADLET |verbatim| 'T) -; (SPADLET |u2| (APPEND |u2| |w|))) -; ('T (SPADLET |u2| (APPEND |u2| |w|)))))))) -; (SPADLET |u| |u2|) -; (SPADLET |u| (|checkAddSpaces| |u|)) -; (SPADLET |u| (|checkIeEg| |u|)) -; (SPADLET |u| (|checkSplit2Words| |u|)) -; (|checkBalance| |u|) -; (SPADLET |okBefore| (NULL |$checkErrorFlag|)) -; (|checkArguments| |u|) -; (COND -; (|$checkErrorFlag| -; (SPADLET |u| (|checkFixCommonProblem| |u|)))) -; (SPADLET |v| (|checkDecorate| |u|)) -; (SPADLET |res| -; (PROG (G167103) -; (SPADLET G167103 "") -; (RETURN -; (DO ((G167108 |v| (CDR G167108)) -; (|y| NIL)) -; ((OR (ATOM G167108) -; (PROGN -; (SETQ |y| (CAR G167108)) -; NIL)) -; G167103) -; (SEQ (EXIT (SETQ G167103 -; (STRCONC G167103 |y|)))))))) -; (SPADLET |res| (|checkAddPeriod| |res|)) -; (COND (|$checkErrorFlag| (|pp| |res|))) -; |res|))))) -; -;checkIndentedLines(u, margin) == -; verbatim := false -; u2 := nil -; for x in u repeat -; k := firstNonBlankPosition x -; k = -1 => -; verbatim => u2 := [:u2, $charFauxNewline] -; u2 := [:u2, '"\blankline "] -; s := SUBSTRING(x, k, nil) -; s = '"\begin{verbatim}" => -; verbatim := true -; u2 := [:u2, s] -; s = '"\end{verbatim}" => -; verbatim := false -; u2 := [:u2, s] -; verbatim => u2 := [:u2, SUBSTRING(x, margin, nil)] -; margin = k => u2 := [:u2, s] -; u2 := [:u2, STRCONC('"\indented{",STRINGIMAGE(k-margin),'"}{",checkAddSpaceSegments(s,0),'"}")] -; u2 - -(DEFUN |checkIndentedLines| (|u| |margin|) - (PROG (|k| |s| |verbatim| |u2|) - (declare (special |$charFauxNewline|)) - (RETURN - (SEQ (PROGN - (SPADLET |verbatim| NIL) - (SPADLET |u2| NIL) - (DO ((G167153 |u| (CDR G167153)) (|x| NIL)) - ((OR (ATOM G167153) - (PROGN (SETQ |x| (CAR G167153)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |k| (|firstNonBlankPosition| |x|)) - (COND - ((BOOT-EQUAL |k| (SPADDIFFERENCE 1)) - (COND - (|verbatim| - (SPADLET |u2| - (APPEND |u2| - (CONS |$charFauxNewline| NIL)))) - ('T - (SPADLET |u2| - (APPEND |u2| - (CONS - "\\blankline " - NIL)))))) - ('T (SPADLET |s| (SUBSTRING |x| |k| NIL)) - (COND - ((BOOT-EQUAL |s| - "\\begin{verbatim}") - (SPADLET |verbatim| 'T) - (SPADLET |u2| - (APPEND |u2| (CONS |s| NIL)))) - ((BOOT-EQUAL |s| - "\\end{verbatim}") - (SPADLET |verbatim| NIL) - (SPADLET |u2| - (APPEND |u2| (CONS |s| NIL)))) - (|verbatim| - (SPADLET |u2| - (APPEND |u2| - (CONS - (SUBSTRING |x| |margin| NIL) - NIL)))) - ((BOOT-EQUAL |margin| |k|) - (SPADLET |u2| - (APPEND |u2| (CONS |s| NIL)))) - ('T - (SPADLET |u2| - (APPEND |u2| - (CONS - (STRCONC - "\\indented{" - (STRINGIMAGE - (SPADDIFFERENCE |k| - |margin|)) - "}{" - (|checkAddSpaceSegments| - |s| 0) - "}") - NIL))))))))))) - |u2|))))) - -;newString2Words l == -; not STRINGP l => [l] -; m := MAXINDEX l -; m = -1 => NIL -; i := 0 -; [w while newWordFrom(l,i,m) is [w,i]] - -(DEFUN |newString2Words| (|l|) - (PROG (|m| |ISTMP#1| |w| |ISTMP#2| |i|) - (RETURN - (SEQ (COND - ((NULL (STRINGP |l|)) (CONS |l| NIL)) - ('T (SPADLET |m| (MAXINDEX |l|)) - (COND - ((BOOT-EQUAL |m| (SPADDIFFERENCE 1)) NIL) - ('T (SPADLET |i| 0) - (PROG (G167196) - (SPADLET G167196 NIL) - (RETURN - (DO () - ((NULL (PROGN - (SPADLET |ISTMP#1| - (|newWordFrom| |l| |i| |m|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SPADLET |w| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |i| - (QCAR |ISTMP#2|)) - 'T)))))) - (NREVERSE0 G167196)) - (SEQ (EXIT (SETQ G167196 (CONS |w| G167196))))))))))))))) - -;newWordFrom(l,i,m) == -; while i <= m and l.i = " " repeat i := i + 1 -; i > m => NIL -; buf := '"" -; ch := l.i -; ch = $charFauxNewline => [$stringFauxNewline, i+ 1] -; done := false -; while i <= m and not done repeat -; ch := l.i -; ch = $charBlank or ch = $charFauxNewline => done := true -; buf := STRCONC(buf,ch) -; i := i + 1 -; [buf,i] - -(DEFUN |newWordFrom| (|l| |i| |m|) - (PROG (|ch| |done| |buf|) - (declare (special |$charFauxNewline| |$charBlank| |$stringFauxNewline|)) - (RETURN - (SEQ (PROGN - (DO () - ((NULL (AND (<= |i| |m|) - (BOOT-EQUAL (ELT |l| |i|) '| |))) - NIL) - (SEQ (EXIT (SPADLET |i| (PLUS |i| 1))))) - (COND - ((> |i| |m|) NIL) - ('T (SPADLET |buf| "") - (SPADLET |ch| (ELT |l| |i|)) - (COND - ((BOOT-EQUAL |ch| |$charFauxNewline|) - (CONS |$stringFauxNewline| (CONS (PLUS |i| 1) NIL))) - ('T (SPADLET |done| NIL) - (DO () ((NULL (AND (<= |i| |m|) (NULL |done|))) NIL) - (SEQ (EXIT (PROGN - (SPADLET |ch| (ELT |l| |i|)) - (COND - ((OR (BOOT-EQUAL |ch| |$charBlank|) - (BOOT-EQUAL |ch| - |$charFauxNewline|)) - (SPADLET |done| 'T)) - ('T - (SPADLET |buf| - (STRCONC |buf| |ch|)) - (SPADLET |i| (PLUS |i| 1)))))))) - (CONS |buf| (CONS |i| NIL))))))))))) - -;checkAddPeriod s == --No, just leave blank at the end (rdj: 10/18/91) -; m := MAXINDEX s -; lastChar := s . m -; lastChar = char '_! or lastChar = char '_? or lastChar = char '_. => s -; lastChar = char '_, or lastChar = char '_; => -; s . m := (char '_.) -; s -; s - -;(DEFUN |checkAddPeriod| (|s|) -; (PROG (|m| |lastChar|) -; (RETURN -; (PROGN -; (SPADLET |m| (MAXINDEX |s|)) -; (SPADLET |lastChar| (ELT |s| |m|)) -; (COND -; ((OR (BOOT-EQUAL |lastChar| (|char| '!)) -; (BOOT-EQUAL |lastChar| (|char| '?)) -; (BOOT-EQUAL |lastChar| (|char| (INTERN "." "BOOT")))) -; |s|) -; ((OR (BOOT-EQUAL |lastChar| (|char| '|,|)) -; (BOOT-EQUAL |lastChar| (|char| '|;|))) -; (SETELT |s| |m| (|char| (INTERN "." "BOOT"))) |s|) -; ('T |s|)))))) - -;checkGetArgs u == -; NOT STRINGP u => nil -; m := MAXINDEX u -; k := firstNonBlankPosition(u) -; k > 0 => checkGetArgs SUBSTRING(u,k,nil) -; stringPrefix?('"\spad{",u) => -; k := getMatchingRightPren(u,6,char '_{,char '_}) or m -; checkGetArgs SUBSTRING(u,6,k-6) -; (i := charPosition(char '_(,u,0)) > m => nil -; (u . m) ^= char '_) => nil -; while (k := charPosition($charComma,u,i + 1)) < m repeat -; acc := [trimString SUBSTRING(u,i + 1,k - i - 1),:acc] -; i := k -; NREVERSE [SUBSTRING(u,i + 1,m - i - 1),:acc] - -(DEFUN |checkGetArgs| (|u|) - (PROG (|m| |k| |acc| |i|) - (declare (special |$charComma|)) - (RETURN - (SEQ (COND - ((NULL (STRINGP |u|)) NIL) - ('T (SPADLET |m| (MAXINDEX |u|)) - (SPADLET |k| (|firstNonBlankPosition| |u|)) - (COND - ((> |k| 0) (|checkGetArgs| (SUBSTRING |u| |k| NIL))) - ((|stringPrefix?| "\\spad{" |u|) - (SPADLET |k| - (OR (|getMatchingRightPren| |u| 6 (|char| '{) - (|char| '})) - |m|)) - (|checkGetArgs| - (SUBSTRING |u| 6 (SPADDIFFERENCE |k| 6)))) - ((> (SPADLET |i| (|charPosition| (|char| '|(|) |u| 0)) - |m|) - NIL) - ((NEQUAL (ELT |u| |m|) (|char| '|)|)) NIL) - ('T - (DO () - ((NULL (> |m| - (SPADLET |k| - (|charPosition| |$charComma| - |u| (PLUS |i| 1))))) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |acc| - (CONS - (|trimString| - (SUBSTRING |u| (PLUS |i| 1) - (SPADDIFFERENCE - (SPADDIFFERENCE |k| |i|) - 1))) - |acc|)) - (SPADLET |i| |k|))))) - (NREVERSE - (CONS (SUBSTRING |u| (PLUS |i| 1) - (SPADDIFFERENCE (SPADDIFFERENCE |m| |i|) - 1)) - |acc|)))))))))) - -;checkGetMargin lines == -; while lines repeat -; do -; x := first lines -; k := firstNonBlankPosition x -; k = -1 => nil -; margin := (margin => MIN(margin,k); k) -; lines := rest lines -; margin or 0 - -;(DEFUN |checkGetMargin| (|lines|) -; (PROG (|x| |k| |margin|) -; (RETURN -; (SEQ (PROGN -; (DO () ((NULL |lines|) NIL) -; (SEQ (EXIT (PROGN -; (|do| (PROGN -; (SPADLET |x| (CAR |lines|)) -; (SPADLET |k| -; (|firstNonBlankPosition| |x|)) -; (COND -; ((BOOT-EQUAL |k| -; (SPADDIFFERENCE 1)) -; NIL) -; ('T -; (SPADLET |margin| -; (COND -; (|margin| (MIN |margin| |k|)) -; ('T |k|))))))) -; (SPADLET |lines| (CDR |lines|)))))) -; (OR |margin| 0)))))) - -;firstNonBlankPosition(x,:options) == -; start := IFCAR options or 0 -; k := -1 -; for i in start..MAXINDEX x repeat -; if x.i ^= $charBlank then return (k := i) -; k - -;(DEFUN |firstNonBlankPosition| (&REST G167305 &AUX |options| |x|) -; (DSETQ (|x| . |options|) G167305) -; (PROG (|start| |k|) -; (declare (special |$charBlank|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |start| (OR (IFCAR |options|) 0)) -; (SPADLET |k| (SPADDIFFERENCE 1)) -; (DO ((G167295 (MAXINDEX |x|)) (|i| |start| (+ |i| 1))) -; ((> |i| G167295) NIL) -; (SEQ (EXIT (COND -; ((NEQUAL (ELT |x| |i|) |$charBlank|) -; (RETURN (SPADLET |k| |i|))) -; ('T NIL))))) -; |k|))))) - -;checkAddIndented(x,margin) == -; k := firstNonBlankPosition x -; k = -1 => '"\blankline " -; margin = k => x -; STRCONC('"\indented{",STRINGIMAGE(k-margin),'"}{",checkAddSpaceSegments(SUBSTRING(x,k,nil),0),'"}") - -(DEFUN |checkAddIndented| (|x| |margin|) - (PROG (|k|) - (RETURN - (PROGN - (SPADLET |k| (|firstNonBlankPosition| |x|)) - (COND - ((BOOT-EQUAL |k| (SPADDIFFERENCE 1)) - "\\blankline ") - ((BOOT-EQUAL |margin| |k|) |x|) - ('T - (STRCONC "\\indented{" - (STRINGIMAGE (SPADDIFFERENCE |k| |margin|)) - "}{" - (|checkAddSpaceSegments| (SUBSTRING |x| |k| NIL) 0) - "}"))))))) - -;checkAddSpaceSegments(u,k) == -; m := MAXINDEX u -; i := charPosition($charBlank,u,k) -; m < i => u -; j := i -; while (j := j + 1) < m and u.j = (char '_ ) repeat 'continue -; n := j - i --number of blanks -; n > 1 => STRCONC(SUBSTRING(u,0,i),'"\space{", -; STRINGIMAGE n,'"}",checkAddSpaceSegments(SUBSTRING(u,i + n,nil),0)) -; checkAddSpaceSegments(u,j) - -(DEFUN |checkAddSpaceSegments| (|u| |k|) - (PROG (|m| |i| |j| |n|) - (declare (special |$charBlank|)) - (RETURN - (SEQ (PROGN - (SPADLET |m| (MAXINDEX |u|)) - (SPADLET |i| (|charPosition| |$charBlank| |u| |k|)) - (COND - ((> |i| |m|) |u|) - ('T (SPADLET |j| |i|) - (DO () - ((NULL (AND (> |m| (SPADLET |j| (PLUS |j| 1))) - (BOOT-EQUAL (ELT |u| |j|) - (|char| '| |)))) - NIL) - (SEQ (EXIT '|continue|))) - (SPADLET |n| (SPADDIFFERENCE |j| |i|)) - (COND - ((> |n| 1) - (STRCONC (SUBSTRING |u| 0 |i|) - "\\space{" (STRINGIMAGE |n|) - "}" - (|checkAddSpaceSegments| - (SUBSTRING |u| (PLUS |i| |n|) NIL) 0))) - ('T (|checkAddSpaceSegments| |u| |j|)))))))))) - -;checkTrim($x,lines) == main where -; main == -; s := [wherePP first lines] -; for x in rest lines repeat -; j := wherePP x -; if not MEMQ(j,s) then -; checkDocError [$x,'" has varying indentation levels"] -; s := [j,:s] -; [trim y for y in lines] -; wherePP(u) == -; k := charPosition($charPlus,u,0) -; k = #u or charPosition($charPlus,u,k + 1) ^= k + 1 => -; systemError '" Improper comment found" -; k -; trim(s) == -; k := wherePP(s) -; return SUBSTRING(s,k + 2,nil) -; m := MAXINDEX s -; n := k + 2 -; for j in (k + 2)..m while s.j = $charBlank repeat (n := n + 1) -; SUBSTRING(s,n,nil) - -(DEFUN |checkTrim,trim| (|s|) - (PROG (|k| |m| |n|) - (declare (special |$charBlank|)) - (RETURN - (SEQ (SPADLET |k| (|checkTrim,wherePP| |s|)) - (RETURN (SUBSTRING |s| (PLUS |k| 2) NIL)) - (SPADLET |m| (MAXINDEX |s|)) (SPADLET |n| (PLUS |k| 2)) - (DO ((|j| (PLUS |k| 2) (+ |j| 1))) - ((OR (> |j| |m|) - (NULL (BOOT-EQUAL (ELT |s| |j|) |$charBlank|))) - NIL) - (SEQ (EXIT (SPADLET |n| (PLUS |n| 1))))) - (EXIT (SUBSTRING |s| |n| NIL)))))) - -(DEFUN |checkTrim,wherePP| (|u|) - (PROG (|k|) - (declare (special |$charPlus|)) - (RETURN - (SEQ (SPADLET |k| (|charPosition| |$charPlus| |u| 0)) - (IF (OR (BOOT-EQUAL |k| (|#| |u|)) - (NEQUAL (|charPosition| |$charPlus| |u| - (PLUS |k| 1)) - (PLUS |k| 1))) - (EXIT (|systemError| - " Improper comment found"))) - (EXIT |k|))))) - -(DEFUN |checkTrim| (|$x| |lines|) - (DECLARE (SPECIAL |$x|)) - (PROG (|j| |s|) - (RETURN - (SEQ (PROGN - (SPADLET |s| - (CONS (|checkTrim,wherePP| (CAR |lines|)) NIL)) - (DO ((G167356 (CDR |lines|) (CDR G167356)) (|x| NIL)) - ((OR (ATOM G167356) - (PROGN (SETQ |x| (CAR G167356)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |j| (|checkTrim,wherePP| |x|)) - (COND - ((NULL (member |j| |s|)) - (|checkDocError| - (CONS |$x| - (CONS - " has varying indentation levels" - NIL))) - (SPADLET |s| (CONS |j| |s|))) - ('T NIL)))))) - (PROG (G167366) - (SPADLET G167366 NIL) - (RETURN - (DO ((G167371 |lines| (CDR G167371)) (|y| NIL)) - ((OR (ATOM G167371) - (PROGN (SETQ |y| (CAR G167371)) NIL)) - (NREVERSE0 G167366)) - (SEQ (EXIT (SETQ G167366 - (CONS (|checkTrim,trim| |y|) - G167366)))))))))))) - -;checkExtract(header,lines) == -; while lines repeat -; line := first lines -; k := firstNonBlankPosition line --k gives margin of Description: -; substring?(header,line,k) => return nil -; lines := rest lines -; null lines => nil -; u := first lines -; j := charPosition(char '_:,u,k) -; margin := k -; firstLines := -; (k := firstNonBlankPosition(u,j + 1)) ^= -1 => -; [SUBSTRING(u,j + 1,nil),:rest lines] -; rest lines -; --now look for another header; if found skip all rest of these lines -; acc := nil -; for line in firstLines repeat -; do -; m := #line -; (k := firstNonBlankPosition line) = -1 => 'skip --include if blank -; k > margin => 'skip --include if idented -; not UPPER_-CASE_-P line.k => 'skip --also if not upcased -; (j := charPosition(char '_:,line,k)) = m => 'skip --or if not colon, or -; (i := charPosition(char '_ ,line,k+1)) < j => 'skip --blank before colon -; return nil -; acc := [line,:acc] -; NREVERSE acc - -(DEFUN |checkExtract| (|header| |lines|) - (PROG (|line| |u| |margin| |firstLines| |m| |k| |j| |i| |acc|) - (RETURN - (SEQ (PROGN - (DO () ((NULL |lines|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |line| (CAR |lines|)) - (SPADLET |k| - (|firstNonBlankPosition| |line|)) - (COND - ((|substring?| |header| |line| |k|) - (RETURN NIL)) - ('T (SPADLET |lines| (CDR |lines|)))))))) - (COND - ((NULL |lines|) NIL) - ('T (SPADLET |u| (CAR |lines|)) - (SPADLET |j| (|charPosition| (|char| '|:|) |u| |k|)) - (SPADLET |margin| |k|) - (SPADLET |firstLines| - (COND - ((NEQUAL (SPADLET |k| - (|firstNonBlankPosition| |u| - (PLUS |j| 1))) - (SPADDIFFERENCE 1)) - (CONS (SUBSTRING |u| (PLUS |j| 1) NIL) - (CDR |lines|))) - ('T (CDR |lines|)))) - (SPADLET |acc| NIL) - (DO ((G167406 |firstLines| (CDR G167406)) - (|line| NIL)) - ((OR (ATOM G167406) - (PROGN (SETQ |line| (CAR G167406)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (|do| (PROGN - (SPADLET |m| (|#| |line|)) - (COND - ((BOOT-EQUAL - (SPADLET |k| - (|firstNonBlankPosition| - |line|)) - (SPADDIFFERENCE 1)) - '|skip|) - ((> |k| |margin|) '|skip|) - ((NULL - (UPPER-CASE-P - (ELT |line| |k|))) - '|skip|) - ((BOOT-EQUAL - (SPADLET |j| - (|charPosition| - (|char| '|:|) |line| |k|)) - |m|) - '|skip|) - ((> |j| - (SPADLET |i| - (|charPosition| - (|char| '| |) |line| - (PLUS |k| 1)))) - '|skip|) - ('T (RETURN NIL))))) - (SPADLET |acc| (CONS |line| |acc|)))))) - (NREVERSE |acc|)))))))) - -;checkFixCommonProblem u == -; acc := nil -; while u repeat -; x := first u -; x = $charLbrace and MEMBER(next := IFCAR rest u,$HTspadmacros) and -; (IFCAR IFCDR rest u ^= $charLbrace) => -; checkDocError ['"Reversing ",next,'" and left brace"] -; acc := [$charLbrace,next,:acc] --reverse order of brace and command -; u := rest rest u -; acc := [x,:acc] -; u := rest u -; NREVERSE acc - -(DEFUN |checkFixCommonProblem| (|u|) - (PROG (|x| |next| |acc|) - (declare (special |$charLbrace| |$HTspadmacros|)) - (RETURN - (SEQ (PROGN - (SPADLET |acc| NIL) - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |x| (CAR |u|)) - (COND - ((AND (BOOT-EQUAL |x| |$charLbrace|) - (|member| - (SPADLET |next| (IFCAR (CDR |u|))) - |$HTspadmacros|) - (NEQUAL (IFCAR (IFCDR (CDR |u|))) - |$charLbrace|)) - (|checkDocError| - (CONS "Reversing " - (CONS |next| - (CONS - " and left brace" - NIL)))) - (SPADLET |acc| - (CONS |$charLbrace| - (CONS |next| |acc|))) - (SPADLET |u| (CDR (CDR |u|)))) - ('T (SPADLET |acc| (CONS |x| |acc|)) - (SPADLET |u| (CDR |u|)))))))) - (NREVERSE |acc|)))))) - -;checkDecorate u == -; count := 0 -; spadflag := false --means OK to wrap single letter words with \s{} -; mathSymbolsOk := false -; acc := nil -; verbatim := false -; while u repeat -; x := first u -; if not verbatim then -; if x = '"\em" then -; if count > 0 then -; mathSymbolsOk := count - 1 -; spadflag := count - 1 -; else checkDocError ['"\em must be enclosed in braces"] -; if MEMBER(x,'("\spadpaste" "\spad" "\spadop")) then mathSymbolsOk := count -; if MEMBER(x,'("\s" "\spadtype" "\spadsys" "\example" "\andexample" "\spadop" "\spad" "\spadignore" "\spadpaste" "\spadcommand" "\footnote")) then spadflag := count -; else if x = $charLbrace then -; count := count + 1 -; else if x = $charRbrace then -; count := count - 1 -; if mathSymbolsOk = count then mathSymbolsOk := false -; if spadflag = count then spadflag := false -; else if not mathSymbolsOk and MEMBER(x,'("+" "*" "=" "==" "->")) then -; if $checkingXmptex? then -; checkDocError ["Symbol ",x,'" appearing outside \spad{}"] -; acc := -; x = '"\end{verbatim}" => -; verbatim := false -; [x, :acc] -; verbatim => [x, :acc] -; x = '"\begin{verbatim}" => -; verbatim := true -; [x, :acc] -; x = '"\begin" and first (v := IFCDR u) = $charLbrace and -; first (v := IFCDR v) = '"detail" and first (v := IFCDR v) = $charRbrace -; => -; u := v -; ['"\blankline ",:acc] -; x = '"\end" and first (v := IFCDR u) = $charLbrace and -; first (v := IFCDR v) = '"detail" and first (v := IFCDR v) = $charRbrace -; => -; u := v -; acc -; x = char '_$ or x = '"$" => ['"\$",:acc] -; x = char '_% or x = '"%" => ['"\%",:acc] -; x = char '_, or x = '"," => ['",{}",:acc] -; x = '"\spad" => ['"\spad",:acc] -; STRINGP x and DIGITP x.0 => [x,:acc] -; null spadflag and -; (CHARP x and ALPHA_-CHAR_-P x and not MEMQ(x,$charExclusions) or -; MEMBER(x,$argl)) => [$charRbrace,x,$charLbrace,'"\spad",:acc] -; null spadflag and ((STRINGP x and not x.0 = $charBack and DIGITP(x.(MAXINDEX x))) or MEMBER(x,'("true" "false"))) => -; [$charRbrace,x,$charLbrace,'"\spad",:acc] --wrap x1, alpha3, etc -; xcount := #x -; xcount = 3 and x.1 = char 't and x.2 = char 'h => -; ['"th",$charRbrace,x.0,$charLbrace,'"\spad",:acc] -; xcount = 4 and x.1 = char '_- and x.2 = char 't and x.3 = char 'h => -; ['"-th",$charRbrace,x.0,$charLbrace,'"\spad",:acc] -; xcount = 2 and x.1 = char 'i or --wrap ei, xi, hi -; null spadflag and xcount > 0 and xcount < 4 and not MEMBER(x,'("th" "rd" "st")) and -; hasNoVowels x => --wrap words with no vowels -; [$charRbrace,x,$charLbrace,'"\spad",:acc] -; [checkAddBackSlashes x,:acc] -; u := rest u -; NREVERSE acc - -(DEFUN |checkDecorate| (|u|) - (PROG (|x| |count| |mathSymbolsOk| |spadflag| |verbatim| |v| |xcount| |acc|) - (declare (special |$charLbrace| |$charRbrace| |$charBack| |$argl| - |$charExclusions| |$checkingXmptex?|)) - (RETURN - (SEQ (PROGN - (SPADLET |count| 0) - (SPADLET |spadflag| NIL) - (SPADLET |mathSymbolsOk| NIL) - (SPADLET |acc| NIL) - (SPADLET |verbatim| NIL) - (DO () ((NULL |u|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |x| (CAR |u|)) - (COND - ((NULL |verbatim|) - (COND - ((BOOT-EQUAL |x| "\\em") - (COND - ((> |count| 0) - (SPADLET |mathSymbolsOk| - (SPADDIFFERENCE |count| 1)) - (SPADLET |spadflag| - (SPADDIFFERENCE |count| 1))) - ('T - (|checkDocError| - (CONS - "\\em must be enclosed in braces" - NIL)))))) - (COND - ((|member| |x| - '("\\spadpaste" "\\spad" - "\\spadop")) - (SPADLET |mathSymbolsOk| |count|))) - (COND - ((|member| |x| - '("\\s" "\\spadtype" "\\spadsys" - "\\example" "\\andexample" - "\\spadop" "\\spad" - "\\spadignore" "\\spadpaste" - "\\spadcommand" "\\footnote")) - (SPADLET |spadflag| |count|)) - ((BOOT-EQUAL |x| |$charLbrace|) - (SPADLET |count| (PLUS |count| 1))) - ((BOOT-EQUAL |x| |$charRbrace|) - (SPADLET |count| - (SPADDIFFERENCE |count| 1)) - (COND - ((BOOT-EQUAL |mathSymbolsOk| - |count|) - (SPADLET |mathSymbolsOk| NIL))) - (COND - ((BOOT-EQUAL |spadflag| |count|) - (SPADLET |spadflag| NIL)) - ('T NIL))) - ((AND (NULL |mathSymbolsOk|) - (|member| |x| - '("+" "*" "=" "==" "->"))) - (COND - (|$checkingXmptex?| - (|checkDocError| - (CONS '|Symbol | - (CONS |x| - (CONS - " appearing outside \\spad{}" - NIL))))) - ('T NIL))) - ('T NIL)))) - (SPADLET |acc| - (COND - ((BOOT-EQUAL |x| - "\\end{verbatim}") - (SPADLET |verbatim| NIL) - (CONS |x| |acc|)) - (|verbatim| (CONS |x| |acc|)) - ((BOOT-EQUAL |x| - "\\begin{verbatim}") - (SPADLET |verbatim| 'T) - (CONS |x| |acc|)) - ((AND - (BOOT-EQUAL |x| - "\\begin") - (BOOT-EQUAL - (CAR - (SPADLET |v| (IFCDR |u|))) - |$charLbrace|) - (BOOT-EQUAL - (CAR - (SPADLET |v| (IFCDR |v|))) - "detail") - (BOOT-EQUAL - (CAR - (SPADLET |v| (IFCDR |v|))) - |$charRbrace|)) - (SPADLET |u| |v|) - (CONS - "\\blankline " - |acc|)) - ((AND - (BOOT-EQUAL |x| - "\\end") - (BOOT-EQUAL - (CAR - (SPADLET |v| (IFCDR |u|))) - |$charLbrace|) - (BOOT-EQUAL - (CAR - (SPADLET |v| (IFCDR |v|))) - "detail") - (BOOT-EQUAL - (CAR - (SPADLET |v| (IFCDR |v|))) - |$charRbrace|)) - (SPADLET |u| |v|) |acc|) - ((OR - (BOOT-EQUAL |x| (|char| '$)) - (BOOT-EQUAL |x| - "$")) - (CONS "\\$" |acc|)) - ((OR - (BOOT-EQUAL |x| (|char| '%)) - (BOOT-EQUAL |x| - "%")) - (CONS "\\%" |acc|)) - ((OR - (BOOT-EQUAL |x| (|char| '|,|)) - (BOOT-EQUAL |x| - ",")) - (CONS ",{}" |acc|)) - ((BOOT-EQUAL |x| - "\\spad") - (CONS "\\spad" - |acc|)) - ((AND (STRINGP |x|) - (DIGITP (ELT |x| 0))) - (CONS |x| |acc|)) - ((AND (NULL |spadflag|) - (OR - (AND (CHARP |x|) - (ALPHA-CHAR-P |x|) - (NULL - (member |x| - |$charExclusions|))) - (|member| |x| |$argl|))) - (CONS |$charRbrace| - (CONS |x| - (CONS |$charLbrace| - (CONS "\\spad" - |acc|))))) - ((AND (NULL |spadflag|) - (OR - (AND (STRINGP |x|) - (NULL - (BOOT-EQUAL (ELT |x| 0) - |$charBack|)) - (DIGITP - (ELT |x| (MAXINDEX |x|)))) - (|member| |x| - '("true" "false")))) - (CONS |$charRbrace| - (CONS |x| - (CONS |$charLbrace| - (CONS "\\spad" - |acc|))))) - ('T (SPADLET |xcount| (|#| |x|)) - (COND - ((AND (EQL |xcount| 3) - (BOOT-EQUAL (ELT |x| 1) - (|char| '|t|)) - (BOOT-EQUAL (ELT |x| 2) - (|char| '|h|))) - (CONS "th" - (CONS |$charRbrace| - (CONS (ELT |x| 0) - (CONS |$charLbrace| - (CONS - "\\spad" - |acc|)))))) - ((AND (EQL |xcount| 4) - (BOOT-EQUAL (ELT |x| 1) - (|char| '-)) - (BOOT-EQUAL (ELT |x| 2) - (|char| '|t|)) - (BOOT-EQUAL (ELT |x| 3) - (|char| '|h|))) - (CONS "-th" - (CONS |$charRbrace| - (CONS (ELT |x| 0) - (CONS |$charLbrace| - (CONS - "\\spad" - |acc|)))))) - ((OR - (AND (EQL |xcount| 2) - (BOOT-EQUAL (ELT |x| 1) - (|char| '|i|))) - (AND (NULL |spadflag|) - (> |xcount| 0) - (> 4 |xcount|) - (NULL - (|member| |x| - '("th" "rd" "st"))) - (|hasNoVowels| |x|))) - (CONS |$charRbrace| - (CONS |x| - (CONS |$charLbrace| - (CONS - "\\spad" - |acc|))))) - ('T - (CONS - (|checkAddBackSlashes| |x|) - |acc|)))))) - (SPADLET |u| (CDR |u|)))))) - (NREVERSE |acc|)))))) - -;hasNoVowels x == -; max := MAXINDEX x -; x.max = char 'y => false -; and/[not isVowel(x.i) for i in 0..max] - -(DEFUN |hasNoVowels| (|x|) - (PROG (|max|) - (RETURN - (SEQ (PROGN - (SPADLET |max| (MAXINDEX |x|)) - (COND - ((BOOT-EQUAL (ELT |x| |max|) (|char| '|y|)) NIL) - ('T - (PROG (G167501) - (SPADLET G167501 'T) - (RETURN - (DO ((G167507 NIL (NULL G167501)) - (|i| 0 (QSADD1 |i|))) - ((OR G167507 (QSGREATERP |i| |max|)) - G167501) - (SEQ (EXIT (SETQ G167501 - (AND G167501 - (NULL - (|isVowel| (ELT |x| |i|))))))))))))))))) - -;isVowel c == -; EQ(c,char 'a) or EQ(c,char 'e) or EQ(c,char 'i) or EQ(c,char 'o) or EQ(c,char 'u) or -; EQ(c,char 'A) or EQ(c,char 'E) or EQ(c,char 'I) or EQ(c,char 'O) or EQ(c,char 'U) - -(DEFUN |isVowel| (|c|) - (OR (EQ |c| (|char| '|a|)) (EQ |c| (|char| '|e|)) - (EQ |c| (|char| '|i|)) (EQ |c| (|char| '|o|)) - (EQ |c| (|char| '|u|)) (EQ |c| (|char| 'A)) (EQ |c| (|char| 'E)) - (EQ |c| (|char| 'I)) (EQ |c| (|char| 'O)) (EQ |c| (|char| 'U)))) - -;checkAddBackSlashes s == -; (CHARP s and (c := s)) or (#s = 1 and (c := s.0)) => -; MEMQ(s,$charEscapeList) => STRCONC($charBack,c) -; s -; k := 0 -; m := MAXINDEX s -; insertIndex := nil -; while k <= m repeat -; do -; char := s.k -; char = $charBack => k := k + 2 -; MEMQ(char,$charEscapeList) => return (insertIndex := k) -; k := k + 1 -; insertIndex => checkAddBackSlashes STRCONC(SUBSTRING(s,0,insertIndex),$charBack,s.k,SUBSTRING(s,insertIndex + 1,nil)) -; s - -(DEFUN |checkAddBackSlashes| (|s|) - (PROG (|c| |m| |char| |insertIndex| |k|) - (declare (special |$charBack| |$charEscapeList|)) - (RETURN - (SEQ (COND - ((OR (AND (CHARP |s|) (SPADLET |c| |s|)) - (AND (EQL (|#| |s|) 1) (SPADLET |c| (ELT |s| 0)))) - (COND - ((member |s| |$charEscapeList|) - (STRCONC |$charBack| |c|)) - ('T |s|))) - ('T (SPADLET |k| 0) (SPADLET |m| (MAXINDEX |s|)) - (SPADLET |insertIndex| NIL) - (DO () ((NULL (<= |k| |m|)) NIL) - (SEQ (EXIT (PROGN - (|do| (PROGN - (SPADLET |char| (ELT |s| |k|)) - (COND - ((BOOT-EQUAL |char| |$charBack|) - (SPADLET |k| (PLUS |k| 2))) - ((member |char| |$charEscapeList|) - (RETURN - (SPADLET |insertIndex| |k|)))))) - (SPADLET |k| (PLUS |k| 1)))))) - (COND - (|insertIndex| - (|checkAddBackSlashes| - (STRCONC (SUBSTRING |s| 0 |insertIndex|) - |$charBack| (ELT |s| |k|) - (SUBSTRING |s| (PLUS |insertIndex| 1) - NIL)))) - ('T |s|)))))))) - -;checkAddSpaces u == -; null u => nil -; null rest u => u -; space := $charBlank -; u2 := nil -; for i in 1.. for f in u repeat -; -- want newlines before and after begin/end verbatim and between lines -; -- since this might be written to a file, we can't really use -; -- newline characters. The Browser and HD will do the translation -; -- later. -; if f = '"\begin{verbatim}" then -; space := $charFauxNewline -; if null u2 then u2 := [space] -; if i > 1 then u2 := [:u2, space, f] -; else u2 := [:u2, f] -; if f = '"\end{verbatim}" then -; u2 := [:u2, space] -; space := $charBlank -; u2 - -(DEFUN |checkAddSpaces| (|u|) - (PROG (|u2| |space|) - (declare (special |$charBlank| |$charFauxNewline|)) - (RETURN - (SEQ (COND - ((NULL |u|) NIL) - ((NULL (CDR |u|)) |u|) - ('T (SPADLET |space| |$charBlank|) (SPADLET |u2| NIL) - (DO ((|i| 1 (QSADD1 |i|)) (G167557 |u| (CDR G167557)) - (|f| NIL)) - ((OR (ATOM G167557) - (PROGN (SETQ |f| (CAR G167557)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (COND - ((BOOT-EQUAL |f| - "\\begin{verbatim}") - (SPADLET |space| |$charFauxNewline|) - (COND - ((NULL |u2|) - (SPADLET |u2| (CONS |space| NIL))) - ('T NIL)))) - (COND - ((> |i| 1) - (SPADLET |u2| - (APPEND |u2| - (CONS |space| (CONS |f| NIL))))) - ('T - (SPADLET |u2| - (APPEND |u2| (CONS |f| NIL))))) - (COND - ((BOOT-EQUAL |f| - "\\end{verbatim}") - (SPADLET |u2| - (APPEND |u2| - (CONS |space| NIL))) - (SPADLET |space| |$charBlank|)) - ('T NIL)))))) - |u2|)))))) - -;checkIeEg u == -; acc := nil -; verbatim := false -; while u repeat -; x := first u -; acc := -; x = '"\end{verbatim}" => -; verbatim := false -; [x, :acc] -; verbatim => [x, :acc] -; x = '"\begin{verbatim}" => -; verbatim := true -; [x, :acc] -; z := checkIeEgfun x => [:NREVERSE z,:acc] -; [x,:acc] -; u := rest u -; NREVERSE acc - -;(DEFUN |checkIeEg| (|u|) -; (PROG (|x| |verbatim| |z| |acc|) -; (RETURN -; (SEQ (PROGN -; (SPADLET |acc| NIL) -; (SPADLET |verbatim| NIL) -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |x| (CAR |u|)) -; (SPADLET |acc| -; (COND -; ((BOOT-EQUAL |x| -; "\\end{verbatim}") -; (SPADLET |verbatim| NIL) -; (CONS |x| |acc|)) -; (|verbatim| (CONS |x| |acc|)) -; ((BOOT-EQUAL |x| -; "\\begin{verbatim}") -; (SPADLET |verbatim| 'T) -; (CONS |x| |acc|)) -; ((SPADLET |z| -; (|checkIeEgfun| |x|)) -; (APPEND (NREVERSE |z|) |acc|)) -; ('T (CONS |x| |acc|)))) -; (SPADLET |u| (CDR |u|)))))) -; (NREVERSE |acc|)))))) - -;checkIeEgfun x == -; CHARP x => nil -; x = '"" => nil -; m := MAXINDEX x -; for k in 0..(m - 3) repeat -; x.(k + 1) = $charPeriod and x.(k + 3) = $charPeriod and -; (x.k = char 'i and x.(k + 2) = char 'e and (key := '"that is") -; or x.k = char 'e and x.(k + 2) = char 'g and (key := '"for example")) => -; firstPart := (k > 0 => [SUBSTRING(x,0,k)]; nil) -; result := [:firstPart,'"\spadignore{",SUBSTRING(x,k,4),'"}", -; :checkIeEgfun SUBSTRING(x,k+4,nil)] -; result - -;(DEFUN |checkIeEgfun| (|x|) -; (PROG (|m| |key| |firstPart| |result|) -; (declare (special |$charPeriod|)) -; (RETURN -; (SEQ (COND -; ((CHARP |x|) NIL) -; ((BOOT-EQUAL |x| "") NIL) -; ('T (SPADLET |m| (MAXINDEX |x|)) -; (SEQ (DO ((G167607 (SPADDIFFERENCE |m| 3)) -; (|k| 0 (QSADD1 |k|))) -; ((QSGREATERP |k| G167607) NIL) -; (SEQ (EXIT (COND -; ((AND -; (BOOT-EQUAL (ELT |x| (PLUS |k| 1)) -; |$charPeriod|) -; (BOOT-EQUAL (ELT |x| (PLUS |k| 3)) -; |$charPeriod|) -; (OR -; (AND -; (BOOT-EQUAL (ELT |x| |k|) -; (|char| '|i|)) -; (BOOT-EQUAL -; (ELT |x| (PLUS |k| 2)) -; (|char| '|e|)) -; (SPADLET |key| -; "that is")) -; (AND -; (BOOT-EQUAL (ELT |x| |k|) -; (|char| '|e|)) -; (BOOT-EQUAL -; (ELT |x| (PLUS |k| 2)) -; (|char| '|g|)) -; (SPADLET |key| -; "for example")))) -; (EXIT -; (PROGN -; (SPADLET |firstPart| -; (COND -; ((> |k| 0) -; (CONS (SUBSTRING |x| 0 |k|) -; NIL)) -; ('T NIL))) -; (SPADLET |result| -; (APPEND |firstPart| -; (CONS -; "\\spadignore{" -; (CONS (SUBSTRING |x| |k| 4) -; (CONS "}" -; (|checkIeEgfun| -; (SUBSTRING |x| (PLUS |k| 4) -; NIL)))))))))))))) -; (EXIT |result|)))))))) - -;checkSplit2Words u == -; acc := nil -; while u repeat -; x := first u -; acc := -; x = '"\end{verbatim}" => -; verbatim := false -; [x, :acc] -; verbatim => [x, :acc] -; x = '"\begin{verbatim}" => -; verbatim := true -; [x, :acc] -; z := checkSplitBrace x => [:NREVERSE z,:acc] -; [x,:acc] -; u := rest u -; NREVERSE acc - -;(DEFUN |checkSplit2Words| (|u|) -; (PROG (|x| |verbatim| |z| |acc|) -; (RETURN -; (SEQ (PROGN -; (SPADLET |acc| NIL) -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |x| (CAR |u|)) -; (SPADLET |acc| -; (COND -; ((BOOT-EQUAL |x| -; "\\end{verbatim}") -; (SPADLET |verbatim| NIL) -; (CONS |x| |acc|)) -; (|verbatim| (CONS |x| |acc|)) -; ((BOOT-EQUAL |x| -; "\\begin{verbatim}") -; (SPADLET |verbatim| 'T) -; (CONS |x| |acc|)) -; ((SPADLET |z| -; (|checkSplitBrace| |x|)) -; (APPEND (NREVERSE |z|) |acc|)) -; ('T (CONS |x| |acc|)))) -; (SPADLET |u| (CDR |u|)))))) -; (NREVERSE |acc|)))))) - -;checkSplitBrace x == -; CHARP x => [x] -; #x = 1 => [x.0] -; (u := checkSplitBackslash x) -; and rest u => "append"/[checkSplitBrace y for y in u] -; m := MAXINDEX x -; (u := checkSplitOn x) -; and rest u => "append"/[checkSplitBrace y for y in u] -; (u := checkSplitPunctuation x) -; and rest u => "append"/[checkSplitBrace y for y in u] -; [x] - -(DEFUN |checkSplitBrace| (|x|) - (PROG (|m| |u|) - (RETURN - (SEQ (COND - ((CHARP |x|) (CONS |x| NIL)) - ((EQL (|#| |x|) 1) (CONS (ELT |x| 0) NIL)) - ((AND (SPADLET |u| (|checkSplitBackslash| |x|)) (CDR |u|)) - (PROG (G167644) - (SPADLET G167644 NIL) - (RETURN - (DO ((G167649 |u| (CDR G167649)) (|y| NIL)) - ((OR (ATOM G167649) - (PROGN (SETQ |y| (CAR G167649)) NIL)) - G167644) - (SEQ (EXIT (SETQ G167644 - (APPEND G167644 - (|checkSplitBrace| |y|))))))))) - ('T (SPADLET |m| (MAXINDEX |x|)) - (COND - ((AND (SPADLET |u| (|checkSplitOn| |x|)) (CDR |u|)) - (PROG (G167655) - (SPADLET G167655 NIL) - (RETURN - (DO ((G167660 |u| (CDR G167660)) (|y| NIL)) - ((OR (ATOM G167660) - (PROGN (SETQ |y| (CAR G167660)) NIL)) - G167655) - (SEQ (EXIT (SETQ G167655 - (APPEND G167655 - (|checkSplitBrace| |y|))))))))) - ((AND (SPADLET |u| (|checkSplitPunctuation| |x|)) - (CDR |u|)) - (PROG (G167666) - (SPADLET G167666 NIL) - (RETURN - (DO ((G167671 |u| (CDR G167671)) (|y| NIL)) - ((OR (ATOM G167671) - (PROGN (SETQ |y| (CAR G167671)) NIL)) - G167666) - (SEQ (EXIT (SETQ G167666 - (APPEND G167666 - (|checkSplitBrace| |y|))))))))) - ('T (CONS |x| NIL))))))))) - -;checkSplitBackslash x == -; not STRINGP x => [x] -; m := MAXINDEX x -; (k := charPosition($charBack,x,0)) < m => -; m = 1 or ALPHA_-CHAR_-P(x . (k + 1)) => --starts with a backslash so.. -; (k := charPosition($charBack,x,1)) < m => --..see if there is another -; [SUBSTRING(x,0,k),:checkSplitBackslash SUBSTRING(x,k,nil)] -- yup -; [x] --no, just return line -; k = 0 => --starts with backspace but x.1 is not a letter; break it up -; [SUBSTRING(x,0,2),:checkSplitBackslash SUBSTRING(x,2,nil)] -; u := SUBSTRING(x,0,k) -; v := SUBSTRING(x,k,2) -; k + 1 = m => [u,v] -; [u,v,:checkSplitBackslash SUBSTRING(x,k + 2,nil)] -; [x] - -(DEFUN |checkSplitBackslash| (|x|) - (PROG (|m| |k| |u| |v|) - (declare (special |$charBack|)) - (RETURN - (COND - ((NULL (STRINGP |x|)) (CONS |x| NIL)) - ('T (SPADLET |m| (MAXINDEX |x|)) - (COND - ((> |m| (SPADLET |k| (|charPosition| |$charBack| |x| 0))) - (COND - ((OR (EQL |m| 1) (ALPHA-CHAR-P (ELT |x| (PLUS |k| 1)))) - (COND - ((> |m| - (SPADLET |k| (|charPosition| |$charBack| |x| 1))) - (CONS (SUBSTRING |x| 0 |k|) - (|checkSplitBackslash| (SUBSTRING |x| |k| NIL)))) - ('T (CONS |x| NIL)))) - ((EQL |k| 0) - (CONS (SUBSTRING |x| 0 2) - (|checkSplitBackslash| (SUBSTRING |x| 2 NIL)))) - ('T (SPADLET |u| (SUBSTRING |x| 0 |k|)) - (SPADLET |v| (SUBSTRING |x| |k| 2)) - (COND - ((BOOT-EQUAL (PLUS |k| 1) |m|) - (CONS |u| (CONS |v| NIL))) - ('T - (CONS |u| - (CONS |v| - (|checkSplitBackslash| - (SUBSTRING |x| (PLUS |k| 2) NIL))))))))) - ('T (CONS |x| NIL)))))))) - -;checkSplitPunctuation x == -; CHARP x => [x] -; m := MAXINDEX x -; m < 1 => [x] -; lastchar := x.m -; lastchar = $charPeriod and x.(m - 1) = $charPeriod => -; m = 1 => [x] -; m > 3 and x.(m-2) = $charPeriod => -; [:checkSplitPunctuation SUBSTRING(x,0,m-2),'"..."] -; [:checkSplitPunctuation SUBSTRING(x,0,m-1),'".."] -; lastchar = $charPeriod or lastchar = $charSemiColon or lastchar = $charComma -; => [SUBSTRING(x,0,m),lastchar] -; m > 1 and x.(m - 1) = $charQuote => [SUBSTRING(x,0,m - 1),SUBSTRING(x,m-1,nil)] -; (k := charPosition($charBack,x,0)) < m => -; k = 0 => -; m = 1 or HGET($htMacroTable,x) or ALPHA_-CHAR_-P x.1 => [x] -; v := SUBSTRING(x,2,nil) -; [SUBSTRING(x,0,2),:checkSplitPunctuation v] -; u := SUBSTRING(x,0,k) -; v := SUBSTRING(x,k,nil) -; [:checkSplitPunctuation u,:checkSplitPunctuation v] -; (k := charPosition($charDash,x,1)) < m => -; u := SUBSTRING(x,k + 1,nil) -; [SUBSTRING(x,0,k),$charDash,:checkSplitPunctuation u] -; [x] - -(DEFUN |checkSplitPunctuation| (|x|) - (PROG (|m| |lastchar| |v| |k| |u|) - (declare (special |$charDash| |$htMacroTable| |$charBack| |$charQuote| - |$charComma| |$charSemiColon| |$charPeriod| - |$charPeriod|)) - (RETURN - (COND - ((CHARP |x|) (CONS |x| NIL)) - ('T (SPADLET |m| (MAXINDEX |x|)) - (COND - ((> 1 |m|) (CONS |x| NIL)) - ('T (SPADLET |lastchar| (ELT |x| |m|)) - (COND - ((AND (BOOT-EQUAL |lastchar| |$charPeriod|) - (BOOT-EQUAL (ELT |x| (SPADDIFFERENCE |m| 1)) - |$charPeriod|)) - (COND - ((EQL |m| 1) (CONS |x| NIL)) - ((AND (> |m| 3) - (BOOT-EQUAL (ELT |x| (SPADDIFFERENCE |m| 2)) - |$charPeriod|)) - (APPEND (|checkSplitPunctuation| - (SUBSTRING |x| 0 (SPADDIFFERENCE |m| 2))) - (CONS "..." NIL))) - ('T - (APPEND (|checkSplitPunctuation| - (SUBSTRING |x| 0 (SPADDIFFERENCE |m| 1))) - (CONS ".." NIL))))) - ((OR (BOOT-EQUAL |lastchar| |$charPeriod|) - (BOOT-EQUAL |lastchar| |$charSemiColon|) - (BOOT-EQUAL |lastchar| |$charComma|)) - (CONS (SUBSTRING |x| 0 |m|) (CONS |lastchar| NIL))) - ((AND (> |m| 1) - (BOOT-EQUAL (ELT |x| (SPADDIFFERENCE |m| 1)) - |$charQuote|)) - (CONS (SUBSTRING |x| 0 (SPADDIFFERENCE |m| 1)) - (CONS (SUBSTRING |x| (SPADDIFFERENCE |m| 1) NIL) - NIL))) - ((> |m| (SPADLET |k| (|charPosition| |$charBack| |x| 0))) - (COND - ((EQL |k| 0) - (COND - ((OR (EQL |m| 1) (HGET |$htMacroTable| |x|) - (ALPHA-CHAR-P (ELT |x| 1))) - (CONS |x| NIL)) - ('T (SPADLET |v| (SUBSTRING |x| 2 NIL)) - (CONS (SUBSTRING |x| 0 2) - (|checkSplitPunctuation| |v|))))) - ('T (SPADLET |u| (SUBSTRING |x| 0 |k|)) - (SPADLET |v| (SUBSTRING |x| |k| NIL)) - (APPEND (|checkSplitPunctuation| |u|) - (|checkSplitPunctuation| |v|))))) - ((> |m| (SPADLET |k| (|charPosition| |$charDash| |x| 1))) - (SPADLET |u| (SUBSTRING |x| (PLUS |k| 1) NIL)) - (CONS (SUBSTRING |x| 0 |k|) - (CONS |$charDash| (|checkSplitPunctuation| |u|)))) - ('T (CONS |x| NIL)))))))))) - -;checkSplitOn(x) == -; CHARP x => [x] -; l := $charSplitList -; m := MAXINDEX x -; while l repeat -; char := first l -; do -; m = 0 and x.0 = char => return (k := -1) --special exit -; k := charPosition(char,x,0) -; k > 0 and x.(k - 1) = $charBack => [x] -; k <= m => return k -; l := rest l -; null l => [x] -; k = -1 => [char] -; k = 0 => [char,SUBSTRING(x,1,nil)] -; k = MAXINDEX x => [SUBSTRING(x,0,k),char] -; [SUBSTRING(x,0,k),char,:checkSplitOn SUBSTRING(x,k + 1,nil)] - -(DEFUN |checkSplitOn| (|x|) - (PROG (|m| |char| |k| |l|) - (declare (special |$charBack| |$charSplitList|)) - (RETURN - (SEQ (COND - ((CHARP |x|) (CONS |x| NIL)) - ('T (SPADLET |l| |$charSplitList|) - (SPADLET |m| (MAXINDEX |x|)) - (DO () ((NULL |l|) NIL) - (SEQ (EXIT (PROGN - (SPADLET |char| (CAR |l|)) - (|do| (COND - ((AND (EQL |m| 0) - (BOOT-EQUAL (ELT |x| 0) |char|)) - (RETURN - (SPADLET |k| - (SPADDIFFERENCE 1)))) - ('T - (SPADLET |k| - (|charPosition| |char| |x| 0)) - (COND - ((AND (> |k| 0) - (BOOT-EQUAL - (ELT |x| - (SPADDIFFERENCE |k| 1)) - |$charBack|)) - (CONS |x| NIL)) - ((<= |k| |m|) (RETURN |k|)))))) - (SPADLET |l| (CDR |l|)))))) - (COND - ((NULL |l|) (CONS |x| NIL)) - ((BOOT-EQUAL |k| (SPADDIFFERENCE 1)) (CONS |char| NIL)) - ((EQL |k| 0) - (CONS |char| (CONS (SUBSTRING |x| 1 NIL) NIL))) - ((BOOT-EQUAL |k| (MAXINDEX |x|)) - (CONS (SUBSTRING |x| 0 |k|) (CONS |char| NIL))) - ('T - (CONS (SUBSTRING |x| 0 |k|) - (CONS |char| - (|checkSplitOn| - (SUBSTRING |x| (PLUS |k| 1) NIL)))))))))))) - -;checkBalance u == -; checkBeginEnd u -; stack := nil -; while u repeat -; do -; x := first u -; openClose := ASSOC(x,$checkPrenAlist) --is it an open bracket? -; => stack := [CAR openClose,:stack] --yes, push the open bracket -; open := RASSOC(x,$checkPrenAlist) => --it is a close bracket! -; stack is [top,:restStack] => --does corresponding open bracket match? -; if open ^= top then --yes: just pop the stack -; checkDocError -; ['"Mismatch: left ",checkSayBracket top,'" matches right ",checkSayBracket open] -; stack := restStack -; checkDocError ['"Missing left ",checkSayBracket open] -; u := rest u -; if stack then -; for x in NREVERSE stack repeat -; checkDocError ['"Missing right ",checkSayBracket x] -; u - -;(DEFUN |checkBalance| (|u|) -; (PROG (|x| |openClose| |open| |top| |restStack| |stack|) -; (declare (special |$checkPrenAlist|)) -; (RETURN -; (SEQ (PROGN -; (|checkBeginEnd| |u|) -; (SPADLET |stack| NIL) -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (|do| (PROGN -; (SPADLET |x| (CAR |u|)) -; (COND -; ((SPADLET |openClose| -; (|assoc| |x| |$checkPrenAlist|)) -; (SPADLET |stack| -; (CONS (CAR |openClose|) -; |stack|))) -; ((SPADLET |open| -; (|rassoc| |x| -; |$checkPrenAlist|)) -; (COND -; ((AND (CONSP |stack|) -; (PROGN -; (SPADLET |top| -; (QCAR |stack|)) -; (SPADLET |restStack| -; (QCDR |stack|)) -; 'T)) -; (COND -; ((NEQUAL |open| |top|) -; (|checkDocError| -; (CONS -; "Mismatch: left " -; (CONS -; (|checkSayBracket| -; |top|) -; (CONS -; " matches right " -; (CONS -; (|checkSayBracket| -; |open|) -; NIL))))))) -; (SPADLET |stack| |restStack|)) -; ('T -; (|checkDocError| -; (CONS -; "Missing left " -; (CONS -; (|checkSayBracket| |open|) -; NIL))))))))) -; (SPADLET |u| (CDR |u|)))))) -; (COND -; (|stack| (DO ((G167759 (NREVERSE |stack|) -; (CDR G167759)) -; (|x| NIL)) -; ((OR (ATOM G167759) -; (PROGN -; (SETQ |x| (CAR G167759)) -; NIL)) -; NIL) -; (SEQ (EXIT (|checkDocError| -; (CONS -; "Missing right " -; (CONS (|checkSayBracket| |x|) -; NIL)))))))) -; |u|))))) - -;checkSayBracket x == -; x = char '_( or x = char '_) => '"pren" -; x = char '_{ or x = char '_} => '"brace" -; '"bracket" - -;(DEFUN |checkSayBracket| (|x|) -; (COND -; ((OR (BOOT-EQUAL |x| (|char| '|(|)) (BOOT-EQUAL |x| (|char| '|)|))) -; "pren") -; ((OR (BOOT-EQUAL |x| (|char| '{)) (BOOT-EQUAL |x| (|char| '}))) -; "brace") -; ('T "bracket"))) - -;checkBeginEnd u == -; beginEndStack := nil -; while u repeat -; IDENTITY -; x := first u -; STRINGP x and x.0 = $charBack and #x > 2 and not HGET($htMacroTable,x) -; and not (x = '"\spadignore") and IFCAR IFCDR u = $charLbrace -; and not -; (substring?('"\radiobox",x,0) or substring?('"\inputbox",x,0))=> -; --allow 0 argument guys to pass through -; checkDocError ["Unexpected HT command: ",x] -; x = '"\beginitems" => -; beginEndStack := ["items",:beginEndStack] -; x = '"\begin" => -; u is [.,=$charLbrace,y,:r] and CAR r = $charRbrace => -; if not MEMBER(y,$beginEndList) then -; checkDocError ['"Unknown begin type: \begin{",y,'"}"] -; beginEndStack := [y,:beginEndStack] -; u := r -; checkDocError ['"Improper \begin command"] -; x = '"\item" => -; MEMBER(IFCAR beginEndStack,'("items" "menu")) => nil -; null beginEndStack => -; checkDocError ['"\item appears outside a \begin-\end"] -; checkDocError ['"\item appears within a \begin{",IFCAR beginEndStack,'"}.."] -; x = '"\end" => -; u is [.,=$charLbrace,y,:r] and CAR r = $charRbrace => -; y = IFCAR beginEndStack => -; beginEndStack := rest beginEndStack -; u := r -; checkDocError ['"Trying to match \begin{",IFCAR beginEndStack,'"} with \end{",y,"}"] -; checkDocError ['"Improper \end command"] -; u := rest u -; beginEndStack => checkDocError ['"Missing \end{",first beginEndStack,'"}"] -; 'ok - -;(DEFUN |checkBeginEnd| (|u|) -; (PROG (|x| |ISTMP#1| |ISTMP#2| |y| |r| |beginEndStack|) -; (declare (special |$charRbrace| |$charLbrace| |$beginEndList| |$charBack| -; |$htMacroTable|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |beginEndStack| NIL) -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (IDENTITY -; (PROGN -; (SPADLET |x| (CAR |u|)) -; (COND -; ((AND (STRINGP |x|) -; (BOOT-EQUAL (ELT |x| 0) -; |$charBack|) -; (> (|#| |x|) 2) -; (NULL (HGET |$htMacroTable| |x|)) -; (NULL -; (BOOT-EQUAL |x| -; "\\spadignore")) -; (BOOT-EQUAL (IFCAR (IFCDR |u|)) -; |$charLbrace|) -; (NULL -; (OR -; (|substring?| -; "\\radiobox" |x| -; 0) -; (|substring?| -; "\\inputbox" |x| -; 0)))) -; (|checkDocError| -; (CONS '|Unexpected HT command: | -; (CONS |x| NIL)))) -; ((BOOT-EQUAL |x| -; "\\beginitems") -; (SPADLET |beginEndStack| -; (CONS '|items| |beginEndStack|))) -; ((BOOT-EQUAL |x| -; "\\begin") -; (COND -; ((AND (CONSP |u|) -; (PROGN -; (SPADLET |ISTMP#1| -; (QCDR |u|)) -; (AND (CONSP |ISTMP#1|) -; (EQUAL (QCAR |ISTMP#1|) -; |$charLbrace|) -; (PROGN -; (SPADLET |ISTMP#2| -; (QCDR |ISTMP#1|)) -; (AND (CONSP |ISTMP#2|) -; (PROGN -; (SPADLET |y| -; (QCAR |ISTMP#2|)) -; (SPADLET |r| -; (QCDR |ISTMP#2|)) -; 'T))))) -; (BOOT-EQUAL (CAR |r|) -; |$charRbrace|)) -; (COND -; ((NULL -; (|member| |y| -; |$beginEndList|)) -; (|checkDocError| -; (CONS -; "Unknown begin type: \\begin{" -; (CONS |y| -; (CONS "}" -; NIL)))))) -; (SPADLET |beginEndStack| -; (CONS |y| |beginEndStack|)) -; (SPADLET |u| |r|)) -; ('T -; (|checkDocError| -; (CONS -; "Improper \\begin command" -; NIL))))) -; ((BOOT-EQUAL |x| -; "\\item") -; (COND -; ((|member| -; (IFCAR |beginEndStack|) -; '("items" "menu")) -; NIL) -; ((NULL |beginEndStack|) -; (|checkDocError| -; (CONS -; "\\item appears outside a \\begin-\\end" -; NIL))) -; ('T -; (|checkDocError| -; (CONS -; "\\item appears within a \\begin{" -; (CONS (IFCAR |beginEndStack|) -; (CONS "}.." -; NIL))))))) -; ((BOOT-EQUAL |x| -; "\\end") -; (COND -; ((AND (CONSP |u|) -; (PROGN -; (SPADLET |ISTMP#1| -; (QCDR |u|)) -; (AND (CONSP |ISTMP#1|) -; (EQUAL (QCAR |ISTMP#1|) -; |$charLbrace|) -; (PROGN -; (SPADLET |ISTMP#2| -; (QCDR |ISTMP#1|)) -; (AND (CONSP |ISTMP#2|) -; (PROGN -; (SPADLET |y| -; (QCAR |ISTMP#2|)) -; (SPADLET |r| -; (QCDR |ISTMP#2|)) -; 'T))))) -; (BOOT-EQUAL (CAR |r|) -; |$charRbrace|)) -; (COND -; ((BOOT-EQUAL |y| -; (IFCAR |beginEndStack|)) -; (SPADLET |beginEndStack| -; (CDR |beginEndStack|)) -; (SPADLET |u| |r|)) -; ('T -; (|checkDocError| -; (CONS -; "Trying to match \\begin{" -; (CONS -; (IFCAR |beginEndStack|) -; (CONS -; "} with \\end{" -; (CONS |y| (CONS '} NIL))))))))) -; ('T -; (|checkDocError| -; (CONS -; "Improper \\end command" -; NIL)))))))) -; (SPADLET |u| (CDR |u|)))))) -; (COND -; (|beginEndStack| -; (|checkDocError| -; (CONS "Missing \\end{" -; (CONS (CAR |beginEndStack|) -; (CONS "}" NIL))))) -; ('T '|ok|))))))) - -;checkArguments u == -; while u repeat -; do -; x := first u -; null (k := HGET($htMacroTable,x)) => 'skip -; k = 0 => 'skip -; k > 0 => checkHTargs(x,rest u,k,nil) -; checkHTargs(x,rest u,-k,true) -; u := rest u -; u - -;(DEFUN |checkArguments| (|u|) -; (PROG (|x| |k|) -; (declare (special |$htMacroTable|)) -; (RETURN -; (SEQ (PROGN -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (|do| (PROGN -; (SPADLET |x| (CAR |u|)) -; (COND -; ((NULL -; (SPADLET |k| -; (HGET |$htMacroTable| |x|))) -; '|skip|) -; ((EQL |k| 0) '|skip|) -; ((> |k| 0) -; (|checkHTargs| |x| (CDR |u|) |k| -; NIL)) -; ('T -; (|checkHTargs| |x| (CDR |u|) -; (SPADDIFFERENCE |k|) 'T))))) -; (SPADLET |u| (CDR |u|)))))) -; |u|))))) - -;checkHTargs(keyword,u,nargs,integerValue?) == -;--u should start with an open brace ... -; nargs = 0 => 'ok -; if not (u := checkLookForLeftBrace u) then -; return checkDocError ['"Missing argument for ",keyword] -; if not (u := checkLookForRightBrace IFCDR u) then -; return checkDocError ['"Missing right brace for ",keyword] -; checkHTargs(keyword,rest u,nargs - 1,integerValue?) - -;(DEFUN |checkHTargs| (|keyword| |u| |nargs| |integerValue?|) -; (PROG () -; (RETURN -; (COND -; ((EQL |nargs| 0) '|ok|) -; ('T -; (COND -; ((NULL (SPADLET |u| (|checkLookForLeftBrace| |u|))) -; (RETURN -; (|checkDocError| -; (CONS "Missing argument for " -; (CONS |keyword| NIL)))))) -; (COND -; ((NULL (SPADLET |u| (|checkLookForRightBrace| (IFCDR |u|)))) -; (RETURN -; (|checkDocError| -; (CONS "Missing right brace for " -; (CONS |keyword| NIL)))))) -; (|checkHTargs| |keyword| (CDR |u|) (SPADDIFFERENCE |nargs| 1) -; |integerValue?|)))))) - -;checkLookForLeftBrace(u) == --return line beginning with left brace -; while u repeat -; x := first u -; if x = $charLbrace then return u -; x ^= $charBlank => return nil -; u := rest u -; u - -;(DEFUN |checkLookForLeftBrace| (|u|) -; (PROG (|x|) -; (declare (special |$charBlank| |$charLbrace|)) -; (RETURN -; (SEQ (PROGN -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |x| (CAR |u|)) -; (COND -; ((BOOT-EQUAL |x| |$charLbrace|) -; (RETURN |u|))) -; (COND -; ((NEQUAL |x| |$charBlank|) (RETURN NIL)) -; ('T (SPADLET |u| (CDR |u|)))))))) -; |u|))))) - -;checkLookForRightBrace(u) == --return line beginning with right brace -; count := 0 -; while u repeat -; x := first u -; do -; x = $charRbrace => -; count = 0 => return (found := u) -; count := count - 1 -; x = $charLbrace => count := count + 1 -; u := rest u -; found - -;(DEFUN |checkLookForRightBrace| (|u|) -; (PROG (|x| |found| |count|) -; (declare (special |$charLbrace| |$charRbrace|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |count| 0) -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |x| (CAR |u|)) -; (|do| (COND -; ((BOOT-EQUAL |x| |$charRbrace|) -; (COND -; ((EQL |count| 0) -; (RETURN (SPADLET |found| |u|))) -; ('T -; (SPADLET |count| -; (SPADDIFFERENCE |count| 1))))) -; ((BOOT-EQUAL |x| |$charLbrace|) -; (SPADLET |count| (PLUS |count| 1))))) -; (SPADLET |u| (CDR |u|)))))) -; |found|))))) - -;checkInteger s == -; CHARP s => false -; s = '"" => false -; and/[DIGIT_-CHAR_-P s.i for i in 0..MAXINDEX s] - -(DEFUN |checkInteger| (|s|) - (PROG () - (RETURN - (SEQ (COND - ((CHARP |s|) NIL) - ((BOOT-EQUAL |s| "") NIL) - ('T - (PROG (G167927) - (SPADLET G167927 'T) - (RETURN - (DO ((G167933 NIL (NULL G167927)) - (G167934 (MAXINDEX |s|)) (|i| 0 (QSADD1 |i|))) - ((OR G167933 (QSGREATERP |i| G167934)) - G167927) - (SEQ (EXIT (SETQ G167927 - (AND G167927 - (DIGIT-CHAR-P (ELT |s| |i|))))))))))))))) - -;checkTransformFirsts(opname,u,margin) == -;--case 1: \spad{... -;--case 2: form(args) -;--case 3: form arg -;--case 4: op arg -;--case 5: arg op arg -; namestring := PNAME opname -; if namestring = '"Zero" then namestring := '"0" -; else if namestring = '"One" then namestring := '"1" -; margin > 0 => -; s := leftTrim u -; STRCONC(fillerSpaces margin,checkTransformFirsts(opname,s,0)) -; m := MAXINDEX u -; m < 2 => u -; u.0 = $charBack => u -; ALPHA_-CHAR_-P u.0 => -; i := checkSkipToken(u,0,m) or return u -; j := checkSkipBlanks(u,i,m) or return u -; open := u.j -; open = char '_[ and (close := char '_]) or -; open = char '_( and (close := char '_)) => -; k := getMatchingRightPren(u,j + 1,open,close) -; namestring ^= (firstWord := SUBSTRING(u,0,i)) => -; checkDocError ['"Improper first word in comments: ",firstWord] -; u -; null k => -; if open = char '_[ -; then checkDocError ['"Missing close bracket on first line: ", u] -; else checkDocError ['"Missing close parenthesis on first line: ", u] -; u -; STRCONC('"\spad{",SUBSTRING(u,0,k + 1),'"}",SUBSTRING(u,k + 1,nil)) -; k := checkSkipToken(u,j,m) or return u -; infixOp := INTERN SUBSTRING(u,j,k - j) -; not GET(infixOp,'Led) => --case 3 -; namestring ^= (firstWord := SUBSTRING(u,0,i)) => -; checkDocError ['"Improper first word in comments: ",firstWord] -; u -; #(p := PNAME infixOp) = 1 and (open := p.0) and -; (close := LASSOC(open,$checkPrenAlist)) => --have an open bracket -; l := getMatchingRightPren(u,k + 1,open,close) -; if l > MAXINDEX u then l := k - 1 -; STRCONC('"\spad{",SUBSTRING(u,0,l + 1),'"}",SUBSTRING(u,l + 1,nil)) -; STRCONC('"\spad{",SUBSTRING(u,0,k),'"}",SUBSTRING(u,k,nil)) -; l := checkSkipBlanks(u,k,m) or return u -; n := checkSkipToken(u,l,m) or return u -; namestring ^= PNAME infixOp => -; checkDocError ['"Improper initial operator in comments: ",infixOp] -; u -; STRCONC('"\spad{",SUBSTRING(u,0,n),'"}",SUBSTRING(u,n,nil)) --case 5 -; true => -- not ALPHA_-CHAR_-P u.0 => -; i := checkSkipToken(u,0,m) or return u -; namestring ^= (firstWord := SUBSTRING(u,0,i)) => -; checkDocError ['"Improper first word in comments: ",firstWord] -; u -; prefixOp := INTERN SUBSTRING(u,0,i) -; not GET(prefixOp,'Nud) => -; u ---what could this be? -; j := checkSkipBlanks(u,i,m) or return u -; u.j = char '_( => --case 4 -; j := getMatchingRightPren(u,j + 1,char '_(,char '_)) -; j > m => u -; STRCONC('"\spad{",SUBSTRING(u,0,j + 1),'"}",SUBSTRING(u,j + 1,nil)) -; k := checkSkipToken(u,j,m) or return u -; namestring ^= (firstWord := SUBSTRING(u,0,i)) => -; checkDocError ['"Improper first word in comments: ",firstWord] -; u -; STRCONC('"\spad{",SUBSTRING(u,0,k),'"}",SUBSTRING(u,k,nil)) - -;(DEFUN |checkTransformFirsts| (|opname| |u| |margin|) -; (PROG (|namestring| |s| |m| |infixOp| |p| |open| |close| |l| |n| |i| -; |prefixOp| |j| |k| |firstWord|) -; (declare (special |$checkPrenAlist| |$charBack|)) -; (RETURN -; (PROGN -; (SPADLET |namestring| (PNAME |opname|)) -; (COND -; ((BOOT-EQUAL |namestring| "Zero") -; (SPADLET |namestring| "0")) -; ((BOOT-EQUAL |namestring| "One") -; (SPADLET |namestring| "1")) -; ('T NIL)) -; (COND -; ((> |margin| 0) (SPADLET |s| (|leftTrim| |u|)) -; (STRCONC (|fillerSpaces| |margin|) -; (|checkTransformFirsts| |opname| |s| 0))) -; ('T (SPADLET |m| (MAXINDEX |u|)) -; (COND -; ((> 2 |m|) |u|) -; ((BOOT-EQUAL (ELT |u| 0) |$charBack|) |u|) -; ((ALPHA-CHAR-P (ELT |u| 0)) -; (SPADLET |i| -; (OR (|checkSkipToken| |u| 0 |m|) (RETURN |u|))) -; (SPADLET |j| -; (OR (|checkSkipBlanks| |u| |i| |m|) -; (RETURN |u|))) -; (SPADLET |open| (ELT |u| |j|)) -; (COND -; ((OR (AND (BOOT-EQUAL |open| (|char| '[)) -; (SPADLET |close| (|char| ']))) -; (AND (BOOT-EQUAL |open| (|char| '|(|)) -; (SPADLET |close| (|char| '|)|)))) -; (SPADLET |k| -; (|getMatchingRightPren| |u| (PLUS |j| 1) -; |open| |close|)) -; (COND -; ((NEQUAL |namestring| -; (SPADLET |firstWord| (SUBSTRING |u| 0 |i|))) -; (|checkDocError| -; (CONS "Improper first word in comments: " -; (CONS |firstWord| NIL))) -; |u|) -; ((NULL |k|) -; (COND -; ((BOOT-EQUAL |open| (|char| '[)) -; (|checkDocError| -; (CONS "Missing close bracket on first line: " -; (CONS |u| NIL)))) -; ('T -; (|checkDocError| -; (CONS "Missing close parenthesis on first line: " -; (CONS |u| NIL))))) -; |u|) -; ('T -; (STRCONC "\\spad{" -; (SUBSTRING |u| 0 (PLUS |k| 1)) -; "}" -; (SUBSTRING |u| (PLUS |k| 1) NIL))))) -; ('T -; (SPADLET |k| -; (OR (|checkSkipToken| |u| |j| |m|) -; (RETURN |u|))) -; (SPADLET |infixOp| -; (INTERN (SUBSTRING |u| |j| -; (SPADDIFFERENCE |k| |j|)))) -; (COND -; ((NULL (GETL |infixOp| '|Led|)) -; (COND -; ((NEQUAL |namestring| -; (SPADLET |firstWord| -; (SUBSTRING |u| 0 |i|))) -; (|checkDocError| -; (CONS "Improper first word in comments: " -; (CONS |firstWord| NIL))) -; |u|) -; ((AND (EQL (|#| (SPADLET |p| (PNAME |infixOp|))) -; 1) -; (SPADLET |open| (ELT |p| 0)) -; (SPADLET |close| -; (LASSOC |open| |$checkPrenAlist|))) -; (SPADLET |l| -; (|getMatchingRightPren| |u| -; (PLUS |k| 1) |open| |close|)) -; (COND -; ((> |l| (MAXINDEX |u|)) -; (SPADLET |l| (SPADDIFFERENCE |k| 1)))) -; (STRCONC "\\spad{" -; (SUBSTRING |u| 0 (PLUS |l| 1)) -; "}" -; (SUBSTRING |u| (PLUS |l| 1) NIL))) -; ('T -; (STRCONC "\\spad{" -; (SUBSTRING |u| 0 |k|) "}" -; (SUBSTRING |u| |k| NIL))))) -; ('T -; (SPADLET |l| -; (OR (|checkSkipBlanks| |u| |k| |m|) -; (RETURN |u|))) -; (SPADLET |n| -; (OR (|checkSkipToken| |u| |l| |m|) -; (RETURN |u|))) -; (COND -; ((NEQUAL |namestring| (PNAME |infixOp|)) -; (|checkDocError| -; (CONS "Improper initial operator in comments: " -; (CONS |infixOp| NIL))) -; |u|) -; ('T -; (STRCONC "\\spad{" -; (SUBSTRING |u| 0 |n|) "}" -; (SUBSTRING |u| |n| NIL))))))))) -; ('T -; (SPADLET |i| -; (OR (|checkSkipToken| |u| 0 |m|) (RETURN |u|))) -; (COND -; ((NEQUAL |namestring| -; (SPADLET |firstWord| (SUBSTRING |u| 0 |i|))) -; (|checkDocError| -; (CONS "Improper first word in comments: " -; (CONS |firstWord| NIL))) -; |u|) -; ('T (SPADLET |prefixOp| (INTERN (SUBSTRING |u| 0 |i|))) -; (COND -; ((NULL (GETL |prefixOp| '|Nud|)) |u|) -; ('T -; (SPADLET |j| -; (OR (|checkSkipBlanks| |u| |i| |m|) -; (RETURN |u|))) -; (COND -; ((BOOT-EQUAL (ELT |u| |j|) (|char| '|(|)) -; (SPADLET |j| -; (|getMatchingRightPren| |u| -; (PLUS |j| 1) (|char| '|(|) -; (|char| '|)|))) -; (COND -; ((> |j| |m|) |u|) -; ('T -; (STRCONC "\\spad{" -; (SUBSTRING |u| 0 (PLUS |j| 1)) -; "}" -; (SUBSTRING |u| (PLUS |j| 1) NIL))))) -; ('T -; (SPADLET |k| -; (OR (|checkSkipToken| |u| |j| |m|) -; (RETURN |u|))) -; (COND -; ((NEQUAL |namestring| -; (SPADLET |firstWord| -; (SUBSTRING |u| 0 |i|))) -; (|checkDocError| -; (CONS "Improper first word in comments: " -; (CONS |firstWord| NIL))) -; |u|) -; ('T -; (STRCONC "\\spad{" -; (SUBSTRING |u| 0 |k|) -; "}" -; (SUBSTRING |u| |k| NIL)))))))))))))))))) - -;getMatchingRightPren(u,j,open,close) == -; count := 0 -; m := MAXINDEX u -; for i in j..m repeat -; c := u . i -; do -; c = close => -; count = 0 => return (found := i) -; count := count - 1 -; c = open => count := count + 1 -; found - -;(DEFUN |getMatchingRightPren| (|u| |j| |open| |close|) -; (PROG (|m| |c| |found| |count|) -; (RETURN -; (SEQ (PROGN -; (SPADLET |count| 0) -; (SPADLET |m| (MAXINDEX |u|)) -; (DO ((|i| |j| (+ |i| 1))) ((> |i| |m|) NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |c| (ELT |u| |i|)) -; (|do| (COND -; ((BOOT-EQUAL |c| |close|) -; (COND -; ((EQL |count| 0) -; (RETURN (SPADLET |found| |i|))) -; ('T -; (SPADLET |count| -; (SPADDIFFERENCE |count| 1))))) -; ((BOOT-EQUAL |c| |open|) -; (SPADLET |count| (PLUS |count| 1))))))))) -; |found|))))) - -;checkSkipBlanks(u,i,m) == -; while i < m and u.i = $charBlank repeat i := i + 1 -; i = m => nil -; i - -;(DEFUN |checkSkipBlanks| (|u| |i| |m|) -; (declare (special |$charBlank|)) -; (SEQ (PROGN -; (DO () -; ((NULL (AND (> |m| |i|) -; (BOOT-EQUAL (ELT |u| |i|) |$charBlank|))) -; NIL) -; (SEQ (EXIT (SPADLET |i| (PLUS |i| 1))))) -; (COND ((BOOT-EQUAL |i| |m|) NIL) ('T |i|))))) - -;checkSkipToken(u,i,m) == -; ALPHA_-CHAR_-P(u.i) => checkSkipIdentifierToken(u,i,m) -; checkSkipOpToken(u,i,m) - -;(DEFUN |checkSkipToken| (|u| |i| |m|) -; (COND -; ((ALPHA-CHAR-P (ELT |u| |i|)) -; (|checkSkipIdentifierToken| |u| |i| |m|)) -; ('T (|checkSkipOpToken| |u| |i| |m|)))) - -;checkSkipOpToken(u,i,m) == -; while i < m and -; (not(checkAlphabetic(u.i)) and not(MEMBER(u.i,$charDelimiters))) repeat -; i := i + 1 -; i = m => nil -; i - -;(DEFUN |checkSkipOpToken| (|u| |i| |m|) -; (declare (special |$charDelimiters|)) -; (SEQ (PROGN -; (DO () -; ((NULL (AND (> |m| |i|) -; (NULL (|checkAlphabetic| (ELT |u| |i|))) -; (NULL (|member| (ELT |u| |i|) -; |$charDelimiters|)))) -; NIL) -; (SEQ (EXIT (SPADLET |i| (PLUS |i| 1))))) -; (COND ((BOOT-EQUAL |i| |m|) NIL) ('T |i|))))) - -;checkSkipIdentifierToken(u,i,m) == -; while i < m and checkAlphabetic u.i repeat i := i + 1 -; i = m => nil -; i - -;(DEFUN |checkSkipIdentifierToken| (|u| |i| |m|) -; (SEQ (PROGN -; (DO () -; ((NULL (AND (> |m| |i|) (|checkAlphabetic| (ELT |u| |i|)))) -; NIL) -; (SEQ (EXIT (SPADLET |i| (PLUS |i| 1))))) -; (COND ((BOOT-EQUAL |i| |m|) NIL) ('T |i|))))) - -;checkAlphabetic c == -; ALPHA_-CHAR_-P c or DIGITP c or MEMQ(c,$charIdentifierEndings) - -;(DEFUN |checkAlphabetic| (|c|) -; (declare (special |$charIdentifierEndings|)) -; (OR (ALPHA-CHAR-P |c|) (DIGITP |c|) -; (member |c| |$charIdentifierEndings|))) - -;--======================================================================= -;-- Code for creating a personalized report for ++ comments -;--======================================================================= -;docreport(nam) == -;--creates a report for person "nam" using file "whofiles" -; OBEY '"rm docreport.input" -; OBEY STRCONC('"echo _")bo setOutStream('",STRINGIMAGE nam,'")_" > temp.input") -; OBEY '"cat docreport.header temp.input > docreport.input" -; OBEY STRCONC('"awk '/",STRINGIMAGE nam,'"/ {printf(_")co %s.spad\n_",$2)}' whofiles > temp.input") -; OBEY '"cat docreport.input temp.input > temp1.input" -; OBEY '"cat temp1.input docreport.trailer > docreport.input" -; OBEY '"rm temp.input" -; OBEY '"rm temp1.input" -; SETQ(_/EDITFILE,'"docreport.input") -; _/RQ() - -(DEFUN |docreport| (|nam|) - (PROGN - (OBEY "rm docreport.input") - (OBEY (STRCONC "echo \")bo setOutStream('" - (STRINGIMAGE |nam|) ")\" > temp.input")) - (OBEY "cat docreport.header temp.input > docreport.input") - (OBEY (STRCONC "awk '/" (STRINGIMAGE |nam|) - "/ {printf(\")co %s.spad\\n\",$2)}' whofiles > temp.input")) - (OBEY "cat docreport.input temp.input > temp1.input") - (OBEY "cat temp1.input docreport.trailer > docreport.input") - (OBEY "rm temp.input") - (OBEY "rm temp1.input") - (SETQ /EDITFILE "docreport.input") - (/RQ))) - -;setOutStream nam == -; filename := STRCONC('"/tmp/",STRINGIMAGE nam,".docreport") -; $outStream := MAKE_-OUTSTREAM filename - -(DEFUN |setOutStream| (|nam|) - (PROG (|filename|) - (declare (special |$outStream|)) - (RETURN - (PROGN - (SPADLET |filename| - (STRCONC "/tmp/" (STRINGIMAGE |nam|) - (INTERN ".docreport" "BOOT"))) - (SPADLET |$outStream| (MAKE-OUTSTREAM |filename|)))))) - -;whoOwns(con) == -; null $exposeFlag => nil -;--con=constructor name (id beginning with a capital), returns owner as a string -; filename := GETDATABASE(con,'SOURCEFILE) -; quoteChar := char '_" -; OBEY STRCONC('"awk '$2 == ",quoteChar,filename,quoteChar,'" {print $1}' whofiles > /tmp/temp") -; instream := MAKE_-INSTREAM '"/tmp/temp" -; value := -; EOFP instream => nil -; READLINE instream -; SHUT instream -; value - -;(DEFUN |whoOwns| (|con|) -; (PROG (|filename| |quoteChar| |instream| |value|) -; (declare (special |$exposeFlag|)) -; (RETURN -; (COND -; ((NULL |$exposeFlag|) NIL) -; ('T (SPADLET |filename| (GETDATABASE |con| 'SOURCEFILE)) -; (SPADLET |quoteChar| (|char| '|"|)) -; (OBEY (STRCONC "awk '$2 == " |quoteChar| -; |filename| |quoteChar| -; " {print $1}' whofiles > /tmp/temp")) -; (SPADLET |instream| (MAKE-INSTREAM "/tmp/temp")) -; (SPADLET |value| -; (COND -; ((EOFP |instream|) NIL) -; ('T (READLINE |instream|)))) -; (SHUT |instream|) |value|))))) - -;--======================================================================= -;-- Report Documentation Error -;--======================================================================= -;checkDocError1 u == -;--when compiling for documentation, ignore certain errors -; BOUNDP '$compileDocumentation and $compileDocumentation => nil -; checkDocError u - -;(DEFUN |checkDocError1| (|u|) -; (declare (special |$compileDocumentation|)) -; (COND -; ((AND (BOUNDP '|$compileDocumentation|) |$compileDocumentation|) -; NIL) -; ('T (|checkDocError| |u|)))) - -;checkDocError u == -; $checkErrorFlag := true -; msg := -; $recheckingFlag => -; $constructorName => checkDocMessage u -; concat('"> ",u) -; $constructorName => checkDocMessage u -; u -; if $exposeFlag and $exposeFlagHeading then -; SAYBRIGHTLY1($exposeFlagHeading,$outStream) -; sayBrightly $exposeFlagHeading -; $exposeFlagHeading := nil -; sayBrightly msg -; if $exposeFlag then SAYBRIGHTLY1(msg,$outStream) - -;(DEFUN |checkDocError| (|u|) -; (PROG (|msg|) -; (declare (special |$outStream| |$exposeFlag| |$exposeFlagHeading| -; |$constructorName| |$recheckingFlag| |$checkErrorFlag|)) -; (RETURN -; (PROGN -; (SPADLET |$checkErrorFlag| 'T) -; (SPADLET |msg| -; (COND -; (|$recheckingFlag| -; (COND -; (|$constructorName| (|checkDocMessage| |u|)) -; ('T (|concat| "> " |u|)))) -; (|$constructorName| (|checkDocMessage| |u|)) -; ('T |u|))) -; (COND -; ((AND |$exposeFlag| |$exposeFlagHeading|) -; (SAYBRIGHTLY1 |$exposeFlagHeading| |$outStream|) -; (|sayBrightly| |$exposeFlagHeading|) -; (SPADLET |$exposeFlagHeading| NIL))) -; (|sayBrightly| |msg|) -; (COND -; (|$exposeFlag| (SAYBRIGHTLY1 |msg| |$outStream|)) -; ('T NIL)))))) - -; --if called by checkDocFile (see file checkdoc.boot) -;checkDocMessage u == -; sourcefile := GETDATABASE($constructorName,'SOURCEFILE) -; person := whoOwns $constructorName or '"---" -; middle := -; BOUNDP '$x => ['"(",$x,'"): "] -; ['": "] -; concat(person,'">",sourcefile,'"-->",$constructorName,middle,u) - -;(DEFUN |checkDocMessage| (|u|) -; (PROG (|sourcefile| |person| |middle|) -; (declare (special |$constructorName| |$x|)) -; (RETURN -; (PROGN -; (SPADLET |sourcefile| -; (GETDATABASE |$constructorName| 'SOURCEFILE)) -; (SPADLET |person| -; (OR (|whoOwns| |$constructorName|) "---")) -; (SPADLET |middle| -; (COND -; ((BOUNDP '|$x|) -; (CONS "(" -; (CONS |$x| (CONS "): " NIL)))) -; ('T (CONS ": " NIL)))) -; (|concat| |person| ">" |sourcefile| -; "-->" |$constructorName| |middle| |u|))))) - -;checkDecorateForHt u == -; count := 0 -; spadflag := false --means OK to wrap single letter words with \s{} -; while u repeat -; x := first u -; do -; if x = '"\em" then -; if count > 0 then spadflag := count - 1 -; else checkDocError ['"\em must be enclosed in braces"] -; if MEMBER(x,'("\s" "\spadop" "\spadtype" "\spad" "\spadpaste" "\spadcommand" "\footnote")) then spadflag := count -; else if x = $charLbrace then count := count + 1 -; else if x = $charRbrace then -; count := count - 1 -; if spadflag = count then spadflag := false -; else if not spadflag and MEMBER(x,'("+" "*" "=" "==" "->")) then -; if $checkingXmptex? then -; checkDocError ["Symbol ",x,'" appearing outside \spad{}"] -; x = '"$" or x = '"%" => checkDocError ['"Unescaped ",x] -;-- null spadflag and STRINGP x and (MEMBER(x,$argl) or #x = 1 -;-- and ALPHA_-CHAR_-P x.0) and not MEMBER(x,'("a" "A")) => -;-- checkDocError1 ['"Naked ",x] -;-- null spadflag and STRINGP x and (not x.0 = $charBack and not DIGITP(x.0) and DIGITP(x.(MAXINDEX x))or MEMBER(x,'("true" "false"))) -;-- => checkDocError1 ["Naked ",x] -; u := rest u -; u - -;(DEFUN |checkDecorateForHt| (|u|) -; (PROG (|x| |count| |spadflag|) -; (declare (special |$checkingXmptex?| |$charRbrace| |$charLbrace|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |count| 0) -; (SPADLET |spadflag| NIL) -; (DO () ((NULL |u|) NIL) -; (SEQ (EXIT (PROGN -; (SPADLET |x| (CAR |u|)) -; (|do| (PROGN -; (COND -; ((BOOT-EQUAL |x| -; "\\em") -; (COND -; ((> |count| 0) -; (SPADLET |spadflag| -; (SPADDIFFERENCE |count| 1))) -; ('T -; (|checkDocError| -; (CONS -; "\\em must be enclosed in braces" -; NIL)))))) -; (COND -; ((|member| |x| -; '("\\s" "\\spadop" "\\spadtype" -; "\\spad" "\\spadpaste" -; "\\spadcommand" "\\footnote")) -; (SPADLET |spadflag| |count|)) -; ((BOOT-EQUAL |x| |$charLbrace|) -; (SPADLET |count| -; (PLUS |count| 1))) -; ((BOOT-EQUAL |x| |$charRbrace|) -; (SPADLET |count| -; (SPADDIFFERENCE |count| 1)) -; (COND -; ((BOOT-EQUAL |spadflag| -; |count|) -; (SPADLET |spadflag| NIL)) -; ('T NIL))) -; ((AND (NULL |spadflag|) -; (|member| |x| -; '("+" "*" "=" "==" "->"))) -; (COND -; (|$checkingXmptex?| -; (|checkDocError| -; (CONS '|Symbol | -; (CONS |x| -; (CONS -; " appearing outside \\spad{}" -; NIL))))) -; ('T NIL))) -; ('T NIL)) -; (COND -; ((OR -; (BOOT-EQUAL |x| -; "$") -; (BOOT-EQUAL |x| -; "%")) -; (|checkDocError| -; (CONS "Unescaped " -; (CONS |x| NIL))))))) -; (SPADLET |u| (CDR |u|)))))) -; |u|))))) - -\end{chunk} -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document}