diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 3600120..596a1d4 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -17867,7 +17867,7 @@ line, old, error, warn, bug, unimple, remark, stat, say, debug \end{chunk} \defmacro{getMsgTag?} -\calls{getMsgTag?}{IFCAR} +\calls{getMsgTag?}{ifcar} \calls{getMsgTag?}{getMsgTag} \begin{chunk}{defmacro getMsgTag? 0} (defmacro |getMsgTag?| (msg) @@ -18138,8 +18138,8 @@ Give message and throw to a recovery point. \end{chunk} \defun{remFile}{remFile} -\calls{remFile}{IFCDR} -\calls{remLine}{IFCAR} +\calls{remFile}{ifcdr} +\calls{remLine}{ifcar} \begin{chunk}{defun remFile} (defun |remFile| (positionList) (ifcdr (ifcdr positionList))) @@ -18419,7 +18419,7 @@ org prints out the word noposition or console (setq tmp (|getMsgInfoFromKey| msg)) (setq text (car tmp)) (setq attributes (cadr tmp)) - (when attributes (|setMsgUnforcedAttrList| msg al)) + (when attributes (|setMsgUnforcedAttrList| msg attributes)) (|setMsgText| msg text))) \end{chunk} @@ -18888,7 +18888,7 @@ makeLeaderMsg chPosList == \calls{posPointers}{poCharPosn} \calls{posPointers}{getMsgPos} -\calls{posPointers}{IFCAR} +\calls{posPointers}{ifcar} \calls{posPointers}{getMsgPos2} \calls{posPointers}{insertPos} \uses{posPointers}{getMsgFTTag} @@ -21993,10 +21993,11 @@ valid for this level. \calls{tersyscommand}{spadThrow} \begin{chunk}{defun tersyscommand} (defun tersyscommand () + (let (chr tok) (fresh-line) (setq chr 'endoflinechr) (setq tok 'end_unit) - (|spadThrow|)) + (|spadThrow|))) \end{chunk} @@ -26871,7 +26872,7 @@ environment to \verb|$HistList| and \verb|$HistRecord|. (setq mini (- |$IOindex| n)) (setq maxi (- |$IOindex| 1)) (cond - ((eq |showInputOrBoth| '|both|) + ((eq showInputOrBoth '|both|) (unwind-protect (|showInOut| mini maxi) (|setIOindex| (+ maxi 1)))) @@ -29381,7 +29382,7 @@ count marker. It is not required but is highly recommended. \begin{chunk}{defun lastcount 0} (defun lastcount (oneline) - (let ((n :done) (m :done) next somemore) + (let ((n :done) (m :done) next somemore isof) (when (and (>= (length oneline) 3) (string= (subseq oneline 0 3) "--S")) (setq somemore (string-trim " " (subseq oneline 3))) (when somemore @@ -38468,9 +38469,11 @@ This reports the traced functions \calls{getPreviousMapSubNames}{get} \calls{getPreviousMapSubNames}{exit} \calls{getPreviousMapSubNames}{seq} +\usesdollar{getPreviousMapSubNames}{InteractiveFrame} \begin{chunk}{defun getPreviousMapSubNames} (defun |getPreviousMapSubNames| (|traceNames|) (prog (lmm subs) + (declare (special |$InteractiveFrame|)) (return (seq (progn @@ -42179,7 +42182,7 @@ searchCurrentEnv(x,currentEnv) == \begin{chunk}{defun spad-syntax-error} (defun spad-syntax-error (&rest byebye) "Print syntax error indication, underline character, scrub line." - (declare (special debugmode)) + (declare (special debugmode byebye)) (bumperrorcount '|syntax|) (cond ((and (eq debugmode 'yes) (not(consoleinputp in-stream))) (spad-long-error)) @@ -43585,10 +43588,6 @@ Format of an entry in browse.daase: (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) (setq data (database-object struct)))) - (asharp? - (setq stream *interp-stream*) - (when (setq struct (get constructor 'database)) - (setq data (database-object struct)))) (niladic (setq stream *interp-stream*) (when (setq struct (get constructor 'database)) @@ -43677,10 +43676,6 @@ Format of an entry in browse.daase: (string= (pathname-type data) "spad")) (setq data (concatenate 'string $spadroot "/../../src/algebra/" data)))) - (asharp? ; is this asharp code? - (if (consp data) - (setq data (cdr data)) - (setq data nil))) (object ; fix up system object pathname (if (consp data) (setq data @@ -43715,12 +43710,7 @@ Format of an entry in browse.daase: \defun{localdatabase}{Read a local filename and update the hash tables} The localdatabase function tries to find files in the order of: -\begin{itemize} -\item nrlib/index.kaf -\item .asy -\item .ao, -\item asharp to .asy -\end{itemize} +nrlib/index.kaf \calls{localdatabase}{sayKeyedMsg} \calls{localdatabase}{localnrlib} \usesdollar{localdatabase}{forceDatabaseUpdate} @@ -44254,13 +44244,9 @@ Here I'll try to outline the interp database write procedure ; 8. We remember source file pathnames in the obj variable - (if (consp (database-object struct)) ; if asharp code ... - (setq obj - (cons (pathname-name (car (database-object struct))) - (cdr (database-object struct)))) - (setq obj - (pathname-name - (first (last (pathname-directory (database-object struct))))))) + (setq obj + (pathname-name + (first (last (pathname-directory (database-object struct)))))) ; 9. We write the "constructorcategory", if it is a category, else nil ; 9a. Get the constructorcategory @@ -44392,13 +44378,9 @@ Here I'll try to outline the interp database write procedure (setq modemapspos (file-position out)) (print (database-modemaps struct) out) (finish-output out) - (if (consp (database-object struct)) ; if asharp code ... - (setq obj - (cons (pathname-name (car (database-object struct))) - (cdr (database-object struct)))) - (setq obj - (pathname-name - (first (last (pathname-directory (database-object struct))))))) + (setq obj + (pathname-name + (first (last (pathname-directory (database-object struct)))))) (setq concategory (database-constructorcategory struct)) (if concategory ; if category then write data else write nil (progn @@ -50027,7 +50009,7 @@ Hash primitive hyperdoc macros into {\bf htMacroTable}. \usesdollar{buildHtMacroTable}{primitiveHtCommands} \begin{chunk}{defun buildHtMacroTable} (defun |buildHtMacroTable| () - (let (fn instream) + (let (fn) (declare (special |$htMacroTable| |$primitiveHtCommands|)) (setq fn (concat (getenviron "AXIOM") "/doc/util.ht")) (cond @@ -52546,6 +52528,7 @@ Convert verb|(bcMkFunction "test" "arg1" '("arg2" "arg3"))| to \verb|"test(arg1,arg2,arg3)"| \begin{chunk}{defun bcMkFunction} (defun |bcMkFunction| (name arg args) + (let (str) (setq str (let ((result "")) (concatenate 'string arg @@ -52553,7 +52536,7 @@ to \verb|"test(arg1,arg2,arg3)"| (when i (setq result (concatenate 'string result (concatenate 'string "," i)))))))) - (concatenate 'string name "(" str ")")) + (concatenate 'string name "(" str ")"))) \end{chunk} @@ -52991,12 +52974,9 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htpSetLabelSpadValue}{htpSetLabelSpadValue} \begin{chunk}{defun htpSetLabelSpadValue} (defun |htpSetLabelSpadValue| (htPage label val) - (prog (props) - (return - (progn - (setq props - (LASSOC label (|htpInputAreaAlist| htPage))) - (cond (props (setelt props 1 |val|)) (t nil)))))) + (let (props) + (setq props (lassoc label (|htpInputAreaAlist| htPage))) + (when props (setelt props 1 val)))) \end{chunk} @@ -53517,34 +53497,29 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htBcLinks}{htBcLinks} \begin{chunk}{defun htBcLinks} -(defun |htBcLinks| (&REST G166465 &AUX options links) - (setq links (car G166465)) - (setq options (cdr G166465)) - (prog (skipStateInfo? t1 message info func value) - (return - (SEQ (progn - (setq |skipStateInfo?| (IFCAR options)) - (setq t1 (|beforeAfter| '|options| links)) - (setq links (car t1)) - (setq options (cadr t1)) - (DO ((G166447 links (CDR G166447)) (G166434 nil)) - ((or (atom G166447) - (progn (setq G166434 (car G166447)) nil) - (progn - (progn - (setq message (car G166434)) - (setq info (cadr G166434)) - (setq func (caddr G166434)) - (setq value (cdddr G166434)) - G166434) - nil)) - nil) - (SEQ (EXIT (progn - (|htMakeButton| - "\\lispdownlink" message - (|mkCurryFun| func value) - skipStateInfo?) - (|bcIssueHt| info)))))))))) +(defun |htBcLinks| (&rest a1) + (let (skipStateInfo? t1 message info func value options links) + (setq links (car a1)) + (setq options (cdr a1)) + (setq skipStateInfo? (ifcar options)) + (setq t1 (|beforeAfter| '|options| links)) + (setq links (car t1)) + (setq options (cadr t1)) + (do ((g1 links (CDR g1)) (g2 nil)) + ((or (atom g1) + (progn (setq g2 (car g1)) nil) + (progn + (progn + (setq message (car g2)) + (setq info (cadr g2)) + (setq func (caddr g2)) + (setq value (cdddr g2)) + g2) + nil)) + nil) + (|htMakeButton| "\\lispdownlink" message + (|mkCurryFun| func value) skipStateInfo?) + (|bcIssueHt| info)))) \end{chunk} @@ -54161,7 +54136,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (declare (special |$curPage|)) (return (SEQ (progn - (setq skipStateInfo? (IFCAR options)) + (setq skipStateInfo? (ifcar options)) (|iht| (cons htCommand (cons "{" nil))) (|bcIssueHt| message) (cond @@ -54447,7 +54422,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (cond ((and (consp condList) (eq (QCDR condList) nil) (progn - (setq t2 (QCAR |condList|)) + (setq t2 (qcar condList)) (and (consp t2) (eq (QCAR t2) '|Satisfies|) (progn @@ -54465,11 +54440,11 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (cond ((stringp val) val) (t (cons '(|String|) (|wrap| s1))))) - ((null (and (consp condList) (eq (QCDR condList) nil) + ((null (and (consp condList) (eq (qcdr condList) nil) (progn - (setq t2 (QCAR condList)) + (setq t2 (qcar condList)) (and (consp t2) - (eq (QCAR t2) '|isDomain|) + (eq (qcar t2) '|isDomain|) (progn (setq t3 (QCDR t2)) (and (consp t3) @@ -54485,7 +54460,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| t))))))))) (|systemError| "currently invalid domain condition")) - ((equal |pattern| '(|String|)) + ((equal pattern '(|String|)) (cons '(|String|) (|wrap| s1))) (t (setq val (|parseAndEval| string)) (cond @@ -54581,27 +54556,21 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{makeSpadCommand}{makeSpadCommand} \begin{chunk}{defun makeSpadCommand} -(defun |makeSpadCommand| (&REST G167322 &AUX z) - (setq z G167322) - (prog (opForm lastArg argList) - (return - (SEQ (progn - (setq opForm (CONCAT (car z) "(")) - (setq lastArg (|last| z)) - (setq z (cdr z)) - (setq argList nil) - (DO ((G167306 l (cdr G167306)) (arg nil)) - ((or (atom G167306) - (progn (setq arg (car G167306)) nil) - (null (NEQUAL arg lastArg))) - nil) - (SEQ (EXIT (setq argList - (cons - (CONCAT arg ", ") - argList))))) - (setq argList (NREVERSE (cons lastArg argList))) - (CONCAT opForm (apply #'CONCAT argList) - ")")))))) +(defun |makeSpadCommand| (&rest a1) + (let (opForm lastArg argList z) + (setq z a1) + (setq opForm (concat (car z) "(")) + (setq lastArg (|last| z)) + (setq z (cdr z)) + (setq argList nil) + (do ((g1 z (cdr g1)) (arg nil)) + ((or (atom g1) + (progn (setq arg (car g1)) nil) + (null (nequal arg lastArg))) + nil) + (setq argList (cons (concat arg ", ") argList))) + (setq argList (nreverse (cons lastArg argList))) + (concat opForm (apply #'concat argList) ")"))) \end{chunk} @@ -54722,7 +54691,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (|htShowCount| (STRINGIMAGE (elt setData 1))) - |maxWidth2|))))))))) + maxWidth2))))))))) (setq maxWidth1 (max 9 maxWidth1)) (setq maxWidth2 (max 41 maxWidth2)) (setq tabset1 (STRINGIMAGE maxWidth1)) @@ -55169,7 +55138,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (|eval| predicate)) (t t))) (cond - (|continue| (|htpSetProperty| htPage '|parts| restParts) + (continue (|htpSetProperty| htPage '|parts| restParts) (|htShowFunctionPageContinued| htPage)) (t (|htKill| htPage value))))))) @@ -55206,26 +55175,19 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \defun{htSetNotAvailable}{htSetNotAvailable} \begin{chunk}{defun htSetNotAvailable} (defun |htSetNotAvailable| (htPage whatToType) - (prog (page string) - (return - (progn - (setq page - (|htInitPage| "Unavailable Set Command" - (|htpPropertyList| htPage))) - (|htInitPage| "Unavailable System Command" nil) - (setq |string| - (STRCONC "{\\em " whatToType - "}")) - (|htMakePage| + (let (page string) + (setq page + (|htInitPage| "Unavailable Set Command" (|htpPropertyList| htPage))) + (|htInitPage| "Unavailable System Command" nil) + (setq string (strconc "{\\em " whatToType "}")) + (|htMakePage| (cons '(|text| "\\vspace{1}\\newline" "{Sorry, but this system command is not available through HyperDoc. Please directly issue this command in an AXIOM window for more information:}" "\\vspace{2}\\newline\\centerline{\\tt") (cons (cons '|text| string) nil))) - (|htMakePage| '((|text| . "}\\vspace{1}\\newline"))) - (|htProcessDoitButton| - (cons "Press to Remove Page" - (cons "" (cons '|htDoNothing| nil)))) - (|htShowPage|))))) + (|htMakePage| '((|text| . "}\\vspace{1}\\newline"))) + (|htProcessDoitButton| (list "Press to Remove Page" "" '|htDoNothing| )) + (|htShowPage|))) \end{chunk} @@ -56299,15 +56261,15 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| ((or (atom G168149) (progn (setq x (car G168149)) nil)) nil) - (SEQ (EXIT (cond + (cond ((|superMatch?| filter (PNAME x)) (setq matches (cons x matches))) (t (setq nonmatches - (cons x nonmatches))))))) - (setq matches (NREVERSE matches)) - (setq nonmatches (NREVERSE nonmatches)) + (cons x nonmatches))))) + (setq matches (nreverse matches)) + (setq nonmatches (nreverse nonmatches)) (|htInitPage| "Greek Names" nil) (cond ((null matches) @@ -56325,7 +56287,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| (cons ss (cons "}" nil))) nil) (cond - (|nonmatches| + (nonmatches (|htSay| "The greek letters that {\\em match} your search string {\\em " ss "}:")) @@ -56343,7 +56305,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| "}")))) (|htSay| "}}\\vspace{1}") (cond - (|nonmatches| + (nonmatches (|htSay| "The greek letters that {\\em do not match} your search string:{\\em \\table{") (DO ((G168167 nonmatches (CDR G168167)) @@ -56547,6 +56509,412 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \chapter{Browser Support Code} \section{Pages Initiated from HyperDoc Pages} + +\subsection{Search routines} + +\defun{dKind}{dKind} +\begin{chunk}{defun dbKind 0} +(defun |dbKind| (line) + (elt line 0)) + +\end{chunk} + +\defun{checkFilter}{checkFilter} +\calls{checkFilter}{stringimage} +\calls{checkFilter}{trimString} +\begin{chunk}{defun checkFilter} +(defun |checkFilter| (filter) + (setq filter (stringimage filter)) + (if (string= filter "") + "*" + (|trimString| filter))) + +\end{chunk} + +;concatWithBlanks r == +; r is [head,:tail] => +; tail => STRCONC(head,'" ",concatWithBlanks tail) +; head +; '"" + +\defun{concatWithBlanks}{Concatenate words with blanks} +\begin{chunk}{defun concatWithBlanks 0} +(defun |concatWithBlanks| (r) + (if (consp r) + (format nil "~{~a~^ ~}" r) + "")) + +\end{chunk} + +\defun{conLowerCaseConTran}{Make constructor names lowercase} +\calls{conLowerCaseConTran}{hget} +\calls{conLowerCaseConTran}{ifcar} +\calls{conLowerCaseConTran}{conLowerCaseConTran} +\usesdollar{conLowerCaseConTran}{lowerCaseConTb} +\begin{chunk}{defun conLowerCaseConTran} +(defun |conLowerCaseConTran| (x) + (declare (special |$lowerCaseConTb|)) + (cond + ((identp x) (or (ifcar (hget |$lowerCaseConTb| x)) x)) + ((atom x) x) + (t (loop for y in x collect (|conLowerCaseConTran| y))))) + +\end{chunk} + +\defun{string2Constructor}{string2Constructor} +\calls{string2Constructor}{downcase} +\calls{string2Constructor}{hget} +\calls{string2Constructor}{ifcar} +\usesdollar{string2Constructor}{lowerCaseConTb} +\begin{chunk}{defun string2Constructor} +(defun |string2Constructor| (x) + (declare (special |$lowerCaseConTb|)) + (cond + ((null (stringp x)) x) + (t (or (ifcar (hget |$lowerCaseConTb| (intern (downcase x)))) x)))) + +\end{chunk} + +\defvar{dbDelimiters} +\begin{chunk}{initvars} +(defvar |$dbDelimiters| (list #\space #\( #\) )) + +\end{chunk} + +\defun{dbString2Words}{String to words respecting delimiters} +This breaks a string into words respecting delimiters, so if +\begin{verbatim} + $dbDelimiters = ( #\space #\( #\) ) +\end{verbatim} +then +\begin{verbatim} + (|dbString2Words| "now is (the) time") + Value = ("now" "is" #\( "the" #\) "time") +\end{verbatim} +\calls{dbString2Words}{dbWordFrom} +\begin{chunk}{defun dbString2Words} +(defun |dbString2Words| (z) + (loop + with i = 0 + with pair = nil + do (setq pair (|dbWordFrom| z i)) + while (and (consp pair) (= (length pair) 2)) ; dbWordFrom(l,i) is [w,i]] + do (setq i (second pair)) + collect (first pair))) + +\end{chunk} + +\defun{dbWordFrom}{Next word respecting delimiters} +This returns the next word or the next delimiter. So given +\begin{verbatim} + $dbDelimiters = ( #\space #\( #\) ) + (|dbWordFrom| "now is (the) time") + + (|dbWordFrom| b 0) Value = ("now" 3) + (|dbWordFrom| b 3) Value = ("is" 6) + (|dbWordFrom| b 6) Value = (#\( 8) + (|dbWordFrom| b 8) Value = ("the" 11) + (|dbWordFrom| b 11) Value = (#\) 12) + (|dbWordFrom| b 12) Value = ("time" 17) + (|dbWordFrom| b 17) Value = NIL +\end{verbatim} +\calls{dbWordFrom}{maxindex} +\calls{dbWordFrom}{member} +\calls{dbWordFrom}{strconc} +\usesdollar{dbWordFrom}{dbDelimiters} +\begin{chunk}{defun dbWordFrom} +(defun |dbWordFrom| (z i) + (let (maxIndex c ch buf k g1) + (declare (special |$dbDelimiters|)) + (setq maxIndex (maxindex z)) + (loop while (and (>= maxIndex i) (char= (elt z i) #\space)) do (incf i)) + (if (and (>= maxIndex i) (|member| (elt z i) |$dbDelimiters|)) + (list (elt z i) (+ i 1)) + (progn + (setq k + (do ((g2 nil g1) (j i (+ j 1))) + ((or g2 (> j maxIndex)) g1) + (unless (|member| (elt z j) |$dbDelimiters|) (setq g1 (or g1 j))))) + (when k + (setq buf "") + (do () + ((null (and (<= k maxIndex) + (null (|member| (setq c (elt z k)) |$dbDelimiters|)))) + nil) + (setq ch (if (char= c #\_) (elt z (setq k (+ 1 k))) c)) + (setq buf (strconc buf ch)) + (setq k (+ k 1))) + (list buf k)))))) + +\end{chunk} + +This creates a page for any cat, dom, package, default package +\begin{verbatim} +constructors Cname\#\E\sig \args \abb \comments (C is C, D, P, X) +\end{verbatim} +There are 8 parts of an htPage: +\begin{enumerate} +\item kind +\item name +\item nargs +\item xflag +\item sig +\item args +\item abbrev +\item comments +\end{enumerate} + +\calls{kPage}{dbXParts} +\calls{kPage}{mkConform} +\calls{kPage}{opOf} +\calls{kPage}{capitalize} +\calls{kPage}{ncParseFromString} +\calls{kPage}{dbSourceFile} +\calls{kPage}{kdr} +\calls{kPage}{dbConformGenUnder} +\calls{kPage}{strconc} +\calls{kPage}{isExposedConstructor} +\calls{kPage}{htInitPageNoScroll} +\calls{kPage}{htAddHeading} +\calls{kPage}{htSayStandard} +\calls{kPage}{mkConArgSublis} +\calls{kPage}{htpSetProperty} +\calls{kPage}{dbShowConsDoc1} +\calls{kPage}{addParameterTemplates} +\calls{kPage}{htSay} +\calls{kPage}{htSayStandard} +\calls{kPage}{kPageContextMenu} +\calls{kPage}{htShowPageNoScroll} +\usesdollar{kPage}{atLeastOneUnexposed} +\usesdollar{kPage}{conformsAreDomains} +\usesdollar{kPage}{kPageSaturnArguments} +\begin{chunk}{defun kPage} +(defun |kPage| (&rest a1) + (let (|$kPageSaturnArguments| parts name nargs sig args form isFile kind + conform conname capitalKind signature sourceFileName constrings + emString heading page options line) + (declare (special |$kPageSaturnArguments| |$conformsAreDomains| + |$atLeastOneUnexposed|)) + (setq line (car a1)) + (setq options (cdr a1)) + ; constructors Cname\#\E\sig \args \abb \comments (C is C, D, P, X) + (setq parts (|dbXParts| line 7 1)) + (setq kind (first parts)) + (setq name (second parts)) + (setq nargs (third parts)) + (setq sig (fifth parts)) + (setq args (sixth parts)) + (setq form (ifcar options)) + (setq isFile (null kind)) + (setq kind (or kind "package")) + (rplaca parts kind) + (setq conform (|mkConform| kind name args)) + (setq |$kPageSaturnArguments| (cdr conform)) + (setq conname (|opOf| conform)) + (setq capitalKind (|capitalize| kind)) + (setq signature (|ncParseFromString| sig)) + (setq sourceFileName (|dbSourceFile| (intern name))) + (setq constrings + (if (kdr form) + (|dbConformGenUnder| form) + (list (strconc name args)))) + (setq emString (cons "{\\sf " (append constrings (list "}")))) + (setq heading (cons capitalKind (cons " " emString))) + (unless (|isExposedConstructor| conname) + (setq heading (cons "Unexposed " heading))) + (setq page (|htInitPageNoScroll| NIL)) + (|htAddHeading| heading) + (|htSayStandard| '|\\beginscroll |) + (|htpSetProperty| page '|argSublis| (|mkConArgSublis| (cdr conform))) + (|htpSetProperty| page '|isFile| t) + (|htpSetProperty| page '|parts| parts) + (|htpSetProperty| page '|heading| heading) + (|htpSetProperty| page '|kind| kind) + (|htpSetProperty| page '|conform| conform) + (|htpSetProperty| page '|signature| signature) + ; what follows is stuff from kiPage with domain = nil + (setq |$conformsAreDomains| nil) + (|dbShowConsDoc1| page conform nil) + (when (and (nequal kind '|category|) (> nargs 0)) + (|addParameterTemplates| page conform)) + (when |$atLeastOneUnexposed| + (|htSay| "\\newline{}{\\em *} = unexposed")) + (|htSayStandard| '|\\endscroll |) + (|kPageContextMenu| page) + (|htShowPageNoScroll|))) + +\end{chunk} + +\defun{cSearch}{Hyperdoc category search} +\calls{cSearch}{constructorSearch} +\begin{chunk}{defun cSearch} +(defun |cSearch| (filter) + (|constructorSearch| (|checkFilter| filter) '|c| "category")) + +\end{chunk} + +\defun{pSearch}{Hyperdoc default domain search} +\calls{pSearch}{constructorSearch} +\begin{chunk}{defun xSearch} +(defun |xSearch| (filter) + (|constructorSearch| (|checkFilter| filter) '|x| "default package")) + +\end{chunk} + +\defun{dSearch}{Hyperdoc domain search} +\calls{dSearch}{constructorSearch} +\begin{chunk}{defun dSearch} +(defun |dSearch| (filter) + (|constructorSearch| (|checkFilter| filter) '|d| "domain")) + +\end{chunk} + +\defun{pSearch}{Hyperdoc package search} +\calls{pSearch}{constructorSearch} +\begin{chunk}{defun pSearch} +(defun |pSearch| (filter) + (|constructorSearch| (|checkFilter| filter) '|p| "package")) + +\end{chunk} + +\defun{kSearch}{Hyperdoc constructor search} +\calls{kSearch}{constructorSearch} +\begin{chunk}{defun kSearch} +(defun |kSearch| (filter) + (|constructorSearch| (|checkFilter| filter) '|k| "constructor")) + +\end{chunk} + +\defun{ySearch}{Hyperdoc default constructor search} +\calls{ySearch}{constructorSearch} +\begin{chunk}{defun ySearch} +(defun |ySearch| (filter) + (|constructorSearch| (|checkFilter| filter) '|y| "constructor")) + +\end{chunk} + +\defun{dbRead}{Read libdb.text at file-position n} +\begin{chunk}{defun dbRead 0} +(defun |dbRead| (n) + (with-open-file + (instream (strconc (getenviron "AXIOM") "/algebra/libdb.text")) + (file-position instream n) + (read-line instream))) + +\end{chunk} + +\defun{libdbTrim}{String trim with newlines removed} +\begin{chunk}{defun libdbTrim 0} +(defun |libdbTrim| (s) + (string-trim '(#\space #\tab #\newline) (substitute #\space #\newline s))) + +\end{chunk} + +\defun{constructorSearch}{Hyperdoc common constructor search} +\calls{constructorSearch}{dbKind} +\calls{constructorSearch}{conSpecialString?} +\calls{constructorSearch}{conPage} +\calls{constructorSearch}{lassoc} +\calls{constructorSearch}{downcase} +\calls{constructorSearch}{downlink} +\calls{constructorSearch}{kPage} +\calls{constructorSearch}{htInitPage} +\calls{constructorSearch}{htpSetProperty} +\calls{constructorSearch}{dbName} +\calls{constructorSearch}{htQuery} +\calls{constructorSearch}{htShowPage} +\calls{constructorSearch}{grepSearchQuery} +\calls{constructorSearch}{constructorSearchGrep} +\usesdollar{constructorSearch}{lowerCaseConTb} +\begin{chunk}{defun constructorSearch} +(defun |constructorSearch| (filter key kind) + (let (parse pageName name u line newkind page message) + (declare (special |$lowerCaseConTb|)) + (cond + ((null filter) nil) + ((setq parse (|conSpecialString?| filter)) (|conPage| parse)) + ((setq pageName + (lassoc (downcase filter) + '(("union" . |DomainUnion|) + ("record" . |DomainRecord|) + ("mapping" . |DomainMapping|) + ("enumeration" . |DomainEnumeration|)))) + (|downlink| pageName)) + (t + (setq name (if (stringp filter) (intern filter) filter)) + (when (setq u (hget |$lowerCaseConTb| name)) + (setq filter (stringimage (car u)))) + (cond + ((setq line (|conPageFastPath| (downcase filter))) + (setq newkind + (case (|dbKind| line) + (#\p "package") + (#\d "domain") + (#\c "category"))) + (cond + ((or (equal kind "constructor") (equal kind newkind)) + (|kPage| line)) + (t + (setq page (|htInitPage| "Query Page" nil)) + (|htpSetProperty| page '|line| line) + (setq message + (list "{\\em " (|dbName| line) "} is not a {\\em " kind + "} but a {\\em " newkind + "}. Would you like to view it?\\vspace{1}" )) + (|htQuery| message '|grepConstructorSearch| 't) + (|htShowPage|)))) + ((equal filter "*") + (|grepSearchQuery| kind + (list filter key kind '|constructorSearchGrep| ))) + (t (|constructorSearchGrep| filter key kind))))))) + +\end{chunk} + +\defun{conSpecialString?}{conSpecialString?} +\calls{conSpecialString?}{ifcar} +\calls{conSpecialString?}{string2Words} +\calls{conSpecialString?}{ncParseFromString} +\calls{conSpecialString?}{member} +\calls{conSpecialString?}{conLowerCaseConTran} +\calls{conSpecialString?}{kar} +\calls{conSpecialString?}{contained} +\calls{conSpecialString?}{kisValidType} +\calls{conSpecialString?}{strconc} +\calls{conSpecialString?}{dbString2Words} +\calls{conSpecialString?}{string2Constructor} +\calls{conSpecialString?}{conSpecialString?} +\begin{chunk}{defun conSpecialString?} +(defun |conSpecialString?| (&REST a1 &AUX options filter) + (let (secondTime t1 words parse form u) + (setq filter (car a1)) + (setq options (cdr a1)) + (setq secondtime (ifcar options)) + (setq t1 (|string2Words| filter)) + (setq parse + (cond + ((and (consp t1) (not (qcdr t1))) ; t1 is [s] + (setq words (|ncParseFromString| (qcar t1)))) + ((every #'(lambda (x) (null (|member| x '("and" "or" "not")))) words) + (|ncParseFromString| filter)))) + (cond + ((null parse) nil) + (t + (setq form (|conLowerCaseConTran| parse)) + (cond + ((or (member (kar form) '(|and| |or| |not|)) (contained '* form)) nil) + ((equal filter "Mapping") nil) + ((setq u (|kisValidType| form)) u) + (secondTime nil) + (t + (setq u + (reduce #'strconc + (loop for x in (|dbString2Words| filter) + collect (|string2Constructor| x)))) + (|conSpecialString?| u t))))))) + +\end{chunk} + +\subsection{Page construction} \defun{conPage}{conPage} \calls{conPage}{form2HtString} \calls{conPage}{downcase} @@ -56607,7 +56975,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \end{chunk} \defun{conPageConEntry}{conPageConEntry} -\calls{conPageConEntry}{buildLIbdbConEntry} +\seebook{conPageConEntry}{buildLIbdbConEntry}{9} \usesdollar{conPageConEntry}{conname} \usesdollar{conPageConEntry}{conform} \usesdollar{conPageConEntry}{exposed?} @@ -56782,18 +57150,6 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| \end{chunk} -There are 8 parts of an htPage: -\begin{enumerate} -\item kind -\item name -\item nargs -\item xflag -\item sig -\item args -\item abbrev -\item comments -\end{enumerate} - \section{Branches of Constructor Page} \defun{kiPage}{kiPage} @@ -57117,7 +57473,6 @@ There are 8 parts of an htPage: \calls{kcPage}{htBeginMenu} \calls{kcPage}{htMakePage} \calls{kcPage}{satBreak} -\calls{kcPage}{asharpConstructorName?} \calls{kcPage}{nequal} \calls{kcPage}{hget} \calls{kcPage}{hasNewInfoAlist} @@ -57194,16 +57549,14 @@ There are 8 parts of an htPage: (list "\\menuitemstyle{Descendants}" (list (list '|text| "\\tab{12}" "All categories which extend this category"))))))) - (unless (|asharpConstructorName?| conname) - (|satBreak|) - (setq message "Constructors mentioning this as an argument type") - (|htMakePage| + (|satBreak|) + (setq message "Constructors mentioning this as an argument type") + (|htMakePage| (list (list '|bcLinks| (list "\\menuitemstyle{Dependents}" - (list (list '|text| "\\tab{12}" message)) '|kcdePage| nil))))) - (when (and (null (|asharpConstructorName?| conname)) - (nequal kind "category")) + (list (list '|text| "\\tab{12}" message)) '|kcdePage| nil)))) + (when (nequal kind "category") (|satBreak|) (|htMakePage| (list @@ -57211,7 +57564,6 @@ There are 8 parts of an htPage: (list "\\menuitemstyle{Lineage}" "\\tab{12}Constructor hierarchy used for operation lookup" '|ksPage| nil))))) - (unless (|asharpConstructorName?| conname) (when (string= kind "category") (|satBreak|) (|htMakePage| @@ -57230,7 +57582,7 @@ There are 8 parts of an htPage: '|kcuPage| nil)))) (if (hget |$defaultPackageNamesHT| conname) (|htSay| " which {\\em may use} this default package") - (|htSay| " which {\\em use} this " kind)))) + (|htSay| " which {\\em use} this " kind))) (when (or (nequal kind "category") (|dbpHasDefaultCategory?| xpart)) (|satBreak|) (setq message @@ -57242,8 +57594,7 @@ There are 8 parts of an htPage: (list '|bcLinks| (list "\\menuitemstyle{Benefactors}" (list (list '|text| "\\tab{12}" message) '|kcnPage| nil)))))) - (when (and (null (|asharpConstructorName?| conname)) - (|hasNewInfoAlist| conname)) + (when (|hasNewInfoAlist| conname) (|satBreak|) (setq message (list "Cross reference for capsule implementation")) (|htMakePage| @@ -57535,7 +57886,8 @@ There are 8 parts of an htPage: \begin{chunk}{defun kcuPage} (defun |kcuPage| (htPage junk) (declare (ignore junk)) - (let (lt1 kind name args conname constring conform pakname domlist cAlist) + (let (lt1 kind name args conname constring conform pakname domlist cAlist + conname) (setq lt1 (|htpProperty| htPage '|parts|)) (setq kind (first lt1)) (setq name (second lt1)) @@ -57866,13 +58218,13 @@ There are 8 parts of an htPage: \calls{conOpPage1}{koPage} \usesdollar{conOpPage1}{Primitives} \begin{chunk}{defun conOpPage1} -(defun |conOpPage1| (&rest args) +(defun |conOpPage1| (&rest arg) (let (bindingsAlist conname domname line parts name sig args isFile kind constring capitalKind signature sourceFileName emString heading page - selectedOperation a b options conform) + selectedOperation options conform) (declare (special |$Primitives|)) - (setq conform (car args)) - (setq options (cdr args)) + (setq conform (car arg)) + (setq options (cdr arg)) (setq bindingsAlist (ifcar options)) (setq conname (|opOf| conform)) (cond @@ -58086,7 +58438,7 @@ There are 8 parts of an htPage: \usesdollar{dbConstructorDoc,gn}{op} \begin{chunk}{defun dbConstructorDoc,gn} (defun |dbConstructorDoc,gn| (arg) - (let (op alist sig doc) + (let (op alist) (declare (special |$op|)) (setq op (car arg)) (setq alist (cdr arg)) @@ -58198,7 +58550,7 @@ There are 8 parts of an htPage: \usesdollar{dbGetDocTable,hn}{FormalMapVariableList} \begin{chunk}{defun dbGetDocTable,hn} (defun |dbGetDocTable,hn| (arg) - (let (sig doc alteredSig pred r) + (let (sig doc alteredSig pred) (declare (special |$which| |$conform| |$sig| |$FormalMapVariableList|)) (setq sig (car arg)) (setq doc (cdr arg)) @@ -58252,7 +58604,7 @@ There are 8 parts of an htPage: \begin{chunk}{defun dbGetDocTable} (defun |dbGetDocTable| (op |$sig| docTable |$which| aux) (declare (special |$sig| |$which|)) - (let (doc origin) + (let (doc origin s) (declare (special |$conform| |$op|)) (when (and (null (integerp op)) (digitp (elt (setq s (stringimage op)) 0))) (setq op (|string2Integer| s))) @@ -58357,8 +58709,8 @@ There are 8 parts of an htPage: \calls{dbShowCons}{dbShowCons1} \usesdollar{dbShowCons}{exposedOnlyIfTrue} \begin{chunk}{defun dbShowCons} -(defun |dbShowCons| (&rest args &AUX options key htPage) - (let (cAlist filter abbrev? conname subject u htPage key options) +(defun |dbShowCons| (&rest args) + (let (cAlist filter abbrev? conname subject u options key htPage) (declare (special |$exposedOnlyIfTrue|)) (setq htPage (first args)) (setq key (second args)) @@ -58440,8 +58792,7 @@ There are 8 parts of an htPage: \usesdollar{dbShowCons1}{exposedOnlyIfTrue} \begin{chunk}{defun dbShowCons1} (defun |dbShowCons1| (htPage cAlist key) - (let (|$conformsAreDomains| item conlist kinds a kind - proplist page u fn y flist result) + (let (|$conformsAreDomains| conlist kinds kind proplist page u flist result) (declare (special |$conformsAreDomains| |$exposedOnlyIfTrue|)) (setq conlist (remdup @@ -58482,7 +58833,7 @@ There are 8 parts of an htPage: (loop for con in conlist collect (|getCDTEntry| con t)))) ((eq key '|files|) (setq flist - (for con in conlist collect (getdatabase con 'sourcefile))) + (loop for con in conlist collect (getdatabase con 'sourcefile))) (|bcUnixTable| (|listSort| #'glesseqp (remdup flist)))) ((eq key '|documentation|) (|dbShowConsDoc| page conlist)) @@ -58543,7 +58894,7 @@ There are 8 parts of an htPage: (setq cAlist (cdr cAlist)) (unless cAlist (|systemError|))) index))) - (let (index cAlist) + (let (cAlist) (cond ((null (cdr conlist)) (|dbShowConsDoc1| htPage @@ -58838,7 +59189,7 @@ There are 8 parts of an htPage: (let (conform page opAlist) (setq conform (|getConstructorForm| conname)) (setq page - (|htInitPage| (list "Exports of {\\sf " (|form2HtString| conform) "}"))) + (|htInitPage| (list "Exports of {\\sf " (|form2HtString| conform) "}") nil)) (setq opAlist (|dbSpecialExpandIfNecessary| conform (cdr (getl conname '|documentation|)))) @@ -59100,7 +59451,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. (defun |digits2Names| (s) (let (str c n segment) (setq str "") - (for i from 0 to (maxindex s) do + (loop for i from 0 to (maxindex s) do (setq c (elt s i)) (setq segment (cond @@ -59380,6 +59731,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun bvec-or 0} \getchunk{defun bvec-xor 0} +\getchunk{defun concatWithBlanks 0} \getchunk{defun cleanupLine 0} \getchunk{defun clearMacroTable 0} \getchunk{defun concat 0} @@ -59390,6 +59742,8 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun csc 0} \getchunk{defun csch 0} +\getchunk{defun dbKind 0} +\getchunk{defun dbRead 0} \getchunk{defun Delay 0} \getchunk{defun desiredMsg 0} \getchunk{defun DirToString 0} @@ -59456,6 +59810,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun lfrinteger 0} \getchunk{defun lfspaces 0} \getchunk{defun lfstring 0} +\getchunk{defun libdbTrim 0} \getchunk{defun lnCreate 0} \getchunk{defun lnExtraBlanks 0} \getchunk{defun lnFileName? 0} @@ -59771,6 +60126,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun changeToNamedInterpreterFrame} \getchunk{defun charDigitVal} \getchunk{defun checkCondition} +\getchunk{defun checkFilter} \getchunk{defun chkAllNonNegativeInteger} \getchunk{defun chkDirectory} \getchunk{defun chkNameList} @@ -59807,18 +60163,22 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun compiledLookupCheck} \getchunk{defun computeDomainVariableAlist} \getchunk{defun condErrorMsg} +\getchunk{defun conLowerCaseConTran} \getchunk{defun conOpPage} \getchunk{defun conOpPage1} \getchunk{defun conPage} \getchunk{defun conPageChoose} \getchunk{defun conPageConEntry} \getchunk{defun conPageFastPath} +\getchunk{defun conSpecialString?} \getchunk{defun constoken} +\getchunk{defun constructorSearch} \getchunk{defun constructSubst} \getchunk{defun containsVars} \getchunk{defun containsVars1} \getchunk{defun copyright} \getchunk{defun countCache} +\getchunk{defun cSearch} \getchunk{defun DaaseName} \getchunk{defun dbAddChain} @@ -59850,7 +60210,9 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun dbSpecialExpandIfNecessary} \getchunk{defun dbSpecialExports} \getchunk{defun dbSpecialOperations} +\getchunk{defun dbString2Words} \getchunk{defun dbSubConform} +\getchunk{defun dbWordFrom} \getchunk{defun decideHowMuch} \getchunk{defun defaultTargetFE} \getchunk{defun defiostream} @@ -59912,6 +60274,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun downlinkSaturn} \getchunk{defun dqConcat} \getchunk{defun dropInputLibrary} +\getchunk{defun dSearch} \getchunk{defun dumbTokenize} \getchunk{defun edit} @@ -60253,6 +60616,8 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun koPageInputAreaUnchanged?} \getchunk{defun ksPage} \getchunk{defun kcuPage} +\getchunk{defun kPage} +\getchunk{defun kSearch} \getchunk{defun kTestPred} \getchunk{defun lassocSub} @@ -60855,6 +61220,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun processSynonyms} \getchunk{defun prTraceNames} \getchunk{defun prTraceNames,fn} +\getchunk{defun pSearch} \getchunk{defun pspacers} \getchunk{defun ptimers} \getchunk{defun put} @@ -61062,6 +61428,7 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun stringize} \getchunk{defun stringList2String} \getchunk{defun stringMatches?} +\getchunk{defun string2Constructor} \getchunk{defun StringToDir} \getchunk{defun strpos} \getchunk{defun strposl} @@ -61184,8 +61551,10 @@ digits in TechExplorer. Since Saturn is gone we can remove it. \getchunk{defun xlSay} \getchunk{defun xlSkip} \getchunk{defun xlSkippingFin} +\getchunk{defun xSearch} \getchunk{defun yesanswer} +\getchunk{defun ySearch} \getchunk{defun zsystemdevelopment} \getchunk{defun zsystemdevelopment1} diff --git a/changelog b/changelog index cd3dac8..baa4a2c 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,10 @@ +20150102 tpd src/axiom-website/patches.html 20150102.01.tpd.patch +20150102 tpd books/bookvol5 merge, rewrite and remove some browser functions +20150102 tpd src/interp/br-con.lisp remove and rewrite functions +20150102 tpd src/interp/interp-proclaims.lisp remove proclaim +20150102 tpd src/interp/lisplib.lisp remove and rewrite functions +20150102 tpd src/interp/nrunfast.lisp remove and rewrite functions +20150102 tpd src/interp/util.lisp remove and rewrite functions 20150101 tpd src/axiom-website/patches.html 20150101.03.tpd.patch 20150101 tpd src/input/wester.input absorbed and removed, yet atain 20150101 tpd src/axiom-website/patches.html 20150101.02.tpd.patch diff --git a/patch b/patch index 38d2e12..f5a4944 100644 --- a/patch +++ b/patch @@ -1,2 +1,10 @@ -src/input/wester.input absorbed and removed, yet again +books/bookvol5 merge, rewrite and remove some browser functions + +# modified: books/bookvol5.pamphlet +# modified: src/interp/br-con.lisp.pamphlet +# modified: src/interp/interp-proclaims.lisp +# modified: src/interp/lisplib.lisp.pamphlet +# modified: src/interp/nrunfast.lisp.pamphlet +# modified: src/interp/util.lisp.pamphlet + diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 63ff99e..8a2d305 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -4886,6 +4886,8 @@ buglist: bug 7279: subscripting "1"::Symbol fails
src/input/wester.input absorbed and removed
20150101.03.tpd.patch src/input/wester.input absorbed and removed, yet again
+20150102.01.tpd.patch +books/bookvol5 merge, rewrite and remove some browser functions
diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index 64c9b4e..1f88e09 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -12,27 +12,6 @@ \begin{chunk}{*} (IN-PACKAGE "BOOT" ) -;concatWithBlanks r == -; r is [head,:tail] => -; tail => STRCONC(head,'" ",concatWithBlanks tail) -; head -; '"" - -(DEFUN |concatWithBlanks| (|r|) - (PROG (|head| |tail|) - (RETURN - (COND - ((AND (CONSP |r|) - (PROGN - (SPADLET |head| (QCAR |r|)) - (SPADLET |tail| (QCDR |r|)) - 'T)) - (COND - (|tail| (STRCONC |head| " " - (|concatWithBlanks| |tail|))) - ('T |head|))) - ('T ""))))) - ;writedb(u) == ; not STRINGP u => nil --skip if not a string ; PRINTEXP(addPatchesToLongLines(u,500),$outStream) @@ -60,31 +39,6 @@ |n|))) ('T |s|))) -;libdbTrim s == -; k := MAXINDEX s -; k < 0 => s -; for i in 0..k repeat -; s.i = $Newline => SETELT(s,i,char '_ ) -; trimString s - -(DEFUN |libdbTrim| (|s|) - (PROG (|k|) - (declare (special |$Newline|)) - (RETURN - (SEQ (PROGN - (SPADLET |k| (MAXINDEX |s|)) - (COND - ((MINUSP |k|) |s|) - ('T - (SEQ (DO ((|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| |k|) NIL) - (SEQ (EXIT (COND - ((BOOT-EQUAL (ELT |s| |i|) - |$Newline|) - (EXIT - (SETELT |s| |i| (|char| '| |)))))))) - (|trimString| |s|))))))))) - ;checkCommentsForBraces(kind,sop,sigpart,comments) == ; count := 0 ; for i in 0..MAXINDEX comments repeat @@ -224,26 +178,6 @@ (INTERN (STRCONC |sname| "XmpPage"))) ('T NIL)))))) -;dbRead(n) == -; instream := MAKE_-INSTREAM STRCONC(getEnv('"AXIOM"), '"/algebra/libdb.text") -; FILE_-POSITION(instream,n) -; line := READLINE instream -; SHUT instream -; line - -(DEFUN |dbRead| (|n|) - (PROG (|instream| |line|) - (RETURN - (PROGN - (SPADLET |instream| - (MAKE-INSTREAM - (STRCONC (|getEnv| "AXIOM") - "/algebra/libdb.text"))) - (FILE-POSITION |instream| |n|) - (SPADLET |line| (read-line |instream|)) - (SHUT |instream|) - |line|)))) - ;dbReadComments(n) == ; n = 0 => '"" ; instream := MAKE_-INSTREAM STRCONC(getEnv('"AXIOM"),'"/algebra/comdb.text") @@ -8639,7 +8573,6 @@ ;--======================================================================= ;koAttrs(conform,domname) == ; [conname,:args] := conform -;--asharpConstructorName? conname => nil --assumed ; 'category = GETDATABASE(conname,'CONSTRUCTORKIND) => ; koCatAttrs(conform,domname) ; $infovec: local := dbInfovec conname or return nil @@ -8840,8 +8773,6 @@ (SPADLET |subargs| |args|) (IF (SPADLET |u| (|koCatOps| |conform| |domname|)) (EXIT |u|)) - (IF (|asharpConstructorName?| (|opOf| |conform|)) - (EXIT NIL)) (SPADLET |$infovec| (|dbInfovec| |conname|)) (SPADLET |exposureTail| (SEQ (IF (NULL |$packageItem|) (EXIT '(NIL NIL))) @@ -12149,18 +12080,6 @@ (SEQ (EXIT (SETELT |s| |n| (|char| '| |))))) |s|))))) -;checkFilter filter == -; filter := STRINGIMAGE filter -; filter = '"" => '"*" -; trimString filter - -(DEFUN |checkFilter| (|filter|) - (PROGN - (SPADLET |filter| (STRINGIMAGE |filter|)) - (COND - ((BOOT-EQUAL |filter| "") "*") - ('T (|trimString| |filter|))))) - ;aSearch filter == --called from HD (man0.ht): general attribute search ; null (filter := checkFilter filter) => nil --in case of filter error ; dbSearch(grepConstruct(filter,'a),'"attribute",filter) @@ -12222,361 +12141,12 @@ '|grepSearchJump| 'T) (|htShowPage|))))) -;cSearch filter == --called from HD (man0.ht): category search -; constructorSearch(checkFilter filter,'c,'"category") - -(DEFUN |cSearch| (|filter|) - (|constructorSearch| (|checkFilter| |filter|) '|c| - "category")) - -;dSearch filter == --called from HD (man0.ht): domain search -; constructorSearch(checkFilter filter,'d,'"domain") - -(DEFUN |dSearch| (|filter|) - (|constructorSearch| (|checkFilter| |filter|) '|d| - "domain")) - -;pSearch filter == --called from HD (man0.ht): package search -; constructorSearch(checkFilter filter,'p,'"package") - -(DEFUN |pSearch| (|filter|) - (|constructorSearch| (|checkFilter| |filter|) '|p| - "package")) - -;xSearch filter == --called from HD (man0.ht): default package search -; constructorSearch(checkFilter filter,'x,'"default package") - -(DEFUN |xSearch| (|filter|) - (|constructorSearch| (|checkFilter| |filter|) '|x| - "default package")) - -;kSearch filter == --called from HD (man0.ht): constructor search (no defaults) -; constructorSearch(checkFilter filter,'k,'"constructor") - -(DEFUN |kSearch| (|filter|) - (|constructorSearch| (|checkFilter| |filter|) '|k| - "constructor")) - -;ySearch filter == --called from conPage: like kSearch but defaults included -; constructorSearch(checkFilter filter,'y,'"constructor") - -(DEFUN |ySearch| (|filter|) - (|constructorSearch| (|checkFilter| |filter|) '|y| - "constructor")) - -;constructorSearch(filter,key,kind) == -; null filter => nil --in case of filter error -; (parse := conSpecialString? filter) => conPage parse -; pageName := LASSOC(DOWNCASE filter,'(("union" . DomainUnion)("record" . DomainRecord)("mapping" . DomainMapping) ("enumeration" . DomainEnumeration))) => -; downlink pageName -; name := (STRINGP filter => INTERN filter; filter) -; if u := HGET($lowerCaseConTb,name) then filter := STRINGIMAGE first u -; line := conPageFastPath DOWNCASE filter => -; code := dbKind line -; newkind := -; code = char 'p => '"package" -; code = char 'd => '"domain" -; code = char 'c => '"category" -; nil -; kind = '"constructor" or kind = newkind => kPage line -; page := htInitPage('"Query Page",nil) -; htpSetProperty(page,'line,line) -; message := -; ['"{\em ",dbName line,'"} is not a {\em ",kind,'"} but a {\em ", -; newkind,'"}. Would you like to view it?\vspace{1}"] -; htQuery(message, 'grepConstructorSearch,true) -; htShowPage() -; filter = '"*" => grepSearchQuery(kind,[filter,key,kind,'constructorSearchGrep]) -; constructorSearchGrep(filter,key,kind) - -(DEFUN |constructorSearch| (|filter| |key| |kind|) - (PROG (|parse| |pageName| |name| |u| |line| |code| |newkind| |page| - |message|) - (declare (special |$lowerCaseConTb|)) - (RETURN - (COND - ((NULL |filter|) NIL) - ((SPADLET |parse| (|conSpecialString?| |filter|)) - (|conPage| |parse|)) - ((SPADLET |pageName| - (LASSOC (DOWNCASE |filter|) - '(("union" . |DomainUnion|) - ("record" . |DomainRecord|) - ("mapping" . |DomainMapping|) - ("enumeration" . |DomainEnumeration|)))) - (|downlink| |pageName|)) - ('T - (SPADLET |name| - (COND - ((STRINGP |filter|) (INTERN |filter|)) - ('T |filter|))) - (COND - ((SPADLET |u| (HGET |$lowerCaseConTb| |name|)) - (SPADLET |filter| (STRINGIMAGE (CAR |u|))))) - (COND - ((SPADLET |line| (|conPageFastPath| (DOWNCASE |filter|))) - (SPADLET |code| (|dbKind| |line|)) - (SPADLET |newkind| - (COND - ((BOOT-EQUAL |code| (|char| '|p|)) - "package") - ((BOOT-EQUAL |code| (|char| '|d|)) - "domain") - ((BOOT-EQUAL |code| (|char| '|c|)) - "category") - ('T NIL))) - (COND - ((OR (BOOT-EQUAL |kind| "constructor") - (BOOT-EQUAL |kind| |newkind|)) - (|kPage| |line|)) - ('T - (SPADLET |page| - (|htInitPage| "Query Page" NIL)) - (|htpSetProperty| |page| '|line| |line|) - (SPADLET |message| - (CONS "{\\em " - (CONS (|dbName| |line|) - (CONS - "} is not a {\\em " - (CONS |kind| - (CONS - "} but a {\\em " - (CONS |newkind| - (CONS - "}. Would you like to view it?\\vspace{1}" - NIL)))))))) - (|htQuery| |message| '|grepConstructorSearch| 'T) - (|htShowPage|)))) - ((BOOT-EQUAL |filter| "*") - (|grepSearchQuery| |kind| - (CONS |filter| - (CONS |key| - (CONS |kind| - (CONS '|constructorSearchGrep| NIL)))))) - ('T (|constructorSearchGrep| |filter| |key| |kind|)))))))) - ;grepConstructorSearch(htPage,yes) == kPage htpProperty(htPage,'line) (DEFUN |grepConstructorSearch| (|htPage| |yes|) (declare (ignore |yes|)) (|kPage| (|htpProperty| |htPage| '|line|))) -;conSpecialString?(filter,:options) == -; secondTime := IFCAR options -; parse := -; words := string2Words filter is [s] => ncParseFromString s -; and/[not MEMBER(x,'("and" "or" "not")) for x in words] => ncParseFromString filter -; false -; null parse => nil -; form := conLowerCaseConTran parse -; MEMQ(KAR form,'(and or not)) or CONTAINED("*",form) => nil -; filter = '"Mapping" =>nil -; u := kisValidType form => u -; secondTime => false -; u := "STRCONC"/[string2Constructor x for x in dbString2Words filter] -; conSpecialString?(u, true) - -(DEFUN |conSpecialString?| (&REST G176005 &AUX |options| |filter|) - (DSETQ (|filter| . |options|) G176005) - (PROG (|secondTime| |ISTMP#1| |s| |words| |parse| |form| |u|) - (RETURN - (SEQ (PROGN - (SPADLET |secondTime| (IFCAR |options|)) - (SPADLET |parse| - (COND - ((SPADLET |words| - (PROGN - (SPADLET |ISTMP#1| - (|string2Words| |filter|)) - (AND (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |s| (QCAR |ISTMP#1|)) - 'T)))) - (|ncParseFromString| |s|)) - ((PROG (G175967) - (SPADLET G175967 'T) - (RETURN - (DO ((G175973 NIL (NULL G175967)) - (G175974 |words| (CDR G175974)) - (|x| NIL)) - ((OR G175973 (ATOM G175974) - (PROGN - (SETQ |x| (CAR G175974)) - NIL)) - G175967) - (SEQ (EXIT - (SETQ G175967 - (AND G175967 - (NULL - (|member| |x| - '("and" "or" "not")))))))))) - (|ncParseFromString| |filter|)) - ('T NIL))) - (COND - ((NULL |parse|) NIL) - ('T (SPADLET |form| (|conLowerCaseConTran| |parse|)) - (COND - ((OR (member (KAR |form|) '(|and| |or| |not|)) - (CONTAINED '* |form|)) - NIL) - ((BOOT-EQUAL |filter| "Mapping") NIL) - ((SPADLET |u| (|kisValidType| |form|)) |u|) - (|secondTime| NIL) - ('T - (SPADLET |u| - (PROG (G175981) - (SPADLET G175981 "") - (RETURN - (DO ((G175986 - (|dbString2Words| |filter|) - (CDR G175986)) - (|x| NIL)) - ((OR (ATOM G175986) - (PROGN - (SETQ |x| (CAR G175986)) - NIL)) - G175981) - (SEQ (EXIT - (SETQ G175981 - (STRCONC G175981 - (|string2Constructor| |x|))))))))) - (|conSpecialString?| |u| 'T)))))))))) - -;dbString2Words l == -; i := 0 -; [w while dbWordFrom(l,i) is [w,i]] - -(DEFUN |dbString2Words| (|l|) - (PROG (|ISTMP#1| |w| |ISTMP#2| |i|) - (RETURN - (SEQ (PROGN - (SPADLET |i| 0) - (PROG (G176027) - (SPADLET G176027 NIL) - (RETURN - (DO () - ((NULL (PROGN - (SPADLET |ISTMP#1| - (|dbWordFrom| |l| |i|)) - (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 G176027)) - (SEQ (EXIT (SETQ G176027 (CONS |w| G176027)))))))))))) - -;$dbDelimiters := [char " " , char "(", char ")"] - -(SPADLET |$dbDelimiters| - (CONS (|char| '| |) - (CONS (|char| '|(|) (CONS (|char| '|)|) NIL)))) - -;dbWordFrom(l,i) == -; maxIndex := MAXINDEX l -; while maxIndex >= i and l.i = char " " repeat i := i + 1 -; if maxIndex >= i and MEMBER(l.i, $dbDelimiters) then return [l.i, i + 1] -; k := or/[j for j in i..maxIndex | not MEMBER(l.j, $dbDelimiters)] or return nil -; buf := '"" -; while k <= maxIndex and not MEMBER(c := l.k, $dbDelimiters) repeat -; ch := -; c = char '__ => l.(k := 1+k) --this may exceed bounds -; c -; buf := STRCONC(buf,ch) -; k := k + 1 -; [buf,k] - -(DEFUN |dbWordFrom| (|l| |i|) - (PROG (|maxIndex| |c| |ch| |buf| |k|) - (declare (special |$dbDelimiters|)) - (RETURN - (SEQ (PROGN - (SPADLET |maxIndex| (MAXINDEX |l|)) - (DO () - ((NULL (AND (>= |maxIndex| |i|) - (BOOT-EQUAL (ELT |l| |i|) (|char| '| |)))) - NIL) - (SEQ (EXIT (SPADLET |i| (PLUS |i| 1))))) - (COND - ((AND (>= |maxIndex| |i|) - (|member| (ELT |l| |i|) |$dbDelimiters|)) - (RETURN (CONS (ELT |l| |i|) (CONS (PLUS |i| 1) NIL))))) - (SPADLET |k| - (OR (PROG (G176053) - (SPADLET G176053 NIL) - (RETURN - (DO ((G176060 NIL G176053) - (|j| |i| (+ |j| 1))) - ((OR G176060 (> |j| |maxIndex|)) - G176053) - (SEQ (EXIT - (COND - ((NULL - (|member| (ELT |l| |j|) - |$dbDelimiters|)) - (SETQ G176053 - (OR G176053 |j|))))))))) - (RETURN NIL))) - (SPADLET |buf| "") - (DO () - ((NULL (AND (<= |k| |maxIndex|) - (NULL (|member| - (SPADLET |c| (ELT |l| |k|)) - |$dbDelimiters|)))) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |ch| - (COND - ((BOOT-EQUAL |c| (|char| '_)) - (ELT |l| - (SPADLET |k| (PLUS 1 |k|)))) - ('T |c|))) - (SPADLET |buf| (STRCONC |buf| |ch|)) - (SPADLET |k| (PLUS |k| 1)))))) - (CONS |buf| (CONS |k| NIL))))))) - -;conLowerCaseConTran x == -; IDENTP x => IFCAR HGET($lowerCaseConTb, x) or x -; atom x => x -; [conLowerCaseConTran y for y in x] - -(DEFUN |conLowerCaseConTran| (|x|) - (PROG () - (declare (special |$lowerCaseConTb|)) - (RETURN - (SEQ (COND - ((IDENTP |x|) - (OR (IFCAR (HGET |$lowerCaseConTb| |x|)) |x|)) - ((ATOM |x|) |x|) - ('T - (PROG (G176092) - (SPADLET G176092 NIL) - (RETURN - (DO ((G176097 |x| (CDR G176097)) (|y| NIL)) - ((OR (ATOM G176097) - (PROGN (SETQ |y| (CAR G176097)) NIL)) - (NREVERSE0 G176092)) - (SEQ (EXIT (SETQ G176092 - (CONS (|conLowerCaseConTran| |y|) - G176092))))))))))))) - -;string2Constructor x == -; not STRINGP x => x -; IFCAR HGET($lowerCaseConTb, INTERN DOWNCASE x) or x - -(DEFUN |string2Constructor| (|x|) - (declare (special |$lowerCaseConTb|)) - (COND - ((NULL (STRINGP |x|)) |x|) - ('T - (OR (IFCAR (HGET |$lowerCaseConTb| (INTERN (DOWNCASE |x|)))) |x|)))) - ;conLowerCaseConTranTryHarder x == ; IDENTP x => IFCAR HGET($lowerCaseConTb,DOWNCASE x) or x ; atom x => x @@ -14399,35 +13969,6 @@ $dbKindAlist := (SPADLET |t| (PATHNAME-TYPE |u|)) (STRCONC |n| "." |t|))))))) -;asharpConstructorName? name == -; u:= GETDATABASE(name,'SOURCEFILE) -; u and PATHNAME_-TYPE u = '"as" - -(DEFUN |asharpConstructorName?| (|name|) - (PROG (|u|) - (RETURN - (PROGN - (SPADLET |u| (GETDATABASE |name| 'SOURCEFILE)) - (AND |u| (BOOT-EQUAL (PATHNAME-TYPE |u|) "as")))))) - -;asharpConstructors() == -; [x for x in allConstructors() | not asharpConstructorName? x] - -(DEFUN |asharpConstructors| () - (PROG () - (RETURN - (SEQ (PROG (G176893) - (SPADLET G176893 NIL) - (RETURN - (DO ((G176899 (|allConstructors|) (CDR G176899)) - (|x| NIL)) - ((OR (ATOM G176899) - (PROGN (SETQ |x| (CAR G176899)) NIL)) - (NREVERSE0 G176893)) - (SEQ (EXIT (COND - ((NULL (|asharpConstructorName?| |x|)) - (SETQ G176893 (CONS |x| G176893))))))))))))) - ;extractFileNameFromPath s == fn(s,0,#s) where ; fn(s,i,m) == ; k := charPosition(char '_/,s,i) @@ -14947,7 +14488,6 @@ $dbKindAlist := (COND ((BOOT-EQUAL '|category| (GETDATABASE |name| 'CONSTRUCTORKIND)) NIL) - ((GETDATABASE |name| 'ASHARP?) NIL) ('T (|loadLibIfNotLoaded| |name|) (COND ((SPADLET |u| (GETL |name| '|infovec|)) |u|))))))) @@ -15195,10 +14735,6 @@ $dbKindAlist := (DEFUN |dbpHasDefaultCategory?| (|s|) (AND (> (|#| |s|) 1) (BOOT-EQUAL (ELT |s| 1) (|char| '|x|)))) -;dbKind line == line.0 - -(DEFUN |dbKind| (|line|) (ELT |line| 0)) - ;dbKindString kind == LASSOC(kind,$dbKindAlist) (DEFUN |dbKindString| (|kind|) @@ -18073,121 +17609,6 @@ $dbKindAlist := NIL))) |val|)))) -;--======================================================================= -;-- Redefinitions from br-con.boot -;--======================================================================= -;kPage(line,:options) == --any cat, dom, package, default package -;--constructors Cname\#\E\sig \args \abb \comments (C is C, D, P, X) -; parts := dbXParts(line,7,1) -; [kind,name,nargs,xflag,sig,args,abbrev,comments] := parts -; form := IFCAR options -; isFile := null kind -; kind := kind or '"package" -; RPLACA(parts,kind) -; conform := mkConform(kind,name,args) -; $kPageSaturnArguments: local := rest conform -; conname := opOf conform -; capitalKind := capitalize kind -; signature := ncParseFromString sig -; sourceFileName := dbSourceFile INTERN name -; constrings := -; KDR form => dbConformGenUnder form -; [STRCONC(name,args)] -; emString := ['"{\sf ",:constrings,'"}"] -; heading := [capitalKind,'" ",:emString] -; if not isExposedConstructor conname then heading := ['"Unexposed ",:heading] -; if name=abbrev then abbrev := asyAbbreviation(conname,nargs) -; page := htInitPageNoScroll nil -; htAddHeading heading -; htSayStandard("\beginscroll ") -; htpSetProperty(page,'argSublis,mkConArgSublis rest conform) -; htpSetProperty(page,'isFile,true) -; htpSetProperty(page,'parts,parts) -; htpSetProperty(page,'heading,heading) -; htpSetProperty(page,'kind,kind) -; if asharpConstructorName? conname then -; htpSetProperty(page,'isAsharpConstructor,true) -; htpSetProperty(page,'conform,conform) -; htpSetProperty(page,'signature,signature) -; ---what follows is stuff from kiPage with domain = nil -; $conformsAreDomains := nil -; dbShowConsDoc1(page,conform,nil) -; if kind ^= 'category and nargs > 0 then addParameterTemplates(page,conform) -; if $atLeastOneUnexposed then htSay '"\newline{}{\em *} = unexposed" -; htSayStandard("\endscroll ") -; kPageContextMenu page -; htShowPageNoScroll() - -(DEFUN |kPage| (&REST G178843 &AUX |options| |line|) - (DSETQ (|line| . |options|) G178843) - (PROG (|$kPageSaturnArguments| |parts| |name| |nargs| |xflag| |sig| - |args| |comments| |form| |isFile| |kind| |conform| - |conname| |capitalKind| |signature| |sourceFileName| - |constrings| |emString| |heading| |abbrev| |page|) - (DECLARE (SPECIAL |$kPageSaturnArguments| |$conformsAreDomains| - |$conformsAreDomains| |$atLeastOneUnexposed|)) - (RETURN - (PROGN - (SPADLET |parts| (|dbXParts| |line| 7 1)) - (SPADLET |kind| (CAR |parts|)) - (SPADLET |name| (CADR |parts|)) - (SPADLET |nargs| (CADDR |parts|)) - (SPADLET |xflag| (CADDDR |parts|)) - (SPADLET |sig| (CAR (CDDDDR |parts|))) - (SPADLET |args| (CADR (CDDDDR |parts|))) - (SPADLET |abbrev| (CADDR (CDDDDR |parts|))) - (SPADLET |comments| (CADDDR (CDDDDR |parts|))) - (SPADLET |form| (IFCAR |options|)) - (SPADLET |isFile| (NULL |kind|)) - (SPADLET |kind| (OR |kind| "package")) - (RPLACA |parts| |kind|) - (SPADLET |conform| (|mkConform| |kind| |name| |args|)) - (SPADLET |$kPageSaturnArguments| (CDR |conform|)) - (SPADLET |conname| (|opOf| |conform|)) - (SPADLET |capitalKind| (|capitalize| |kind|)) - (SPADLET |signature| (|ncParseFromString| |sig|)) - (SPADLET |sourceFileName| (|dbSourceFile| (INTERN |name|))) - (SPADLET |constrings| - (COND - ((KDR |form|) (|dbConformGenUnder| |form|)) - ('T (CONS (STRCONC |name| |args|) NIL)))) - (SPADLET |emString| - (CONS "{\\sf " - (APPEND |constrings| - (CONS "}" NIL)))) - (SPADLET |heading| - (CONS |capitalKind| - (CONS " " |emString|))) - (COND - ((NULL (|isExposedConstructor| |conname|)) - (SPADLET |heading| - (CONS "Unexposed " |heading|)))) - (SPADLET |page| (|htInitPageNoScroll| NIL)) - (|htAddHeading| |heading|) - (|htSayStandard| '|\\beginscroll |) - (|htpSetProperty| |page| '|argSublis| - (|mkConArgSublis| (CDR |conform|))) - (|htpSetProperty| |page| '|isFile| 'T) - (|htpSetProperty| |page| '|parts| |parts|) - (|htpSetProperty| |page| '|heading| |heading|) - (|htpSetProperty| |page| '|kind| |kind|) - (COND - ((|asharpConstructorName?| |conname|) - (|htpSetProperty| |page| '|isAsharpConstructor| 'T))) - (|htpSetProperty| |page| '|conform| |conform|) - (|htpSetProperty| |page| '|signature| |signature|) - (SPADLET |$conformsAreDomains| NIL) - (|dbShowConsDoc1| |page| |conform| NIL) - (COND - ((AND (NEQUAL |kind| '|category|) (> |nargs| 0)) - (|addParameterTemplates| |page| |conform|))) - (COND - (|$atLeastOneUnexposed| - (|htSay| "\\newline{}{\\em *} = unexposed"))) - (|htSayStandard| '|\\endscroll |) - (|kPageContextMenu| |page|) - (|htShowPageNoScroll|))))) - ;kPageContextMenu page == ; $saturn => kPageContextMenuSaturn page ; [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(page,'parts) @@ -18282,17 +17703,15 @@ $dbKindAlist := (CONS NIL NIL)))) NIL)) NIL)))) - (COND - ((NULL (|asharpConstructorName?| |conname|)) - (|htSay| "}{") - (|htMakePage| + (|htSay| "}{") + (|htMakePage| (CONS (CONS '|bcLinks| (CONS (CONS '|Dependents| (CONS "" (CONS '|kcdePage| (CONS NIL NIL)))) NIL)) - NIL)))) + NIL)) (COND ((BOOT-EQUAL |kind| "category") (|htSay| "}{") @@ -18307,17 +17726,14 @@ $dbKindAlist := (COND ((BOOT-EQUAL |kind| "category") (|htSay| "}{") - (COND - ((NULL (|asharpConstructorName?| |conname|)) - (|htMakePage| + (|htMakePage| (CONS (CONS '|bcLinks| (CONS (CONS '|Domains| (CONS "" (CONS '|kcdoPage| (CONS NIL NIL)))) NIL)) - NIL))) - ('T (|htSay| "{\\em Domains}"))))) + NIL)))) (|htSay| "}{") (COND ((AND (NEQUAL |kind| "category") @@ -18362,16 +17778,13 @@ $dbKindAlist := (COND ((NEQUAL |kind| "category") (|htSay| "}{") - (COND - ((NULL (|asharpConstructorName?| |conname|)) - (|htMakePage| + (|htMakePage| (CONS (CONS '|bcLinks| (CONS (CONS '|Search Path| (CONS "" (CONS '|ksPage| (CONS NIL NIL)))) NIL)) - NIL))) - ('T (|htSay| "{\\em Search Path}"))))) + NIL)))) (COND ((NEQUAL |kind| "category") (|htSay| "}{") @@ -18478,16 +17891,14 @@ $dbKindAlist := (CONS NIL NIL)))) NIL)) NIL)))) - (COND - ((NULL (|asharpConstructorName?| |conname|)) - (|htMakePage| + (|htMakePage| (CONS (CONS '|bcLinks| (CONS (CONS "\\&Dependents" (CONS "" (CONS '|kcdePage| (CONS NIL NIL)))) NIL)) - NIL)))) + NIL)) (COND ((BOOT-EQUAL |kind| "category") (|htMakePage| @@ -18500,16 +17911,13 @@ $dbKindAlist := NIL)))) (COND ((BOOT-EQUAL |kind| "category") - (COND - ((NULL (|asharpConstructorName?| |conname|)) - (|htMakePage| + (|htMakePage| (CONS (CONS '|bcLinks| (CONS (CONS "Do\\&mains" (CONS "" (CONS '|kcdoPage| (CONS NIL NIL)))) NIL)) - NIL))) - ('T (|htSayCold| "Do\\&mains"))))) + NIL)))) (COND ((AND (NEQUAL |kind| "category") (SPADLET |name| (|saturnHasExamplePage| |conname|))) @@ -18540,16 +17948,13 @@ $dbKindAlist := NIL)))) NIL)) NIL)) - (COND - ((NULL (|asharpConstructorName?| |conname|)) - (|htMakePage| + (|htMakePage| (CONS (CONS '|bcLinks| (CONS (CONS "Search O\\&rder" (CONS "" (CONS '|ksPage| (CONS NIL NIL)))) NIL)) - NIL))) - ('T (|htSayCold| "Search Order"))) + NIL)) (COND ((OR (NEQUAL |kind| "category") (|dbpHasDefaultCategory?| |xpart|)) @@ -19768,7 +19173,7 @@ $dbKindAlist := (DEFUN |dbPresentOps| (&REST G179404 &AUX |exclusions| |which| |htPage|) (DSETQ (|htPage| |which| . |exclusions|) G179404) - (PROG (|asharp?| |fromConPage?| |usage?| |star?| |implementation?| + (PROG (|fromConPage?| |usage?| |star?| |implementation?| |rightmost?| |opAlist| |empty?| |entry| |one?| |conname|) (declare (special |$saturn| |$UserLevel| |$conformsAreDomains| |$includeUnexposed?| |$exposedOnlyIfTrue|)) @@ -19777,8 +19182,6 @@ $dbKindAlist := (|$saturn| (|dbPresentOpsSaturn| |htPage| |which| |exclusions|)) ('T - (SPADLET |asharp?| - (|htpProperty| |htPage| '|isAsharpConstructor|)) (SPADLET |fromConPage?| (SPADLET |conname| (|opOf| (|htpProperty| |htPage| '|conform|)))) @@ -19787,10 +19190,7 @@ $dbKindAlist := (OR (NULL |fromConPage?|) (BOOT-EQUAL |which| "package operation"))) - (SPADLET |implementation?| - (AND (NULL |asharp?|) - (BOOT-EQUAL |$UserLevel| '|development|) - |$conformsAreDomains|)) + (SPADLET |implementation?| |$conformsAreDomains|) (SPADLET |rightmost?| (OR |star?| (AND |implementation?| @@ -20041,7 +19441,7 @@ $dbKindAlist := ; $saturnContextMenuLines := $htLineList (DEFUN |dbPresentOpsSaturn| (|htPage| |which| |exclusions|) - (PROG (|$htLineList| |$newPage| |asharp?| |fromConPage?| |usage?| + (PROG (|$htLineList| |$newPage| |fromConPage?| |usage?| |star?| |implementation?| |rightmost?| |opAlist| |empty?| |entry| |one?| |conname|) (DECLARE (SPECIAL |$htLineList| |$newPage| |$UserLevel| @@ -20052,8 +19452,6 @@ $dbKindAlist := (PROGN (SPADLET |$htLineList| NIL) (SPADLET |$newPage| NIL) - (SPADLET |asharp?| - (|htpProperty| |htPage| '|isAsharpConstructor|)) (SPADLET |fromConPage?| (SPADLET |conname| (|opOf| (|htpProperty| |htPage| '|conform|)))) @@ -20062,10 +19460,7 @@ $dbKindAlist := (OR (NULL |fromConPage?|) (BOOT-EQUAL |which| "package operation"))) - (SPADLET |implementation?| - (AND (NULL |asharp?|) - (BOOT-EQUAL |$UserLevel| '|development|) - |$conformsAreDomains|)) + (SPADLET |implementation?| |$conformsAreDomains|) (SPADLET |rightmost?| (OR |star?| (AND |implementation?| diff --git a/src/interp/interp-proclaims.lisp b/src/interp/interp-proclaims.lisp index 979969b..ab893c6 100644 --- a/src/interp/interp-proclaims.lisp +++ b/src/interp/interp-proclaims.lisp @@ -1836,7 +1836,7 @@ BOOT::|parseAndEval| BOOT::|getDomainHash| BOOT::|aplTran1| BOOT::|hasAplExtension| BOOT::|htpDomainConditions| BOOT::|aplTranList| BOOT::|postDefArgs| - BOOT::|postTranScripts| BOOT::|getHtMacroItem| + BOOT::|postTranScripts| BOOT::|postTranScripts,fn| BOOT::|unTuple| BOOT::|isPackageType| BOOT::|buttonNames| BOOT::|postcheckTarget| BOOT::|postcheck| diff --git a/src/interp/lisplib.lisp.pamphlet b/src/interp/lisplib.lisp.pamphlet index fa45559..93bba74 100644 --- a/src/interp/lisplib.lisp.pamphlet +++ b/src/interp/lisplib.lisp.pamphlet @@ -213,22 +213,10 @@ ; SETF(SYMBOL_-FUNCTION cnam,mkAutoLoad(fn, cnam)) (DEFUN |systemDependentMkAutoload| (|fn| |cnam|) - (PROG (|asharpName| |kind| |cosig| |file|) + (PROG (|kind| |cosig| |file|) (RETURN (COND ((FBOUNDP |cnam|) '|next|) - ((SPADLET |asharpName| (GETDATABASE |cnam| 'ASHARP?)) - (SPADLET |kind| (GETDATABASE |cnam| 'CONSTRUCTORKIND)) - (SPADLET |cosig| (GETDATABASE |cnam| 'COSIG)) - (SPADLET |file| (GETDATABASE |cnam| 'OBJECT)) - (SET-LIB-FILE-GETTER |file| |cnam|) - (COND - ((BOOT-EQUAL |kind| '|category|) - (ASHARPMKAUTOLOADCATEGORY |file| |cnam| |asharpName| - |cosig|)) - ('T - (ASHARPMKAUTOLOADFUNCTOR |file| |cnam| |asharpName| - |cosig|)))) ('T (SETF (SYMBOL-FUNCTION |cnam|) (|mkAutoLoad| |fn| |cnam|))))))) ;autoLoad(abb,cname) == diff --git a/src/interp/nrunfast.lisp.pamphlet b/src/interp/nrunfast.lisp.pamphlet index a788046..ef6e898 100644 --- a/src/interp/nrunfast.lisp.pamphlet +++ b/src/interp/nrunfast.lisp.pamphlet @@ -2774,8 +2774,6 @@ '(|Union| |Record| |Mapping| |Enumeration|))) (|ofCategory| |domform| |catOrAtt|)) ((BOOT-EQUAL |catOrAtt| '(|Type|)) 'T) - ((GETDATABASE (|opOf| |domform|) 'ASHARP?) - (|newHasTest,fn| |domform| |catOrAtt|)) ('T (SPADLET |op| (|opOf| |catOrAtt|)) (SPADLET |isAtom| (ATOM |catOrAtt|)) (COND diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet index 9f07faf..f201ecb 100644 --- a/src/interp/util.lisp.pamphlet +++ b/src/interp/util.lisp.pamphlet @@ -500,13 +500,11 @@ if you use the browse function of the {\bf hypertex} system. (setq browse-functions '( |browserAutoloadOnceTrigger| - |htInitPage| |parentsOf| ; br-con |getParentsFor| ; br-con |folks| ; br-con |oSearch| ; br-con |aokSearch| - |kSearch| |aSearch| |genSearch| |docSearch| @@ -518,7 +516,6 @@ if you use the browse function of the {\bf hypertex} system. |dbGetOrigin| |dbComments| |grepConstruct| - |cSearch| |dbName| |dbPart| |form2HtString|