diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index b349633..a125289 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -7644,53 +7644,6 @@ Make pattern variable substitutions.
\end{chunk}
-\defun{checkExtract}{checkExtract}
-\calls{checkExtract}{firstNonBlankPosition}
-\calls{checkExtract}{substring?}
-\calls{checkExtract}{charPosition}
-\calls{checkExtract}{nequal}
-\calls{checkExtract}{length}
-\calls{checkExtract}{nreverse}
-\begin{chunk}{defun checkExtract}
-(defun |checkExtract| (header lines)
- (let (line u margin firstLines m k j i acc)
- ;; throw away lines until we find the header
- (while lines
- (setq line (car lines))
- (setq k (|firstNonBlankPosition| line))
- (when (|substring?| header line k) (return))
- (pop lines))
- ;; collect up the lines
- (when lines
- (setq u (car lines))
- (setq j (|charPosition| (|char| '|:|) 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)))
- (setq acc nil)
- ;; look for another header; if found skip all the rest of the lines
- (loop for line in firstLines
- do
- (setq m (|#| line))
- (cond
- ;; include if blank
- ((eql (setq k (|firstNonBlankPosition| line)) -1) '|skip|)
- ;; include if indented
- ((> k margin) '|skip|)
- ;; include if not uppercased
- ((null (upper-case-p (elt line k))) '|skip|)
- ;; include if not colon
- ((eql (setq j (|charPosition| (|char| '|:|) line k)) m) '|skip|)
- ;; include if blank before colon
- ((> j (setq i (|charPosition| (|char| '| |) line (1+ k)))) '|skip|)
- (t (return nil)))
- (setq acc (cons line acc)))
- (nreverse acc))))
-
-\end{chunk}
-
\defun{lisplibDoRename}{lisplibDoRename}
\calls{lisplibDoRename}{replaceFile}
\refsdollar{lisplibDoRename}{spadLibFT}
@@ -19342,80 +19295,94 @@ deleting entries from u assumes that the first element is useless
(|macroExpand| x env)))))
(hn (u)
; ((op,sig,doc), ...) --> ((op ((sig doc) ...)) ...)
- (let (opList)
- (setq opList (remdup (assocleft u)))
+ (let (opList op1 sig doc)
+ (setq oplist (remdup (assocleft u)))
(loop for op in opList
collect
(cons op
(loop for item in u
- when (equal op (first item))
- collect (cons (second item) (third item))))))))
- (let (unusedCommentLineNumbers docList u noHeading attributes signatures name
- bigcnt s litcnt a n)
- (declare (special |$e| |$lisplibForm| |$docList| |$op| $comblocklist))
- (setq unusedCommentLineNumbers
- (loop for x in $comblocklist
- do (cdr x)
- collect x))
- (setq docList (msubst '$ '% (|transDocList| |$op| |$docList|)))
- (cond
- ((setq u
- (loop for sig in docList
- when (null (cdr sig))
- collect sig))
- (loop for y in u
- do
- (cond
- ((eq y '|constructor|) (setq noHeading t))
- ((and (consp y) (consp (qcdr y)) (eq (qcddr y) nil) (consp (qcadr y))
- (eq (qcaadr y) '|attribute|))
- (setq attributes (cons (cons (qcar y) (qcdadr y)) attributes)))
- (t (setq signatures (cons y signatures)))))
- (setq name (car |$lisplibForm|))
- (when (or noHeading signatures attributes unusedCommentLineNumbers)
- (|sayKeyedMsg| 'S2CD0001 nil)
- (setq bigcnt 1)
- (when (or noHeading signatures attributes)
- (|sayKeyedMsg| 'S2CD0002
- (cons (strconc (stringimage bigcnt) ".") (list name)))
- (setq bigcnt (1+ bigcnt))
- (setq litcnt 1)
- (when noHeading
- (|sayKeyedMsg| 'S2CD0003
- (list (strconc "(" (stringimage litcnt) ")") name))
- (setq litcnt (1+ litcnt)))
- (when signatures
- (|sayKeyedMsg| 'S2CD0004
- (list (strconc "(" (stringimage litcnt) ")")))
- (setq litcnt (1+ litcnt))
- (loop for item in signatures
- do
- (setq s (|formatOpSignature| (first item) (second item)))
- (|sayMSG|
- (if (atom s)
- (list '|%x9| s)
- (cons '|%x9| s)))))
- (when attributes
- (|sayKeyedMsg| 'S2CD0005
- (list (strconc "(" (stringimage litcnt) ")")))
- (setq litcnt (1+ litcnt))
- (loop for x in attributes
- do
- (setq a (|form2String| x))
- (|sayMSG|
- (if (atom a)
- (list '|%x9| a)
- (cons '|%x9| a))))))
- (when unusedCommentLineNumbers
- (|sayKeyedMsg| 'S2CD0006
- (list (strconc (stringimage bigcnt) ".") name))
- (loop for item in unusedCommentLineNumbers
- do (|sayMSG|
- (cons " "
- (append (|bright| n) (list " " (second item))))))))))
- (hn
- (loop for item in docList
- collect (fn (car item) |$e|))))))
+ do (setq op1 (first item))
+ (setq sig (second item))
+ (setq doc (third item))
+ when (equal op op1)
+ collect
+ (list sig doc)))))))
+ (let (unusedCommentLineNumbers docList u noHeading attributes
+ signatures name bigcnt op s litcnt a n r sig)
+ (declare (special |$e| |$lisplibForm| |$docList| |$op| $comblocklist))
+ (setq unusedCommentLineNumbers
+ (loop for x in $comblocklist
+ when (cdr x)
+ collect x))
+ (setq docList (msubst '$ '% (|transDocList| |$op| |$docList|)))
+ (cond
+ ((setq u
+ (loop for item in docList
+ when (null (cdr item))
+ collect (car item)))
+ (loop for y in u
+ do
+ (cond
+ ((eq y '|constructor|) (setq noHeading t))
+ ((and (consp y) (consp (qcdr y)) (eq (qcddr y) nil)
+ (consp (qcadr y)) (eq (qcaadr y) '|attribute|))
+ (setq attributes (cons (cons (qcar y) (qcdadr y)) attributes)))
+ (t (setq signatures (cons y signatures)))))
+ (setq name (CAR |$lisplibForm|))
+ (when (or noHeading signatures attributes unusedCommentLineNumbers)
+ (|sayKeyedMsg| 'S2CD0001 nil)
+ (setq bigcnt 1)
+ (when (or noHeading signatures attributes)
+ (|sayKeyedMsg| 'S2CD0002 (list (strconc (stringimage bigcnt) ".") name))
+ (setq bigcnt (1+ bigcnt))
+ (setq litcnt 1)
+ (when noHeading
+ (|sayKeyedMsg| 'S2CD0003
+ (list (strconc "(" (stringimage litcnt) ")") name))
+ (setq litcnt (1+ litcnt)))
+ (when signatures
+ (|sayKeyedMsg| 'S2CD0004
+ (list (strconc "(" (stringimage litcnt) ")")))
+ (setq litcnt (1+ litcnt))
+ (loop for item in signatures
+ do
+ (setq op (first item))
+ (setq sig (second item))
+ (setq s (|formatOpSignature| op sig))
+ (|sayMSG|
+ (if (atom s)
+ (list '|%x9| s)
+ (cons '|%x9| s)))))
+ (when attributes
+ (|sayKeyedMsg| 'S2CD0005
+ (list (strconc "(" (stringimage litcnt) ")")))
+ (setq litcnt (1+ litcnt))
+ (DO ((G166491 attributes
+ (CDR G166491))
+ (x NIL))
+ ((OR (ATOM G166491)
+ (PROGN
+ (SETQ x (CAR G166491))
+ NIL))
+ NIL)
+ (SEQ (EXIT
+ (PROGN
+ (setq a (|form2String| x))
+ (|sayMSG|
+ (COND
+ ((ATOM a)
+ (CONS '|%x9| (CONS a NIL)))
+ ('T (CONS '|%x9| a))))))))))
+ (when unusedCommentLineNumbers
+ (|sayKeyedMsg| 'S2CD0006
+ (list (strconc (stringimage bigcnt) ".") name))
+ (loop for item in unusedCommentLineNumbers
+ do
+ (setq r (second item))
+ (|sayMSG| (cons " " (append (|bright| n) (list " " r)))))))))
+ (hn
+ (loop for item in docList
+ collect (append (fn (car item) |$e|) (cdr item)))))))
\end{chunk}
@@ -19781,7 +19748,6 @@ deleting entries from u assumes that the first element is useless
\end{chunk}
-
\defun{checkDecorateForHt}{checkDecorateForHt}
\calls{checkDecorateForHt}{checkDocError}
\calls{checkDecorateForHt}{member}
@@ -19890,26 +19856,28 @@ deleting entries from u assumes that the first element is useless
\end{chunk}
\defun{whoOwns}{whoOwns}
+This function always returns nil in the current system.
+Since it has no side effects we define it to return nil.
\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))))
+(defun |whoOwns| (con) nil)
+; (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}
@@ -20545,8 +20513,6 @@ This returns a line beginning with right brace
\end{chunk}
-
-
\chapter{Utility Functions}
\defun{translabel}{translabel}
@@ -24496,7 +24462,6 @@ The current input line.
\getchunk{defun checkDocError}
\getchunk{defun checkDocError1}
\getchunk{defun checkDocMessage}
-\getchunk{defun checkExtract}
\getchunk{defun checkGetMargin}
\getchunk{defun checkGetParse}
\getchunk{defun checkHTargs}
@@ -24504,6 +24469,7 @@ The current input line.
\getchunk{defun checkIeEgfun}
\getchunk{defun checkLookForLeftBrace}
\getchunk{defun checkLookForRightBrace}
+\getchunk{defun checkTexht}
\getchunk{defun checkRecordHash}
\getchunk{defun checkRewrite}
\getchunk{defun checkSayBracket}
@@ -24512,7 +24478,6 @@ The current input line.
\getchunk{defun checkSkipOpToken}
\getchunk{defun checkSkipToken}
\getchunk{defun checkSplit2Words}
-\getchunk{defun checkTexht}
\getchunk{defun checkTransformFirsts}
\getchunk{defun checkWarning}
\getchunk{defun coerce}
diff --git a/changelog b/changelog
index 5ff288d..38a9914 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,6 @@
+20111124 tpd src/axiom-website/patches.html 20111124.04.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.03.tpd.patch
20111124 tpd books/bookvolbib add additional references
20111124 tpd src/axiom-website/patches.html 20111124.02.tpd.patch
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index d095aa1..a3cc5ef 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3694,5 +3694,7 @@ src/axiom-website/litprog.html add quote
books/bookvol9 treeshake compiler
20111124.03.tpd.patch
books/bookvolbib add additional references
+20111124.04.tpd.patch
+books/bookvol9 treeshake compiler