diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index bc6bc63..5a2c1b7 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -51890,6 +51890,137 @@ There are 8 parts of an htPage: \end{chunk} +\defun{koPage}{koPage} +\calls{koPage}{htpProperty} +\calls{koPage}{concat} +\calls{koPage}{koPageInputAreaUnchanged?} +\calls{koPage}{kDomainName} +\calls{koPage}{errorPage} +\calls{koPage}{form2HtString} +\calls{koPage}{capitalize} +\calls{koPage}{htpSetProperty} +\calls{koPage}{koPageAux} +\begin{chunk}{defun koPage} +(defun |koPage| (htPage which) + (let (lt1 kind name nargs args constring conname u IT1 domname headingString + heading) + (setq lt1 (|htpProperty| htPage '|parts|)) + (setq kind (first lt1)) + (setq name (second lt1)) + (setq nargs (third lt1)) + (setq args (sixth lt1)) + (setq constring (concat name args)) + (setq conname (intern name)) + (setq IT1 (setq u (|htpProperty| htPage '|domname|))) + (setq domname + (cond + ((and (consp IT1) (equal (qcar IT1) conname) + (or (eq (|htpProperty| htPage '|fromConOpPage1|) t) + (|koPageInputAreaUnchanged?| htPage nargs))) + u) + (t (|kDomainName| htPage kind name nargs)))) + (cond + ((and (consp domname) (eq (qcar domname) '|error|)) + (|errorPage| htPage domname)) + (t + (|htpSetProperty| htPage '|domname| domname) + (setq headingString (if domname (|form2HtString| domname nil t) constring)) + (setq heading (list (|capitalize| kind) " {\\sf " headingString "}" )) + (|htpSetProperty| htPage '|which| which) + (|htpSetProperty| htPage '|heading| heading) + (|koPageAux| htPage which domname heading))))) + +\end{chunk} + +\defun{koPageFromKKPage}{koPageFromKKPage} +\calls{koPageFromKKPage}{koPageAux} +\calls{koPageFromKKPage}{htpProperty} +\begin{chunk}{defun koPageFromKKPage} +(defun |koPageFromKKPage| (htPage ao) + (|koPageAux| htPage ao (|htpProperty| htPage '|domname|) + (|htpProperty| htPage '|heading|))) + +\end{chunk} + +\defun{koPageAux}{koPageAux} +\calls{koPageAux}{htpSetProperty} +\calls{koPageAux}{koAttrs} +\calls{koPageAux}{koOps} +\calls{koPageAux}{assoc} +\calls{koPageAux}{systemError} +\calls{koPageAux}{dbShowOperationsFromConform} +\begin{chunk}{defun koPageAux} +(defun |koPageAux| (htPage which domname heading) + (let (conform selectedOperation opAlist) + (|htpSetProperty| htPage '|which| which) + (setq domname (|htpProperty| htPage '|domname|)) + (setq conform (|htpProperty| htPage '|conform|)) + (setq heading (|htpProperty| htPage '|heading|)) + (setq opAlist + (cond + ((string= which "attribute") (|koAttrs| conform domname)) + ((string= which "general operation") (|koOps| conform domname t)) + (t (|koOps| conform domname)))) + (cond + ((setq selectedOperation (|htpProperty| htPage '|selectedOperation|)) + (setq opAlist + (list (or (|assoc| selectedOperation opAlist) (|systemError|)))))) + (|dbShowOperationsFromConform| htPage which opAlist))) + +\end{chunk} + +\defun{koPageAux1}{koPageAux1} +\calls{koPageAux1}{htpProperty} +\calls{koPageAux1}{dbShowOperationsFromConform} +\begin{chunk}{defun koPageAux1} +(defun |koPageAux1| (htPage opAlist) + (let (which) + (setq which (|htpProperty| htPage '|which|)) + (|dbShowOperationsFromConform| htPage which opAlist))) + +\end{chunk} + +\defun{koaPageFilterByName}{koaPageFilterByName} +\calls{koaPageFilterByName}{htpLabelInputString} +\calls{koaPageFilterByName}{koaPageFilterByCategory} +\calls{koaPageFilterByName}{pmTransFilter} +\calls{koaPageFilterByName}{htpProperty} +\calls{koaPageFilterByName}{dbGetInputString} +\calls{koaPageFilterByName}{superMatch?} +\calls{koaPageFilterByName}{downcase} +\calls{koaPageFilterByName}{stringimage} +\calls{koaPageFilterByName}{htpSetProperty} +\begin{chunk}{defun koaPageFilterByName} +(defun |koaPageFilterByName| (htPage functionToCall) + (let (filter which opAlist) + (cond + ((string= (|htpLabelInputString| htPage '|filter|) "") + (|koaPageFilterByCategory| htPage functionToCall)) + (t + (setq filter (|pmTransFilter| (|dbGetInputString| htPage))) + (setq which (|htpProperty| htPage '|which|)) + (setq opAlist + (loop for x in (|htpProperty| htPage '|opAlist|) + when (|superMatch?| filter (downcase (stringimage (car x)))) + collect x)) + (|htpSetProperty| htPage '|opAlist| opAlist) + (funcall functionToCall htPage nil))))) + +\end{chunk} + +\defun{dbConstructorDoc,hn}{dbConstructorDoc,hn} +\calls{dbConstructorDoc,hn}{length} +\calls{dbConstructorDoc,hn}{sublislis} +\usesdollar{dbConstructorDoc,hn}{FormalMapVariableList} +\usesdollar{dbConstructorDoc,hn}{sig} +\usesdollar{dbConstructorDoc,hn}{args} +\begin{chunk}{defun dbConstructorDoc,hn} +(defun |dbConstructorDoc,hn| (sig) + (declare (special |$sig| |$args|)) + (and (equal (|#| |$sig|) (|#| sig)) + (equal |$sig| (sublislis |$args| |$FormalMapVariableList| sig)))) + +\end{chunk} \chapter{The Interpreter} \begin{chunk}{Interpreter} @@ -52490,6 +52621,7 @@ There are 8 parts of an htPage: \getchunk{defun DaaseName} \getchunk{defun dbCompositeWithMap} +\getchunk{defun dbConstructorDoc,hn} \getchunk{defun dbExtractUnderlyingDomain} \getchunk{defun dbNonEmptyPattern} \getchunk{defun dbSearchOrder} @@ -52884,6 +53016,11 @@ There are 8 parts of an htPage: \getchunk{defun kePageOpAlist} \getchunk{defun kiPage} \getchunk{defun kisValidType} +\getchunk{defun koaPageFilterByName} +\getchunk{defun koPage} +\getchunk{defun koPageAux} +\getchunk{defun koPageAux1} +\getchunk{defun koPageFromKKPage} \getchunk{defun koPageInputAreaUnchanged?} \getchunk{defun ksPage} \getchunk{defun kcuPage} diff --git a/changelog b/changelog index a18a7d8..b5fbe06 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20130613 tpd src/axiom-website/patches.html 20130613.02.tpd.patch +20130613 tpd src/interp/br-con.lisp move code to bookvol5 +20130613 tpd books/bookvol5 move code from br-con.lisp 20130613 tpd src/axiom-website/patches.html 20130613.01.tpd.patch 20130613 tpd books/bookvol8.1 add crc test section 2.8, 2.9 20130613 tpd books/ps/v81crcp56-2.8.1.1-3.eps added diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index c6e6281..7933b09 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -4208,6 +4208,8 @@ books/bookvol8.1 add crc test section 2.4 books/bookvol8.1 add crc test section 2.5, 2.6, 2.7 20130613.01.tpd.patch books/bookvol8.1 add crc test section 2.8, 2.9 +20130613.02.tpd.patch +books/bookvol5 move code from br-con.lisp diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index 5d3062c..1c1bf04 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -13,179 +13,6 @@ (IN-PACKAGE "BOOT" ) ;--======================================================================= -;-- Operation Page from Main Page -;--======================================================================= -;koPage(htPage,which) == -; [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts) -; constring := STRCONC(name,args) -; conname := INTERN name -; domname := -; (u := htpProperty(htPage,'domname)) is [=conname,:.] -; and (htpProperty(htPage,'fromConOpPage1) = true or -; koPageInputAreaUnchanged?(htPage,nargs)) => u -; kDomainName(htPage,kind,name,nargs) -; domname is ['error,:.] => errorPage(htPage,domname) -; htpSetProperty(htPage,'domname,domname) -; headingString := -; domname => form2HtString(domname,nil,true) -; constring -; heading := [capitalize kind,'" {\sf ",headingString,'"}"] -; htpSetProperty(htPage,'which,which) -; htpSetProperty(htPage,'heading,heading) -; koPageAux(htPage,which,domname,heading) - -(DEFUN |koPage| (|htPage| |which|) - (PROG (|LETTMP#1| |kind| |name| |nargs| |xflag| |sig| |args| |abbrev| - |comments| |constring| |conname| |u| |ISTMP#1| |domname| - |headingString| |heading|) - (RETURN - (PROGN - (SPADLET |LETTMP#1| (|htpProperty| |htPage| '|parts|)) - (SPADLET |kind| (CAR |LETTMP#1|)) - (SPADLET |name| (CADR |LETTMP#1|)) - (SPADLET |nargs| (CADDR |LETTMP#1|)) - (SPADLET |xflag| (CADDDR |LETTMP#1|)) - (SPADLET |sig| (CAR (CDDDDR |LETTMP#1|))) - (SPADLET |args| (CADR (CDDDDR |LETTMP#1|))) - (SPADLET |abbrev| (CADDR (CDDDDR |LETTMP#1|))) - (SPADLET |comments| (CADDDR (CDDDDR |LETTMP#1|))) - (SPADLET |constring| (STRCONC |name| |args|)) - (SPADLET |conname| (INTERN |name|)) - (SPADLET |domname| - (COND - ((AND (PROGN - (SPADLET |ISTMP#1| - (SPADLET |u| - (|htpProperty| |htPage| - '|domname|))) - (AND (CONSP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) |conname|))) - (OR (BOOT-EQUAL - (|htpProperty| |htPage| - '|fromConOpPage1|) - 'T) - (|koPageInputAreaUnchanged?| |htPage| - |nargs|))) - |u|) - ('T (|kDomainName| |htPage| |kind| |name| |nargs|)))) - (COND - ((AND (CONSP |domname|) (EQ (QCAR |domname|) '|error|)) - (|errorPage| |htPage| |domname|)) - ('T (|htpSetProperty| |htPage| '|domname| |domname|) - (SPADLET |headingString| - (COND - (|domname| (|form2HtString| |domname| NIL 'T)) - ('T |constring|))) - (SPADLET |heading| - (CONS (|capitalize| |kind|) - (CONS " {\\sf " - (CONS |headingString| - (CONS "}" NIL))))) - (|htpSetProperty| |htPage| '|which| |which|) - (|htpSetProperty| |htPage| '|heading| |heading|) - (|koPageAux| |htPage| |which| |domname| |heading|))))))) - -;koPageFromKKPage(htPage,ao) == -; koPageAux(htPage,ao,htpProperty(htPage,'domname),htpProperty(htPage,'heading)) - -(DEFUN |koPageFromKKPage| (|htPage| |ao|) - (|koPageAux| |htPage| |ao| (|htpProperty| |htPage| '|domname|) - (|htpProperty| |htPage| '|heading|))) - -;koPageAux(htPage,which,domname,heading) == --from koPage, koPageFromKKPage -; htpSetProperty(htPage,'which,which) -; domname := htpProperty(htPage,'domname) -; conform := htpProperty(htPage,'conform) -; heading := htpProperty(htPage,'heading) -; opAlist := -; which = '"attribute" => koAttrs(conform,domname) -; which = '"general operation" => koOps(conform,domname,true) -; koOps(conform,domname) -; if selectedOperation := htpProperty(htPage,'selectedOperation) then -; opAlist := [ASSOC(selectedOperation,opAlist) or systemError()] -; dbShowOperationsFromConform(htPage,which,opAlist) - -(DEFUN |koPageAux| (|htPage| |which| |domname| |heading|) - (PROG (|conform| |selectedOperation| |opAlist|) - (RETURN - (PROGN - (|htpSetProperty| |htPage| '|which| |which|) - (SPADLET |domname| (|htpProperty| |htPage| '|domname|)) - (SPADLET |conform| (|htpProperty| |htPage| '|conform|)) - (SPADLET |heading| (|htpProperty| |htPage| '|heading|)) - (SPADLET |opAlist| - (COND - ((BOOT-EQUAL |which| "attribute") - (|koAttrs| |conform| |domname|)) - ((BOOT-EQUAL |which| - "general operation") - (|koOps| |conform| |domname| 'T)) - ('T (|koOps| |conform| |domname|)))) - (COND - ((SPADLET |selectedOperation| - (|htpProperty| |htPage| '|selectedOperation|)) - (SPADLET |opAlist| - (CONS (OR (|assoc| |selectedOperation| |opAlist|) - (|systemError|)) - NIL)))) - (|dbShowOperationsFromConform| |htPage| |which| |opAlist|))))) - -;koPageAux1(htPage,opAlist) == -; which := htpProperty(htPage,'which) -; dbShowOperationsFromConform(htPage,which,opAlist) - -(DEFUN |koPageAux1| (|htPage| |opAlist|) - (PROG (|which|) - (RETURN - (PROGN - (SPADLET |which| (|htpProperty| |htPage| '|which|)) - (|dbShowOperationsFromConform| |htPage| |which| |opAlist|))))) - -;koaPageFilterByName(htPage,functionToCall) == -; htpLabelInputString(htPage,'filter) = '"" => -; koaPageFilterByCategory(htPage,functionToCall) -; filter := pmTransFilter(dbGetInputString htPage) -;--WARNING: this call should check for ['error,:.] returned -; which := htpProperty(htPage,'which) -; opAlist := -; [x for x in htpProperty(htPage,'opAlist) | superMatch?(filter,DOWNCASE STRINGIMAGE first x)] -; htpSetProperty(htPage,'opAlist,opAlist) -; FUNCALL(functionToCall,htPage,nil) - -(DEFUN |koaPageFilterByName| (|htPage| |functionToCall|) - (PROG (|filter| |which| |opAlist|) - (RETURN - (SEQ (COND - ((BOOT-EQUAL (|htpLabelInputString| |htPage| '|filter|) - "") - (|koaPageFilterByCategory| |htPage| |functionToCall|)) - ('T - (SPADLET |filter| - (|pmTransFilter| (|dbGetInputString| |htPage|))) - (SPADLET |which| (|htpProperty| |htPage| '|which|)) - (SPADLET |opAlist| - (PROG (G167180) - (SPADLET G167180 NIL) - (RETURN - (DO ((G167186 - (|htpProperty| |htPage| '|opAlist|) - (CDR G167186)) - (|x| NIL)) - ((OR (ATOM G167186) - (PROGN - (SETQ |x| (CAR G167186)) - NIL)) - (NREVERSE0 G167180)) - (SEQ (EXIT (COND - ((|superMatch?| |filter| - (DOWNCASE - (STRINGIMAGE (CAR |x|)))) - (SETQ G167180 - (CONS |x| G167180)))))))))) - (|htpSetProperty| |htPage| '|opAlist| |opAlist|) - (FUNCALL |functionToCall| |htPage| NIL))))))) - -;--======================================================================= ;-- Get Constructor Documentation ;--======================================================================= ;dbConstructorDoc(conform,$op,$sig) == fn conform where @@ -196,12 +23,6 @@ ; hn sig == ; #$sig = #sig and $sig = SUBLISLIS($args,$FormalMapVariableList,sig) -(DEFUN |dbConstructorDoc,hn| (|sig|) - (declare (special |$sig| |$args|)) - (AND (BOOT-EQUAL (|#| |$sig|) (|#| |sig|)) - (BOOT-EQUAL |$sig| - (SUBLISLIS |$args| |$FormalMapVariableList| |sig|)))) - (DEFUN |dbConstructorDoc,gn| (G167206) (PROG (|op| |alist| |sig| |doc|) (declare (special |$op|))