diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 67bacbd..b349633 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -66,7 +66,7 @@ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, -BUT NOT LIMITED TO, PROCUREMENT OF SUBSTIUTE GOODS OR +BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING @@ -381,7 +381,7 @@ Equation(S: Type): public == private where ++ the lhs of eq2 should be a kernel private ==> add - Rep := Recod(lhs: S, rhs: S) + Rep := Record(lhs: S, rhs: S) eq1,eq2: $ s : S if S has IntegralDomain then @@ -19592,6 +19592,235 @@ deleting entries from u assumes that the first element is useless \end{chunk} +\defun{checkRecordHash}{checkRecordHash} +\calls{checkRecordHash}{member} +\calls{checkRecordHash}{checkLookForLeftBrace} +\calls{checkRecordHash}{checkLookForRightBrace} +\calls{checkRecordHash}{ifcdr} +\calls{checkRecordHash}{intern} +\calls{checkRecordHash}{hget} +\calls{checkRecordHash}{hput} +\calls{checkRecordHash}{checkGetLispFunctionName} +\calls{checkRecordHash}{checkGetStringBeforeRightBrace} +\calls{checkRecordHash}{checkGetParse} +\calls{checkRecordHash}{checkDocError} +\calls{checkRecordHash}{opOf} +\calls{checkRecordHash}{spadSysChoose} +\calls{checkRecordHash}{checkNumOfArgs} +\calls{checkRecordHash}{checkIsValidType} +\calls{checkRecordHash}{form2HtString} +\calls{checkRecordHash}{getl} +\refsdollar{checkRecordHash}{charBack} +\refsdollar{checkRecordHash}{HTlinks} +\refsdollar{checkRecordHash}{htHash} +\refsdollar{checkRecordHash}{HTlisplinks} +\refsdollar{checkRecordHash}{lispHash} +\refsdollar{checkRecordHash}{glossHash} +\refsdollar{checkRecordHash}{currentSysList} +\refsdollar{checkRecordHash}{setOptions} +\refsdollar{checkRecordHash}{sysHash} +\refsdollar{checkRecordHash}{name} +\refsdollar{checkRecordHash}{origin} +\defsdollar{checkRecordHash}{sysHash} +\defsdollar{checkRecordHash}{glossHash} +\defsdollar{checkRecordHash}{lispHash} +\defsdollar{checkRecordHash}{htHash} +\begin{chunk}{defun checkRecordHash} +(defun |checkRecordHash| (u) + (let (p q htname entry s parse n key x) + (declare (special |$origin| |$name| |$sysHash| |$setOptions| |$glossHash| + |$currentSysList| |$lispHash| |$HTlisplinks| |$htHash| + |$HTlinks| |$charBack|)) + (loop while u + do + (setq x (car u)) + (when (and (stringp x) (equal (elt x 0) |$charBack|)) + (cond + ((and (|member| x |$HTlinks|) + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (|checkLookForRightBrace| (ifcdr u))) + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (ifcdr u))) + (setq htname (|intern| (ifcar u))) + (setq entry (or (hget |$htHash| htname) (list nil))) + (hput |$htHash| htname + (cons (car entry) (cons (cons |$name| |$origin|) (cdr entry))))) + ((and (|member| x |$HTlisplinks|) + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (|checkLookForRightBrace| (ifcdr u))) + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (ifcdr u))) + (setq htname + (|intern| + (|checkGetLispFunctionName| + (|checkGetStringBeforeRightBrace| u)))) + (setq entry (or (hget |$lispHash| htname) (list nil))) + (hput |$lispHash| htname + (cons (car entry) (cons (cons |$name| |$origin|) (cdr entry))))) + ((and (or (setq p (|member| x '("\\gloss" "\\spadglos"))) + (setq q (|member| x '("\\glossSee" "\\spadglosSee")))) + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (ifcdr u))) + (when q + (setq u (|checkLookForRightBrace| u)) + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (ifcdr u))) + (setq htname (|intern| (|checkGetStringBeforeRightBrace| u))) + (setq entry + (or (hget |$glossHash| htname) (list nil))) + (hput |$glossHash| htname + (cons (car entry) (cons (cons |$name| |$origin|) (cdr entry))))) + ((and (boot-equal x "\\spadsys") + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (ifcdr u))) + (setq s (|checkGetStringBeforeRightBrace| u)) + (when (char= (elt s 0) #\)) (setq s (substring s 1 nil))) + (setq parse (|checkGetParse| s)) + (cond + ((null parse) + (|checkDocError| (list "Unparseable \\spadtype: " s))) + ((null (|member| (|opOf| parse) |$currentSysList|)) + (|checkDocError| (list "Bad system command: " s))) + ((or (atom parse) + (null (and (consp parse) (eq (qcar parse) '|set|) + (consp (qcdr parse)) + (eq (qcddr parse) nil)))) + '|ok|) + ((null (|spadSysChoose| |$setOptions| (qcadr parse))) + (progn + (|checkDocError| (list "Incorrect \\spadsys: " s)) + (setq entry (or (hget |$sysHash| htname) (list nil))) + (hput |$sysHash| htname + (cons (car entry) (cons (cons |$name| |$origin|) (cdr entry)))))))) + ((and (boot-equal x "\\spadtype") + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (ifcdr u))) + (setq s (|checkGetStringBeforeRightBrace| u)) + (setq parse (|checkGetParse| s)) + (cond + ((null parse) + (|checkDocError| (list "Unparseable \\spadtype: " s))) + (t + (setq n (|checkNumOfArgs| parse)) + (cond + ((null n) + (|checkDocError| (list "Unknown \\spadtype: " s))) + ((and (atom parse) (> n 0)) + '|skip|) + ((null (setq key (|checkIsValidType| parse))) + (|checkDocError| (list "Unknown \\spadtype: " s))) + ((atom key) '|ok|) + (t + (|checkDocError| + (list "Wrong number of arguments: " (|form2HtString| key)))))))) + ((and (|member| x '("\\spadop" "\\keyword")) + (setq u (|checkLookForLeftBrace| (ifcdr u))) + (setq u (ifcdr u))) + (setq x (|intern| (|checkGetStringBeforeRightBrace| u))) + (when (null (or (getl x '|Led|) (getl x '|Nud|))) + (|checkDocError| (list "Unknown \\spadop: " x)))))) + (pop u)) + '|done|)) + +\end{chunk} + +\defun{checkGetParse}{checkGetParse} +\calls{checkGetParse}{ncParseFromString} +\calls{checkGetParse}{removeBackslashes} +\begin{chunk}{defun checkGetParse} +(defun |checkGetParse| (s) + (|ncParseFromString| (|removeBackslashes| s))) + +\end{chunk} + +\defun{checkTexht}{checkTexht} +\calls{checkTexht}{ifcar} +\calls{checkTexht}{checkDocError} +\calls{checkTexht}{nequal} +\refsdollar{checkTexht}{charRbrace} +\refsdollar{checkTexht}{charLbrace} +\begin{chunk}{defun checkTexht} +(defun |checkTexht| (u) + (let (count y x acc) + (declare (special |$charRbrace| |$charLbrace|)) + (setq count 0) + (loop while u + do + (setq x (car u)) + (when (and (string= x "\\texht") (setq u (ifcdr u))) + (when (null (equal (ifcar u) |$charLbrace|)) + (|checkDocError| "First left brace after \\texht missing")) + ; drop first argument including braces of texht + (setq count 1) + (do () + ((null (or (nequal (setq y (ifcar (setq u (cdr u)))) |$charRbrace|) + (> count 1))) + nil) + (when (equal y |$charLbrace|) (setq count (1+ count))) + (when (equal y |$charRbrace|) (setq count (1- count)))) + ; drop first right brace of 1st arg + (setq x (ifcar (setq u (cdr u))))) + (when (and (string= x "\\httex") (setq u (ifcdr u)) + (equal (ifcar u) |$charLbrace|)) + (setq acc (cons (ifcar u) acc)) + (do () + ((null (nequal (setq y (ifcar (setq u (cdr u)))) |$charRbrace|)) + nil) + (setq acc (cons y acc))) + (setq acc (cons (ifcar u) acc)) ; left brace: add it + (setq x (ifcar (setq u (cdr u)))) ; left brace: forget it + (do () + ((null (nequal (ifcar (setq u (cdr u))) |$charRbrace|)) + nil) + '|skip|) + ; forget right brace; move to next character + (setq x (ifcar (setq u (cdr u))))) + (setq acc (cons x acc)) + (pop u)) + (nreverse acc))) + +\end{chunk} + + +\defun{checkDecorateForHt}{checkDecorateForHt} +\calls{checkDecorateForHt}{checkDocError} +\calls{checkDecorateForHt}{member} +\refsdollar{checkDecorateForHt}{checkingXmptex?} +\refsdollar{checkDecorateForHt}{charRbrace} +\refsdollar{checkDecorateForHt}{charLbrace} +\begin{chunk}{defun checkDecorateForHt} +(defun |checkDecorateForHt| (u) + (let (x count spadflag) + (declare (special |$checkingXmptex?| |$charRbrace| |$charLbrace|)) + (setq count 0) + (setq spadflag nil) + (loop while u + do + (setq x (car u)) + (when (equal x "\\em") + (if (> count 0) + (setq spadflag (1- count)) + (|checkDocError| (list "\\em must be enclosed in braces")))) + (cond + ((|member| x '("\\s" "\\spadop" "\\spadtype" "\\spad" "\\spadpaste" + "\\spadcommand" "\\footnote")) + (setq spadflag count)) + ((equal x |$charLbrace|) + (setq count (1+ count))) + ((equal x |$charRbrace|) + (setq count (1- count)) + (when (equal spadflag count) (setq spadflag nil))) + ((and (null spadflag) (|member| x '("+" "*" "=" "==" "->"))) + (when |$checkingXmptex?| + (|checkDocError| (list '|Symbol | x " appearing outside \\spad{}")))) + (t nil)) + (when (or (equal x "$") (equal x "%")) + (|checkDocError| (list "Unescaped " x))) + (pop u)) + u)) + +\end{chunk} + \defun{checkDocError1}{checkDocError1} \calls{checkDocError1}{checkDocError} \refsdollar{checkDocError1}{compileDocumentation} @@ -19660,6 +19889,30 @@ deleting entries from u assumes that the first element is useless \end{chunk} +\defun{whoOwns}{whoOwns} +\calls{whoOwns}{getdatabase} +\calls{whoOwns}{strconc} +\calls{whoOwns}{awk} +\calls{whoOwns}{shut} +\refsdollar{whoOwns}{exposeFlag} +\begin{chunk}{defun whoOwns} +(defun |whoOwns| (con) + (let (filename quoteChar instream value) + (declare (special |$exposeFlag|)) + (cond + ((null |$exposeFlag|) nil) + (t + (setq filename (getdatabase con 'sourcefile)) + (setq quoteChar #\") + (obey (strconc "awk '$2 == " quoteChar filename quoteChar + " {print $1}' whofiles > /tmp/temp")) + (setq instream (make-instream "/tmp/temp")) + (setq value (unless (eofp instream) (readline instream))) + (shut instream) + value)))) + +\end{chunk} + \defun{checkComments}{checkComments} \calls{checkComments}{checkGetMargin} \calls{checkComments}{nequal} @@ -19732,6 +19985,175 @@ deleting entries from u assumes that the first element is useless \end{chunk} +\defun{checkSplit2Words}{checkSplit2Words} +\calls{checkSplit2Words}{checkSplitBrace} +\begin{chunk}{defun checkSplit2Words} +(defun |checkSplit2Words| (u) + (let (x verbatim z acc) + (setq acc nil) + (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 z (|checkSplitBrace| x)) + (append (nreverse z) acc)) + (t (cons x acc)))) + (pop u)) + (nreverse acc))) + +\end{chunk} + +\defun{checkAddPeriod}{checkAddPeriod} +\calls{checkAddPeriod}{setelt} +\calls{checkAddPeriod}{maxindex} +\begin{chunk}{defun checkAddPeriod} +(defun |checkAddPeriod| (s) + (let (m lastChar) + (setq m (maxindex s)) + (setq lastChar (elt s m)) + (cond + ((or (char= lastChar #\!) (char= lastChar #\?) (char= lastChar #\.)) s) + ((or (char= lastChar #\,) (char= lastChar #\;)) + (setelt s m #\.) + s) + (t s)))) + +\end{chunk} + +\defun{checkBalance}{checkBalance} +\calls{checkPrenAlist}{checkBeginEnd} +\calls{checkPrenAlist}{assoc} +\calls{checkPrenAlist}{rassoc} +\calls{checkPrenAlist}{nequal} +\calls{checkPrenAlist}{checkDocError} +\calls{checkPrenAlist}{checkSayBracket} +\calls{checkPrenAlist}{nreverse} +\refsdollar{checkBalance}{checkPrenAlist} +\begin{chunk}{defun checkBalance} +(defun |checkBalance| (u) + (let (x openClose open top restStack stack) + (declare (special |$checkPrenAlist|)) + (|checkBeginEnd| u) + (setq stack nil) + (loop while u + do + (setq x (car u)) + (cond + ((setq openClose (|assoc| x |$checkPrenAlist|)) + (setq stack (cons (car openClose) stack))) + ((setq open (|rassoc| x |$checkPrenAlist|)) + (cond + ((consp stack) + (setq top (qcar stack)) + (setq restStack (qcdr stack)) + (when (nequal open top) + (|checkDocError| + (list "Mismatch: left " (|checkSayBracket| top) + " matches right " (|checkSayBracket| open)))) + (setq stack restStack)) + (t + (|checkDocError| + (list "Missing left " (|checkSayBracket| open))))))) + (pop u)) + (when stack + (loop for x in (nreverse stack) + do + (|checkDocError| (list "Missing right " (|checkSayBracket| x))))) + u)) + +\end{chunk} + +\defun{checkBeginEnd}{checkBeginEnd} +\calls{checkBeginEnd}{length} +\calls{checkBeginEnd}{hget} +\calls{checkBeginEnd}{ifcar} +\calls{checkBeginEnd}{ifcdr} +\calls{checkBeginEnd}{substring?} +\calls{checkBeginEnd}{checkDocError} +\calls{checkBeginEnd}{member} +\refsdollar{checkBeginEnd}{charRbrace} +\refsdollar{checkBeginEnd}{charLbrace} +\refsdollar{checkBeginEnd}{beginEndList} +\refsdollar{checkBeginEnd}{htMacroTable} +\refsdollar{checkBeginEnd}{charBack} +\begin{chunk}{defun checkBeginEnd} +(defun |checkBeginEnd| (u) + (let (x y beginEndStack) + (declare (special |$charRbrace| |$charLbrace| |$beginEndList| |$charBack| + |$htMacroTable|)) + (loop while u + do + (setq x (car u)) + (cond + ((and (stringp x) (equal (elt x 0) |$charBack|) (> (|#| x) 2) + (null (hget |$htMacroTable| x)) (null (equal x "\\spadignore")) + (equal (ifcar (ifcdr u)) |$charLbrace|) + (null (or (|substring?| "\\radiobox" x 0) + (|substring?| "\\inputbox" x 0)))) + (|checkDocError| (list '|Unexpected HT command: | x))) + ((equal x "\\beginitems") + (setq beginEndStack (cons '|items| beginEndStack))) + ((equal x "\\begin") + (cond + ((and (consp u) (consp (qcdr u)) (equal (qcar (qcdr u)) |$charLbrace|) + (consp (qcddr u)) (equal (car (qcdddr u)) |$charRbrace|)) + (setq y (qcaddr u)) + (cond + ((null (|member| y |$beginEndList|)) + (|checkDocError| (list "Unknown begin type: \\begin{" y "}")))) + (setq beginEndStack (cons y beginEndStack)) + (setq u (qcdddr u))) + (t (|checkDocError| (list "Improper \\begin command"))))) + ((equal x "\\item") + (cond + ((|member| (ifcar beginEndStack) '("items" "menu")) nil) + ((null beginEndStack) + (|checkDocError| (list "\\item appears outside a \\begin-\\end"))) + (t + (|checkDocError| + (list "\\item appears within a \\begin{" + (ifcar beginEndStack) "}.."))))) + ((equal x "\\end") + (cond + ((and (consp u) (consp (qcdr u)) (equal (qcar (qcdr u)) |$charLbrace|) + (consp (qcddr u)) (equal (car (qcdddr u)) |$charRbrace|)) + (setq y (qcaddr u)) + (cond + ((equal y (ifcar beginEndStack)) + (setq beginEndStack (cdr beginEndStack)) + (setq u (qcdddr u))) + (t + (|checkDocError| + (list "Trying to match \\begin{" (ifcar beginEndStack) + "} with \\end{" y "}"))))) + (t + (|checkDocError| (list "Improper \\end command")))))) + (pop u)) + (cond + (beginEndStack + (|checkDocError| (list "Missing \\end{" (car beginEndStack) "}"))) + (t '|ok|)))) + +\end{chunk} + +\defun{checkSayBracket}{checkSayBracket} +\begin{chunk}{defun checkSayBracket} +(defun |checkSayBracket| (x) + (cond + ((or (char= x #\() (char= x #\))) "pren") + ((or (char= x #\{) (char= x #\})) "brace") + (t "bracket"))) + +\end{chunk} + \defun{checkArguments}{checkArguments} \calls{checkArguments}{hget} \calls{checkArguments}{checkHTargs} @@ -19746,12 +20168,72 @@ deleting entries from u assumes that the first element is useless ((null (setq k (hget |$htMacroTable| x))) '|skip|) ((eql k 0) '|skip|) ((> k 0) (|checkHTargs| x (cdr u) k nil)) - (t (|checkHTargs| x (cdr u) -k t))) + (t (|checkHTargs| x (cdr u) (- k) t))) (pop u)) u)) \end{chunk} +\defun{checkHTargs}{checkHTargs} +Note that {\tt u} should start with an open brace. +\calls{checkHTargs}{checkLookForLeftBrace} +\calls{checkHTargs}{checkLookForRightBrace} +\calls{checkHTargs}{checkDocError} +\calls{checkHTargs}{checkHTargs} +\calls{checkHTargs}{ifcdr} +\begin{chunk}{defun checkHTargs} +(defun |checkHTargs| (keyword u nargs inteerValue?) + (cond + ((eql nargs 0) '|ok|) + ((null (setq u (|checkLookForLeftBrace| u))) + (|checkDocError| (list "Missing argument for " keyword))) + ((null (setq u (|checkLookForRightBrace| (ifcdr u)))) + (|checkDocError| (list "Missing right brace for " keyword))) + (t + (|checkHTargs| keyword (cdr u) (1- nargs) inteerValue?)))) + +\end{chunk} + +\defun{checkLookForLeftBrace}{checkLookForLeftBrace} +\calls{checkLookForLeftBrace}{nequal} +\refsdollar{checkLookForLeftBrace}{charBlank} +\refsdollar{checkLookForLeftBrace}{charLbrace} +\begin{chunk}{defun checkLookForLeftBrace} +(defun |checkLookForLeftBrace| (u) + (declare (special |$charBlank| |$charLbrace|)) + (loop while u + do + (cond + ((equal (car u) |$charLbrace|) (return (car u))) + ((nequal (car u) |$charBlank|) (return nil)) + (t (pop u)))) + u) + +\end{chunk} + +\defun{checkLookForRightBrace}{checkLookForRightBrace} +This returns a line beginning with right brace +\refsdollar{checkLookForRightBrace}{charLbrace} +\refsdollar{checkLookForRightBrace}{charRbrace} +\begin{chunk}{defun checkLookForRightBrace} +(defun |checkLookForRightBrace| (u) + (let (found count) + (declare (special |$charLbrace| |$charRbrace|)) + (setq count 0) + (loop while u + do + (cond + ((equal (car u) |$charRbrace|) + (if (eql count 0) + (return (setq found u)) + (setq count (1- count)))) + ((equal (car u) |$charLbrace|) + (setq count (1+ count)))) + (pop u)) + found)) + +\end{chunk} + \defun{checkTransformFirsts}{checkTransformFirsts} \calls{checkTransformFirsts}{pname} \calls{checkTransformFirsts}{leftTrim} @@ -24003,22 +24485,34 @@ The current input line. \getchunk{defun canReturn} \getchunk{defun char-eq} \getchunk{defun char-ne} +\getchunk{defun checkAddPeriod} \getchunk{defun checkAlphabetic} \getchunk{defun checkAndDeclare} \getchunk{defun checkArguments} +\getchunk{defun checkBalance} +\getchunk{defun checkBeginEnd} \getchunk{defun checkComments} +\getchunk{defun checkDecorateForHt} \getchunk{defun checkDocError} \getchunk{defun checkDocError1} \getchunk{defun checkDocMessage} \getchunk{defun checkExtract} \getchunk{defun checkGetMargin} +\getchunk{defun checkGetParse} +\getchunk{defun checkHTargs} \getchunk{defun checkIeEg} \getchunk{defun checkIeEgfun} +\getchunk{defun checkLookForLeftBrace} +\getchunk{defun checkLookForRightBrace} +\getchunk{defun checkRecordHash} \getchunk{defun checkRewrite} +\getchunk{defun checkSayBracket} \getchunk{defun checkSkipBlanks} \getchunk{defun checkSkipIdentifierToken} \getchunk{defun checkSkipOpToken} \getchunk{defun checkSkipToken} +\getchunk{defun checkSplit2Words} +\getchunk{defun checkTexht} \getchunk{defun checkTransformFirsts} \getchunk{defun checkWarning} \getchunk{defun coerce} @@ -24614,6 +25108,7 @@ The current input line. \getchunk{defun updateCategoryFrameForCategory} \getchunk{defun updateCategoryFrameForConstructor} +\getchunk{defun whoOwns} \getchunk{defun wrapDomainSub} \getchunk{defun writeLib1} diff --git a/changelog b/changelog index f613b2a..d7dd1ff 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20111124 tpd src/axiom-website/patches.html 20111124.02.tpd.patch +20111124 tpd src/interp/c-doc.lisp treeshake compiler +20111124 tpd books/bookvol9 treeshake compiler 20111124 tpd src/axiom-website/patches.html 20111124.01.tpd.patch 20111124 tpd src/axiom-website/documentation.html add quote 20111124 tpd src/axiom-website/litprog.html add quote diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 8629e70..0d76dbf 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3690,5 +3690,7 @@ books/bookvol9 treeshake compiler
src/axiom-website/litprog.html added
20111124.01.tpd.patch src/axiom-website/litprog.html add quote
+20111124.02.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/c-doc.lisp.pamphlet b/src/interp/c-doc.lisp.pamphlet index fd7ec11..44dab1d 100644 --- a/src/interp/c-doc.lisp.pamphlet +++ b/src/interp/c-doc.lisp.pamphlet @@ -229,383 +229,6 @@ G166663) (SEQ (EXIT (SETQ G166663 (STRCONC G166663 |x|)))))))))))) -;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 => @@ -1133,31 +756,6 @@ (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 @@ -1919,49 +1517,6 @@ ('T NIL)))))) |u2|)))))) -;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] @@ -2210,379 +1765,6 @@ (|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|))))))) - -;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 @@ -2651,130 +1833,9 @@ (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 ;--======================================================================= -;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