diff --git a/changelog b/changelog index 557dd64..701d449 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090712 tpd src/axiom-website/patches.html 20090712.05.tpd.patch +20090712 tpd src/interp/Makefile remove br-util +20090712 tpd src/interp/br-con.boot merge br-util.boot +20090712 tpd src/interp/br-util.boot removed, merge with br-con 20090712 tpd src/axiom-website/patches.html 20090712.04.tpd.patch 20090712 tpd src/interp/Makefile remove br-search 20090712 tpd src/interp/br-con.boot merge br-search.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 967d21d..3a0fa2f 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1717,5 +1717,7 @@ merge br-con and br-op1
merge br-con and br-op2
20090712.04.tpd.patch merge br-con and br-search
+20090712.05.tpd.patch +merge br-con and br-util
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 1145bcc..477eefa 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -286,7 +286,6 @@ browser. These files should probably be autoloaded. BROBJS= ${AUTO}/bc-matrix.${O} \ ${AUTO}/ht-util.${O} \ ${AUTO}/br-con.${O} \ - ${AUTO}/br-util.${O} \ ${AUTO}/topics.${O} ${AUTO}/br-prof.${O} \ ${AUTO}/br-saturn.${O} @@ -431,7 +430,7 @@ DOCFILES=${DOC}/alql.boot.dvi \ ${DOC}/br-con.boot.dvi \ ${DOC}/br-prof.boot.dvi \ ${DOC}/br-saturn.boot.dvi \ - ${DOC}/br-util.boot.dvi ${DOC}/buildom.boot.dvi \ + ${DOC}/buildom.boot.dvi \ ${DOC}/category.boot.dvi ${DOC}/cattable.boot.dvi \ ${DOC}/c-doc.boot.dvi ${DOC}/cformat.boot.dvi \ ${DOC}/cfuns.lisp.dvi ${DOC}/clam.boot.dvi \ @@ -5837,55 +5836,6 @@ ${DOC}/br-con.boot.dvi: ${IN}/br-con.boot.pamphlet @ -\subsection{br-util.boot} -<>= -${AUTO}/br-util.${O}: ${OUT}/br-util.${O} - @ echo 485 making ${AUTO}/br-util.${O} from ${OUT}/br-util.${O} - @ cp ${OUT}/br-util.${O} ${AUTO} - -@ -<>= -${OUT}/br-util.${O}: ${MID}/br-util.clisp - @ echo 486 making ${OUT}/br-util.${O} from ${MID}/br-util.clisp - @ (cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/br-util.clisp"' \ - ':output-file "${OUT}/br-util.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/br-util.clisp"' \ - ':output-file "${OUT}/br-util.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/br-util.clisp: ${IN}/br-util.boot.pamphlet - @ echo 487 making ${MID}/br-util.clisp from ${IN}/br-util.boot.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/br-util.boot.pamphlet >br-util.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "br-util.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "br-util.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm br-util.boot ) - -@ -<>= -${DOC}/br-util.boot.dvi: ${IN}/br-util.boot.pamphlet - @echo 488 making ${DOC}/br-util.boot.dvi \ - from ${IN}/br-util.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/br-util.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} br-util.boot ; \ - rm -f ${DOC}/br-util.boot.pamphlet ; \ - rm -f ${DOC}/br-util.boot.tex ; \ - rm -f ${DOC}/br-util.boot ) - -@ - \subsection{br-saturn.boot} <>= ${AUTO}/br-saturn.${O}: ${OUT}/br-saturn.${O} @@ -7577,11 +7527,6 @@ clean: <> <> -<> -<> -<> -<> - <> <> <> diff --git a/src/interp/br-con.boot.pamphlet b/src/interp/br-con.boot.pamphlet index da2ca8e..c35139b 100644 --- a/src/interp/br-con.boot.pamphlet +++ b/src/interp/br-con.boot.pamphlet @@ -5224,7 +5224,681 @@ dbUnpatchLines lines == --concatenate long lines together, skip blank lines -- following call to NREVERSE needed to keep lines properly sorted NREVERSE acc ------> added by BMT 12/95 +--====================> WAS b-util.boot <================================ +--======================================================================= +-- AXIOM Browser +-- Initial entry is from man0.ht page to one of these functions: +-- kSearch (cSearch, dSearch, or pSearch), for constructors +-- oSearch, for operations +-- aSearch, for attributes +-- aokSearch, for general search +-- docSearch, for documentation search +-- genSearch, for complete search +--======================================================================= + +browserAutoloadOnceTrigger() == nil + +----------------------> Global Variables <----------------------- +$includeUnexposed? := true --default setting +$tick := char '_` --field separator for database files +$charUnderscore := ('__) --needed because of parser bug +$wild1 := '"[^`]*" --phrase used to convert keys to grep strings +$browseCountThreshold := 10 --the maximum number of names that will display + --on a general search +$opDescriptionThreshold := 4 --if <= 4 operations with unique name, give desc + --otherwise, give signatures +$browseMixedCase := true --distinquish case in the browser? +$docTable := nil --cache for documentation table +$conArgstrings := nil --bound by conPage so that kPage + --will display arguments if given +$conformsAreDomains := false --are all arguments of a constructor given? +$returnNowhereFromGoGet := false --special branch out for goget for browser +$dbDataFunctionAlist := nil --set by dbGatherData +$domain := nil --bound in koOps +$infovec := nil --bound in koOps +$predvec := nil --bound in koOps +$exposedOnlyIfTrue := nil --see repeatSearch, dbShowOps, dbShowCon +$bcMultipleNames := nil --see bcNameConTable +$bcConformBincount := nil --see bcConform1 +$docTableHash := MAKE_-HASHTABLE 'EQUAL --see dbExpandOpAlistIfNecessary +$groupChoice := nil --see dbShowOperationsFromConform + +------------------> Initial Settings <--------------------- +$pmFilterDelimiters := [char '_(,char '_),char '_ ] +$dbKindAlist := + [[char 'a,:'"attribute"],[char 'o,:'"operation"], + [char 'd,:'"domain"],[char 'p,:'"package"], + [char 'c,:'"category"],[char 'x,:'"default_ package"]] +$OpViewTable := '( + (names "Name" "Names" dbShowOpNames) + (documentation "Name" "Names" dbShowOpDocumentation) + (domains "Domain" "Domains" dbShowOpDomains) + (signatures "Signature" "Signatures" dbShowOpSignatures) + (parameters "Form" "Forms" dbShowOpParameters) + (origins "Origin" "Origins" dbShowOpOrigins) + (implementation nil "Implementation Domains" dbShowOpImplementations) + (conditions "Condition" "Conditions" dbShowOpConditions)) + +bcBlankLine() == bcHt '"\vspace{1}\newline " + +pluralize k == + k = '"child" => '"children" + k = '"category" => '"categories" + k = '"entry" => '"entries" + STRCONC(k,'"s") + +capitalize s == + LASSOC(s,'( + ("domain" . "Domain") + ("category" . "Category") + ("package" . "Package") + ("default package" . "Default Package"))) or + res := COPY_-SEQ s + SETELT(res,0,UPCASE res.0) + res + +escapeSpecialIds u == --very expensive function + x := LASSOC(u,$htCharAlist) => [x] + #u = 1 => + member(u, $htSpecialChars) => [CONCAT('"_\", u)] + [u] + c := char u.0 + or/[c = char y for y in $htSpecialChars] => + [CONCAT('"_\",u)] + [u] + +escapeString com == --this makes changes on single comment lines +-- was htexCom + look := 0 + while look repeat + look >= SIZE com => look := [] + + + look := STRPOSL ('"${}#%", com, look, []) + if look then + com := RPLACSTR (com,look,0,'"\") --note RPLACSTR copies!!! + look := look + 2 + com + +htPred2English(x,:options) == + $emList :local := IFCAR options --list of identifiers to be emphasised + $precList: local := '((OR 10 . "or") (AND 9 . "and") + (_< 5) (_<_= 5) (_> 5) (_>_= 5) (_= 5) (_^_= 5) (or 10) (and 9)) + fn(x,100) where + fn(x,prec) == + x is [op,:l] => + LASSOC(op,$precList) is [iprec,:rename] => + if iprec > prec then htSay '"(" + fn(first l,iprec) + for y in rest l repeat + htSay('" ",rename or op,'" ") + fn(y,iprec) + if iprec > prec then htSay '")" + if prec < 5 then htSay '"(" + gn(x,op,l,prec) + if prec < 5 then htSay '")" + x = 'etc => htSay '"..." + IDENTP x and not MEMQ(x,$emList) => htSay escapeSpecialIds PNAME x + htSay form2HtString(x,$emList) + gn(x,op,l,prec) == + MEMQ(op,'(NOT not)) => + htSay('"not ") + fn(first l,0) + op = 'HasCategory => + bcConform(first l,$emList) + htSay('" has ") + bcConform(CADADR l,$emList) + op = 'HasAttribute => + bcConform(first l,$emList) + htSay('" has ") + fnAttr CADADR l + MEMQ(op,'(has ofCategory)) => + bcConform(first l,$emList) + htSay('" has ") + [a,b] := l + b is ['ATTRIBUTE,c] and not constructor? c => fnAttr c + bcConform(b, $emList) + bcConform(x,$emList) + fnAttr c == + s := form2HtString c + MEMBER(s,$emList) => htSay('"{\em ",s,'"}") + satDownLink(s, ['"(|aPage| '|",s,'"|)"]) + +unMkEvalable u == + u is ['QUOTE,a] => a + u is ['LIST,:r] => [unMkEvalable x for x in r] + u + +lisp2HT u == ['"_'",:fn u] where fn u == + IDENTP u => escapeSpecialIds PNAME u + STRINGP u => escapeString u + ATOM u => systemError() + ['"_(",:"append"/[fn x for x in u],'")"] + +args2HtString(x,:options) == + null x => '"" + emList := IFCAR options + SUBSTRING(form2HtString(['f,:x],emList),1,nil) + +quickForm2HtString(x) == + atom x => STRINGIMAGE x + form2HtString x + +form2HtString(x,:options) == + $emList:local := IFCAR options --list of atoms to be emphasized + $brief: local := IFCAR IFCDR options --see dbShowOperationsFromConform (lib11) + fn(x) where + fn x == + atom x => + MEMQ(x,$FormalMapVariableList) => STRCONC('"\",STRINGIMAGE x) + u := escapeSpecialChars STRINGIMAGE x + MEMQ(x,$emList) => STRCONC('"{\em ",u,'"}") + STRINGP x => STRCONC('"_"",u,'"_"") + u + first x = 'QUOTE => STRCONC('"'",sexpr2HtString first rest x) + first x = ":" => STRCONC(fn first rest x,'": ",fn first rest rest x) + first x = 'Mapping => + STRCONC(fnTail(rest rest x,'"()"),'"->",fn first rest x) + first x = 'construct => fnTail(rest x,'"[]") + tail := fnTail(rest x,'"()") + head := fn first x +-- $brief and #head + #tail > 35 => STRCONC(head,'"(...)") + STRCONC(head,tail) + fnTail(x,str) == + null x => '"" + STRCONC(str . 0,fn first x,fnTailTail rest x,str . 1) + fnTailTail x == + null x => '"" + STRCONC('",",fn first x,fnTailTail rest x) + +sexpr2HtString x == + atom x => form2HtString x + STRCONC('"(",fn x,'")") where fn x == + r := rest x + suffix := + null r => '"" + atom r => STRCONC('" . ",form2HtString rest x) + STRCONC('" ",fn r) + STRCONC(sexpr2HtString first x,suffix) + +form2LispString(x) == + atom x => + x = '_$ => '"__$" + MEMQ(x,$FormalMapVariableList) => STRCONC(STRINGIMAGE '__, STRINGIMAGE x) + STRINGP x => STRCONC('"_"",STRINGIMAGE x,'"_"") + STRINGIMAGE x + x is ['QUOTE,a] => STRCONC('"'",sexpr2LispString a) + x is [":",a,b] => STRCONC(form2LispString a,'":",form2LispString b) + first x = 'Mapping => + null rest (r := rest x) => STRCONC('"()->",form2LispString first r) + STRCONC(args2LispString rest r,'"->",form2LispString first r) + STRCONC(form2LispString first x,args2LispString rest x) + +sexpr2LispString x == + atom x => form2LispString x + STRCONC('"(",fn x,'")") where fn x == + r := rest x + suffix := + null r => '"" + atom r => STRCONC('" . ",form2LispString rest x) + STRCONC('" ",fn r) + STRCONC(sexpr2HtString first x,suffix) + +args2LispString x == + null x => '"" + STRCONC('"(",form2LispString first x,fnTailTail rest x,'")") where + fnTailTail x == + null x => '"" + STRCONC('",",form2LispString first x,fnTailTail rest x) + +dbConstructorKind x == + target := CADAR GETDATABASE(x,'CONSTRUCTORMODEMAP) + target = '(Category) => 'category + target is ['CATEGORY,'package,:.] => 'package + HGET($defaultPackageNamesHT,x) => 'default_ package + 'domain + +getConstructorForm name == + name = 'Union => '(Union (_: a A) (_: b B)) + name = 'UntaggedUnion => '(Union A B) + name = 'Record => '(Record (_: a A) (_: b B)) + name = 'Mapping => '(Mapping T S) + name = 'Enumeration => '(Enumeration a b) + GETDATABASE(name,'CONSTRUCTORFORM) + +getConstructorArgs conname == CDR getConstructorForm conname + +htSay(x,:options) == +--if x = $charEscape then x := $charNewline else +--if x = $stringEscape then x := $stringNewline + bcHt x + for y in options repeat bcHt y + +bcComments(comments,:options) == + italics? := not IFCAR options + STRINGP comments => + comments = '"" => nil + htSay('"\newline ") + if italics? then htSay '"{\em " + htSay comments + if italics? then htSay '"}" + null comments => nil + htSay('"\newline ") + if italics? then htSay "{\em " + htSay first comments + for x in rest comments repeat htSay('" ",x) + if italics? then htSay '"}" + +bcConform(form,:options) == + $italics? : local := IFCAR options + $italicHead? : local := IFCAR IFCDR options + bcConform1 form + +bcConform1 form == main where +-----------------> OBSELETE + main == + form is ['ifp,form1,:pred] => + hd form1 + bcPred pred + hd form + hd form == + atom form => + not MEMQ(form,'(Mapping Union Record)) and null constructor? form => + s := STRINGIMAGE form + (s.0 = char '_#) and (n := POSN1(form, $FormalFunctionParameterList)) => + htSay form2HtString ($FormalMapVariableList . n) + htSay form + s := STRINGIMAGE form + $italicHead? => htSayItalics s + $bcMultipleNames => + satTypeDownLink(s, ['"(|conPageChoose| '|",s,'"|)"]) + satTypeDownLink(s, ["(|conPage| '|",s,'"|)"]) + (head := QCAR form) = 'QUOTE => + htSay('"'") + hd CADR form + head = 'SIGNATURE => + htSay(CADR form,'": ") + mapping CADDR form + head = 'Mapping and rest form => rest form => mapping rest form + head = ":" => + hd CADR form + htSay '": " + hd CADDR form + QCDR form and dbEvalableConstructor? form + => bcConstructor(form,head) + hd head + null (r := QCDR form) => nil + tl QCDR form + mapping [target,:source] == + tuple source + bcHt + $saturn => '" {\ttrarrow} " + '" -> " + hd target + tuple u == + null u => bcHt '"()" + null rest u => hd u + bcHt '"(" + hd first u + for x in rest u repeat + bcHt '"," + hd x + bcHt '")" + tl u == + bcHt '"(" + firstTime := true + for x in u repeat + if not firstTime then bcHt '"," + firstTime := false + hd x + bcHt '")" + say x == + if $italics? then bcHt '"{\em " + if x = 'etc then x := '"..." + bcHt escapeSpecialIds STRINGIMAGE x + if $italics? then bcHt '"}" + +bcConstructor(form is [op,:arglist],cname) == --called only when $conformsAreDomains + htSayList dbConformGen form + +htSayList u == + for x in u repeat htSay x + +conform2HtString form == + for u in form2String form repeat + htSay u + +dbEvalableConstructor? form == +--form is constructor form; either +--(a) all arguments are specified or (b) none are specified + form is [op,:argl] => + null argl => true + op = 'QUOTE => 'T --is a domain valued object + and/[dbEvalableConstructor? x for x in argl] + INTEGERP form => true + false + +htSayItalics s == htSay('"{\em ",s,'"}") + +bcCon(name,:options) == + argString := IFCAR options or '"" + s := STRINGIMAGE name + bcStar name + htSayConstructorName(s,s) + htSay argString + +bcAbb(name,abb) == + s := STRINGIMAGE name + a := STRINGIMAGE abb + bcStar name + htSayConstructorName(a,s) + +bcStar name == + if $includeUnexposed? and not isExposedConstructor name then htSayUnexposed() + +bcStarSpace name == + null $includeUnexposed? => nil + not isExposedConstructor name => htSayUnexposed() + htBlank() + +bcStarSpaceOp(op,exposed?) == + null $includeUnexposed? => nil + not exposed? => + htSayUnexposed() + if op.0 = char '_* then htSay '" " + htBlank() + +bcStarConform form == + bcStar opOf form + bcConform form + +dbSourceFile name == + u:= GETDATABASE(name,'SOURCEFILE) + null u => '"" + n := PATHNAME_-NAME u + t := PATHNAME_-TYPE u + STRCONC(n,'".",t) + +asharpConstructorName? name == + u:= GETDATABASE(name,'SOURCEFILE) + u and PATHNAME_-TYPE u = '"as" + +asharpConstructors() == + [x for x in allConstructors() | not asharpConstructorName? x] + +extractFileNameFromPath s == fn(s,0,#s) where + fn(s,i,m) == + k := charPosition(char '_/,s,i) + k = m => SUBSTRING(s,i,nil) + fn(s,k + 1,m) + +bcOpTable(u,fn) == + htBeginTable() + firstTime := true + for op in u for i in 0.. repeat + if firstTime then firstTime := false + else htSaySaturn '"&" + htSay '"{" + htMakePage [['bcLinks,[escapeSpecialChars STRINGIMAGE opOf op,'"",fn,i]]] + htSay '"}" + htEndTable() + +bcNameConTable u == + $bcMultipleNames: local := (#u ^= 1) + bcConTable REMDUP u + -- bcConTable u + +bcConTable u == + htBeginTable() + firstTime := true + for con in u repeat + if firstTime then firstTime := false + else htSaySaturn '"&" + htSay '"{" + bcStarSpace opOf con + bcConform con + htSay '"}" + htEndTable() + +bcAbbTable u == + htBeginTable() + firstTime := true + for x in REMDUP u repeat --allow x to be NIL meaning "no abbreviation" + -- for x in u repeat --allow x to be NIL meaning "no abbreviation" + if firstTime then firstTime := false + else htSaySaturn '"&" + if x is [con,abb,:.] then + htSay '"{" + bcAbb(con,abb) + htSay '"}" + htEndTable() + +bcConPredTable(u,conname,:options) == + italicList := IFCAR options + htBeginTable() + firstTime := true + for [conform,:pred] in u repeat + if firstTime then firstTime := false + else htSaySaturn '"&" + htSay '"{" + bcStarSpace opOf conform + form := + atom conform => getConstructorForm conform + conform + bcConform(form,italicList) + if extractHasArgs pred is [arglist,:pred] then + htSay('" {\em of} ") + bcConform([conname,:arglist],italicList,true) + if pred ^= 'etc then bcPred(pred,italicList) + htSay '"}" + htEndTable() + +bcPred(pred,:options) == + pred = '"" or pred = true or null pred => 'skip + italicList := IFCAR options + if not IFCAR IFCDR options then htSay '" {\em if} " + htPred2English(pred,italicList) + +extractHasArgs pred == + x := find pred or return nil where find x == + x is [op,:argl] => + op = 'hasArgs => x + MEMQ(op,'(AND OR NOT)) => or/[find y for y in argl] + nil + nil + [rest x,:simpBool SUBST('T,x,pred)] + +splitConTable cons == + uncond := cond := nil + for (pair := [con,:pred]) in cons repeat + null pred => 'skip + pred = 'T or pred is ['hasArgs,:.] => uncond := [pair,:uncond] + cond := [pair,:cond] + [NREVERSE uncond,:NREVERSE cond] + +bcNameTable(u,fn,:option) == --option if * prefix + htSay '"\newline" + htBeginTable() + firstTime := true + for x in u repeat + if firstTime then firstTime := false + else htSaySaturn '"&" + htSay '"{" + if IFCAR option then bcStar x + htMakePage [['bcLinks,[s := escapeSpecialChars STRINGIMAGE x,'"",fn,s]]] + htSay '"}" + htEndTable() + +bcNameCountTable(u,fn,gn,:options) == + linkFunction := + IFCAR options => 'bcLispLinks + 'bcLinks + htSay '"\newline" + htBeginTable() + firstTime := true + for i in 0.. for x in u repeat + if firstTime then firstTime := false + else htSaySaturn '"&" + htSay '"{" + htMakePage [[linkFunction,[FUNCALL(fn,x),'"",gn,i]]] + htSay '"}" + htEndTable() + +dbSayItemsItalics(:u) == + htSay '"{\em " + APPLY(function dbSayItems,u) + htSay '"}" + +dbSayItems(countOrPrefix,singular,plural,:options) == + bcHt '"\newline " + count := + countOrPrefix is [:prefix,c] => + htSay prefix + c + countOrPrefix + if count = 0 then htSay('"No ",singular) + else if count = 1 then htSay('"1 ",singular) + else htSay(count,'" ",plural) + for x in options repeat bcHt x + if count ^= 0 then bcHt '":" + +dbBasicConstructor? conname == MEMBER(dbSourceFile conname,'("catdef" "coerce")) + +nothingFoundPage(:options) == + htInitPage('"Sorry, no match found",nil) + htShowPage() + +htCopyProplist htPage == [[x,:y] for [x,:y] in htpPropertyList htPage] + +dbInfovec name == + 'category = GETDATABASE(name,'CONSTRUCTORKIND) => nil + GETDATABASE(name, 'ASHARP?) => nil + loadLibIfNotLoaded(name) + u := GET(name,'infovec) => u + +emptySearchPage(kind,filter,:options) == + skipNamePart := IFCAR options + heading := ['"No ",capitalize kind,'" Found"] + htInitPage(heading,nil) + exposePart := + null $includeUnexposed? => '"{\em exposed} " + '"" + htSay('"\vspace{1}\newline\centerline{There is no ",exposePart,kind,'" matching pattern}\newline\centerline{{\em ") + if filter then htPred2English filter + htSay '"}}" + htShowPage() + +isLoaded? conform == GET(constructor? opOf conform,'LOADED) + +string2Integer s == + and/[DIGIT_-CHAR_-P (s.i) for i in 0..MAXINDEX s] => PARSE_-INTEGER s + nil + +dbGetInputString htPage == + s := htpLabelInputString(htPage,'filter) + null s or s = '"" => '"*" + s + + + +--======================================================================= +-- Error Pages +--======================================================================= +bcErrorPage u == + u is ['error,:r] => + htInitPage(first r,nil) + bcBlankLine() + for x in rest r repeat htSay x + htShowPage() + systemError '"Unexpected error message" + +errorPage(htPage,[heading,kind,:info]) == + kind = 'invalidType => kInvalidTypePage first info + if heading = 'error then htInitPage('"Error",nil) else + htInitPage(heading,nil) + bcBlankLine() + for x in info repeat htSay x + htShowPage() + +htErrorStar() == + errorPage(nil,['"{\em *} not a valid search string",nil,'"\vspace{3}\centerline{{\em *} is not a valid search string for a general search}\centerline{\em {it would match everything!}}"]) + +htQueryPage(htPage,heading,message,query,fn) == + htInitPage(heading,nil) + htSay message + htQuery(query,fn) + htShowPage() + +htQuery(question,fn,:options) == + upLink? := IFCAR options + if question then + htSay('"\vspace{1}\centerline{") + htSay question + htSay('"}") + htSay('"\centerline{") + htMakePage [['bcLispLinks,['"\fbox{Yes}",'"",fn,'yes]]] + htBlank 4 + if upLink? + then htSay('"\downlink{\fbox{No}}{UpPage}") + else htMakePage [['bcLispLinks,['"\fbox{No}",'"",fn,'no]]] + htSay('"}") + +kInvalidTypePage form == + htInitPage('"Error",nil) + bcBlankLine() + htSay('"\centerline{You gave an invalid type:}\newline\centerline{{\sf ") + htSay(form2HtString form,'"}}") + htShowPage() + +dbNotAvailablePage(:options) == + htInitPage('"Missing Page",nil) + bcBlankLine() + htSay(IFCAR options or '"\centerline{This page is not available yet}") + htShowPage() + +--======================================================================= +-- Utility Functions for Manipulating Browse Datalines +--======================================================================= +dbpHasDefaultCategory? s == #s > 1 and s.1 = char 'x --s is part 3 of line + +dbKind line == line.0 + +dbKindString kind == LASSOC(kind,$dbKindAlist) + +dbName line == escapeString SUBSTRING(line,1,charPosition($tick,line,1) - 1) + +dbAttr line == STRCONC(dbName line,escapeString dbPart(line,4,0)) + +dbPart(line,n,k) == --returns part n of line (n=1,..) beginning in column k + n = 1 => SUBSTRING(line,k + 1,charPosition($tick,line,k + 1) - k - 1) + dbPart(line,n - 1,charPosition($tick,line,k + 1)) + +dbXParts(line,n,m) == + [.,nargs,:r] := dbParts(line,n,m) + [dbKindString line.0,dbName line,PARSE_-INTEGER nargs,:r] + +dbParts(line,n,m) == --split line into n parts beginning in column m + n = 0 => nil + [SUBSTRING(line,m,-m + (k := charPosition($tick,line,m))), + :dbParts(line,n - 1,k + 1)] + +dbConname(line) == dbPart(line,5,1) + +dbComments line == dbReadComments(string2Integer dbPart(line,7,1)) + +dbNewConname(line) == --dbName line unless kind is 'a or 'o => name in 5th pos. + (kind := line.0) = char 'a or kind = char 'o => + conform := dbPart(line,5,1) + k := charPosition(char '_(,conform,1) + SUBSTRING(conform,1,k - 1) + dbName line + +dbTickIndex(line,n,k) == --returns index of nth tick in line starting at k + n = 1 => charPosition($tick,line,k) + dbTickIndex(line,n - 1,1 + charPosition($tick,line,k)) + +mySort u == listSort(function GLESSEQP,u) @ diff --git a/src/interp/br-util.boot.pamphlet b/src/interp/br-util.boot.pamphlet deleted file mode 100644 index aa6f9cd..0000000 --- a/src/interp/br-util.boot.pamphlet +++ /dev/null @@ -1,734 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp br-util.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF 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 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 --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - ---====================> WAS b-util.boot <================================ - ---======================================================================= --- AXIOM Browser --- Initial entry is from man0.ht page to one of these functions: --- kSearch (cSearch, dSearch, or pSearch), for constructors --- oSearch, for operations --- aSearch, for attributes --- aokSearch, for general search --- docSearch, for documentation search --- genSearch, for complete search ---======================================================================= - -browserAutoloadOnceTrigger() == nil - -----------------------> Global Variables <----------------------- -$includeUnexposed? := true --default setting -$tick := char '_` --field separator for database files -$charUnderscore := ('__) --needed because of parser bug -$wild1 := '"[^`]*" --phrase used to convert keys to grep strings -$browseCountThreshold := 10 --the maximum number of names that will display - --on a general search -$opDescriptionThreshold := 4 --if <= 4 operations with unique name, give desc - --otherwise, give signatures -$browseMixedCase := true --distinquish case in the browser? -$docTable := nil --cache for documentation table -$conArgstrings := nil --bound by conPage so that kPage - --will display arguments if given -$conformsAreDomains := false --are all arguments of a constructor given? -$returnNowhereFromGoGet := false --special branch out for goget for browser -$dbDataFunctionAlist := nil --set by dbGatherData -$domain := nil --bound in koOps -$infovec := nil --bound in koOps -$predvec := nil --bound in koOps -$exposedOnlyIfTrue := nil --see repeatSearch, dbShowOps, dbShowCon -$bcMultipleNames := nil --see bcNameConTable -$bcConformBincount := nil --see bcConform1 -$docTableHash := MAKE_-HASHTABLE 'EQUAL --see dbExpandOpAlistIfNecessary -$groupChoice := nil --see dbShowOperationsFromConform - -------------------> Initial Settings <--------------------- -$pmFilterDelimiters := [char '_(,char '_),char '_ ] -$dbKindAlist := - [[char 'a,:'"attribute"],[char 'o,:'"operation"], - [char 'd,:'"domain"],[char 'p,:'"package"], - [char 'c,:'"category"],[char 'x,:'"default_ package"]] -$OpViewTable := '( - (names "Name" "Names" dbShowOpNames) - (documentation "Name" "Names" dbShowOpDocumentation) - (domains "Domain" "Domains" dbShowOpDomains) - (signatures "Signature" "Signatures" dbShowOpSignatures) - (parameters "Form" "Forms" dbShowOpParameters) - (origins "Origin" "Origins" dbShowOpOrigins) - (implementation nil "Implementation Domains" dbShowOpImplementations) - (conditions "Condition" "Conditions" dbShowOpConditions)) - -bcBlankLine() == bcHt '"\vspace{1}\newline " - -pluralize k == - k = '"child" => '"children" - k = '"category" => '"categories" - k = '"entry" => '"entries" - STRCONC(k,'"s") - -capitalize s == - LASSOC(s,'( - ("domain" . "Domain") - ("category" . "Category") - ("package" . "Package") - ("default package" . "Default Package"))) or - res := COPY_-SEQ s - SETELT(res,0,UPCASE res.0) - res - -escapeSpecialIds u == --very expensive function - x := LASSOC(u,$htCharAlist) => [x] - #u = 1 => - member(u, $htSpecialChars) => [CONCAT('"_\", u)] - [u] - c := char u.0 - or/[c = char y for y in $htSpecialChars] => - [CONCAT('"_\",u)] - [u] - -escapeString com == --this makes changes on single comment lines --- was htexCom - look := 0 - while look repeat - look >= SIZE com => look := [] - - - look := STRPOSL ('"${}#%", com, look, []) - if look then - com := RPLACSTR (com,look,0,'"\") --note RPLACSTR copies!!! - look := look + 2 - com - -htPred2English(x,:options) == - $emList :local := IFCAR options --list of identifiers to be emphasised - $precList: local := '((OR 10 . "or") (AND 9 . "and") - (_< 5) (_<_= 5) (_> 5) (_>_= 5) (_= 5) (_^_= 5) (or 10) (and 9)) - fn(x,100) where - fn(x,prec) == - x is [op,:l] => - LASSOC(op,$precList) is [iprec,:rename] => - if iprec > prec then htSay '"(" - fn(first l,iprec) - for y in rest l repeat - htSay('" ",rename or op,'" ") - fn(y,iprec) - if iprec > prec then htSay '")" - if prec < 5 then htSay '"(" - gn(x,op,l,prec) - if prec < 5 then htSay '")" - x = 'etc => htSay '"..." - IDENTP x and not MEMQ(x,$emList) => htSay escapeSpecialIds PNAME x - htSay form2HtString(x,$emList) - gn(x,op,l,prec) == - MEMQ(op,'(NOT not)) => - htSay('"not ") - fn(first l,0) - op = 'HasCategory => - bcConform(first l,$emList) - htSay('" has ") - bcConform(CADADR l,$emList) - op = 'HasAttribute => - bcConform(first l,$emList) - htSay('" has ") - fnAttr CADADR l - MEMQ(op,'(has ofCategory)) => - bcConform(first l,$emList) - htSay('" has ") - [a,b] := l - b is ['ATTRIBUTE,c] and not constructor? c => fnAttr c - bcConform(b, $emList) - bcConform(x,$emList) - fnAttr c == - s := form2HtString c - MEMBER(s,$emList) => htSay('"{\em ",s,'"}") - satDownLink(s, ['"(|aPage| '|",s,'"|)"]) - -unMkEvalable u == - u is ['QUOTE,a] => a - u is ['LIST,:r] => [unMkEvalable x for x in r] - u - -lisp2HT u == ['"_'",:fn u] where fn u == - IDENTP u => escapeSpecialIds PNAME u - STRINGP u => escapeString u - ATOM u => systemError() - ['"_(",:"append"/[fn x for x in u],'")"] - -args2HtString(x,:options) == - null x => '"" - emList := IFCAR options - SUBSTRING(form2HtString(['f,:x],emList),1,nil) - -quickForm2HtString(x) == - atom x => STRINGIMAGE x - form2HtString x - -form2HtString(x,:options) == - $emList:local := IFCAR options --list of atoms to be emphasized - $brief: local := IFCAR IFCDR options --see dbShowOperationsFromConform (lib11) - fn(x) where - fn x == - atom x => - MEMQ(x,$FormalMapVariableList) => STRCONC('"\",STRINGIMAGE x) - u := escapeSpecialChars STRINGIMAGE x - MEMQ(x,$emList) => STRCONC('"{\em ",u,'"}") - STRINGP x => STRCONC('"_"",u,'"_"") - u - first x = 'QUOTE => STRCONC('"'",sexpr2HtString first rest x) - first x = ":" => STRCONC(fn first rest x,'": ",fn first rest rest x) - first x = 'Mapping => - STRCONC(fnTail(rest rest x,'"()"),'"->",fn first rest x) - first x = 'construct => fnTail(rest x,'"[]") - tail := fnTail(rest x,'"()") - head := fn first x --- $brief and #head + #tail > 35 => STRCONC(head,'"(...)") - STRCONC(head,tail) - fnTail(x,str) == - null x => '"" - STRCONC(str . 0,fn first x,fnTailTail rest x,str . 1) - fnTailTail x == - null x => '"" - STRCONC('",",fn first x,fnTailTail rest x) - -sexpr2HtString x == - atom x => form2HtString x - STRCONC('"(",fn x,'")") where fn x == - r := rest x - suffix := - null r => '"" - atom r => STRCONC('" . ",form2HtString rest x) - STRCONC('" ",fn r) - STRCONC(sexpr2HtString first x,suffix) - -form2LispString(x) == - atom x => - x = '_$ => '"__$" - MEMQ(x,$FormalMapVariableList) => STRCONC(STRINGIMAGE '__, STRINGIMAGE x) - STRINGP x => STRCONC('"_"",STRINGIMAGE x,'"_"") - STRINGIMAGE x - x is ['QUOTE,a] => STRCONC('"'",sexpr2LispString a) - x is [":",a,b] => STRCONC(form2LispString a,'":",form2LispString b) - first x = 'Mapping => - null rest (r := rest x) => STRCONC('"()->",form2LispString first r) - STRCONC(args2LispString rest r,'"->",form2LispString first r) - STRCONC(form2LispString first x,args2LispString rest x) - -sexpr2LispString x == - atom x => form2LispString x - STRCONC('"(",fn x,'")") where fn x == - r := rest x - suffix := - null r => '"" - atom r => STRCONC('" . ",form2LispString rest x) - STRCONC('" ",fn r) - STRCONC(sexpr2HtString first x,suffix) - -args2LispString x == - null x => '"" - STRCONC('"(",form2LispString first x,fnTailTail rest x,'")") where - fnTailTail x == - null x => '"" - STRCONC('",",form2LispString first x,fnTailTail rest x) - -dbConstructorKind x == - target := CADAR GETDATABASE(x,'CONSTRUCTORMODEMAP) - target = '(Category) => 'category - target is ['CATEGORY,'package,:.] => 'package - HGET($defaultPackageNamesHT,x) => 'default_ package - 'domain - -getConstructorForm name == - name = 'Union => '(Union (_: a A) (_: b B)) - name = 'UntaggedUnion => '(Union A B) - name = 'Record => '(Record (_: a A) (_: b B)) - name = 'Mapping => '(Mapping T S) - name = 'Enumeration => '(Enumeration a b) - GETDATABASE(name,'CONSTRUCTORFORM) - -getConstructorArgs conname == CDR getConstructorForm conname - -htSay(x,:options) == ---if x = $charEscape then x := $charNewline else ---if x = $stringEscape then x := $stringNewline - bcHt x - for y in options repeat bcHt y - -bcComments(comments,:options) == - italics? := not IFCAR options - STRINGP comments => - comments = '"" => nil - htSay('"\newline ") - if italics? then htSay '"{\em " - htSay comments - if italics? then htSay '"}" - null comments => nil - htSay('"\newline ") - if italics? then htSay "{\em " - htSay first comments - for x in rest comments repeat htSay('" ",x) - if italics? then htSay '"}" - -bcConform(form,:options) == - $italics? : local := IFCAR options - $italicHead? : local := IFCAR IFCDR options - bcConform1 form - -bcConform1 form == main where ------------------> OBSELETE - main == - form is ['ifp,form1,:pred] => - hd form1 - bcPred pred - hd form - hd form == - atom form => - not MEMQ(form,'(Mapping Union Record)) and null constructor? form => - s := STRINGIMAGE form - (s.0 = char '_#) and (n := POSN1(form, $FormalFunctionParameterList)) => - htSay form2HtString ($FormalMapVariableList . n) - htSay form - s := STRINGIMAGE form - $italicHead? => htSayItalics s - $bcMultipleNames => - satTypeDownLink(s, ['"(|conPageChoose| '|",s,'"|)"]) - satTypeDownLink(s, ["(|conPage| '|",s,'"|)"]) - (head := QCAR form) = 'QUOTE => - htSay('"'") - hd CADR form - head = 'SIGNATURE => - htSay(CADR form,'": ") - mapping CADDR form - head = 'Mapping and rest form => rest form => mapping rest form - head = ":" => - hd CADR form - htSay '": " - hd CADDR form - QCDR form and dbEvalableConstructor? form - => bcConstructor(form,head) - hd head - null (r := QCDR form) => nil - tl QCDR form - mapping [target,:source] == - tuple source - bcHt - $saturn => '" {\ttrarrow} " - '" -> " - hd target - tuple u == - null u => bcHt '"()" - null rest u => hd u - bcHt '"(" - hd first u - for x in rest u repeat - bcHt '"," - hd x - bcHt '")" - tl u == - bcHt '"(" - firstTime := true - for x in u repeat - if not firstTime then bcHt '"," - firstTime := false - hd x - bcHt '")" - say x == - if $italics? then bcHt '"{\em " - if x = 'etc then x := '"..." - bcHt escapeSpecialIds STRINGIMAGE x - if $italics? then bcHt '"}" - -bcConstructor(form is [op,:arglist],cname) == --called only when $conformsAreDomains - htSayList dbConformGen form - -htSayList u == - for x in u repeat htSay x - -conform2HtString form == - for u in form2String form repeat - htSay u - -dbEvalableConstructor? form == ---form is constructor form; either ---(a) all arguments are specified or (b) none are specified - form is [op,:argl] => - null argl => true - op = 'QUOTE => 'T --is a domain valued object - and/[dbEvalableConstructor? x for x in argl] - INTEGERP form => true - false - -htSayItalics s == htSay('"{\em ",s,'"}") - -bcCon(name,:options) == - argString := IFCAR options or '"" - s := STRINGIMAGE name - bcStar name - htSayConstructorName(s,s) - htSay argString - -bcAbb(name,abb) == - s := STRINGIMAGE name - a := STRINGIMAGE abb - bcStar name - htSayConstructorName(a,s) - -bcStar name == - if $includeUnexposed? and not isExposedConstructor name then htSayUnexposed() - -bcStarSpace name == - null $includeUnexposed? => nil - not isExposedConstructor name => htSayUnexposed() - htBlank() - -bcStarSpaceOp(op,exposed?) == - null $includeUnexposed? => nil - not exposed? => - htSayUnexposed() - if op.0 = char '_* then htSay '" " - htBlank() - -bcStarConform form == - bcStar opOf form - bcConform form - -dbSourceFile name == - u:= GETDATABASE(name,'SOURCEFILE) - null u => '"" - n := PATHNAME_-NAME u - t := PATHNAME_-TYPE u - STRCONC(n,'".",t) - -asharpConstructorName? name == - u:= GETDATABASE(name,'SOURCEFILE) - u and PATHNAME_-TYPE u = '"as" - -asharpConstructors() == - [x for x in allConstructors() | not asharpConstructorName? x] - -extractFileNameFromPath s == fn(s,0,#s) where - fn(s,i,m) == - k := charPosition(char '_/,s,i) - k = m => SUBSTRING(s,i,nil) - fn(s,k + 1,m) - -bcOpTable(u,fn) == - htBeginTable() - firstTime := true - for op in u for i in 0.. repeat - if firstTime then firstTime := false - else htSaySaturn '"&" - htSay '"{" - htMakePage [['bcLinks,[escapeSpecialChars STRINGIMAGE opOf op,'"",fn,i]]] - htSay '"}" - htEndTable() - -bcNameConTable u == - $bcMultipleNames: local := (#u ^= 1) - bcConTable REMDUP u - -- bcConTable u - -bcConTable u == - htBeginTable() - firstTime := true - for con in u repeat - if firstTime then firstTime := false - else htSaySaturn '"&" - htSay '"{" - bcStarSpace opOf con - bcConform con - htSay '"}" - htEndTable() - -bcAbbTable u == - htBeginTable() - firstTime := true - for x in REMDUP u repeat --allow x to be NIL meaning "no abbreviation" - -- for x in u repeat --allow x to be NIL meaning "no abbreviation" - if firstTime then firstTime := false - else htSaySaturn '"&" - if x is [con,abb,:.] then - htSay '"{" - bcAbb(con,abb) - htSay '"}" - htEndTable() - -bcConPredTable(u,conname,:options) == - italicList := IFCAR options - htBeginTable() - firstTime := true - for [conform,:pred] in u repeat - if firstTime then firstTime := false - else htSaySaturn '"&" - htSay '"{" - bcStarSpace opOf conform - form := - atom conform => getConstructorForm conform - conform - bcConform(form,italicList) - if extractHasArgs pred is [arglist,:pred] then - htSay('" {\em of} ") - bcConform([conname,:arglist],italicList,true) - if pred ^= 'etc then bcPred(pred,italicList) - htSay '"}" - htEndTable() - -bcPred(pred,:options) == - pred = '"" or pred = true or null pred => 'skip - italicList := IFCAR options - if not IFCAR IFCDR options then htSay '" {\em if} " - htPred2English(pred,italicList) - -extractHasArgs pred == - x := find pred or return nil where find x == - x is [op,:argl] => - op = 'hasArgs => x - MEMQ(op,'(AND OR NOT)) => or/[find y for y in argl] - nil - nil - [rest x,:simpBool SUBST('T,x,pred)] - -splitConTable cons == - uncond := cond := nil - for (pair := [con,:pred]) in cons repeat - null pred => 'skip - pred = 'T or pred is ['hasArgs,:.] => uncond := [pair,:uncond] - cond := [pair,:cond] - [NREVERSE uncond,:NREVERSE cond] - -bcNameTable(u,fn,:option) == --option if * prefix - htSay '"\newline" - htBeginTable() - firstTime := true - for x in u repeat - if firstTime then firstTime := false - else htSaySaturn '"&" - htSay '"{" - if IFCAR option then bcStar x - htMakePage [['bcLinks,[s := escapeSpecialChars STRINGIMAGE x,'"",fn,s]]] - htSay '"}" - htEndTable() - -bcNameCountTable(u,fn,gn,:options) == - linkFunction := - IFCAR options => 'bcLispLinks - 'bcLinks - htSay '"\newline" - htBeginTable() - firstTime := true - for i in 0.. for x in u repeat - if firstTime then firstTime := false - else htSaySaturn '"&" - htSay '"{" - htMakePage [[linkFunction,[FUNCALL(fn,x),'"",gn,i]]] - htSay '"}" - htEndTable() - -dbSayItemsItalics(:u) == - htSay '"{\em " - APPLY(function dbSayItems,u) - htSay '"}" - -dbSayItems(countOrPrefix,singular,plural,:options) == - bcHt '"\newline " - count := - countOrPrefix is [:prefix,c] => - htSay prefix - c - countOrPrefix - if count = 0 then htSay('"No ",singular) - else if count = 1 then htSay('"1 ",singular) - else htSay(count,'" ",plural) - for x in options repeat bcHt x - if count ^= 0 then bcHt '":" - -dbBasicConstructor? conname == MEMBER(dbSourceFile conname,'("catdef" "coerce")) - -nothingFoundPage(:options) == - htInitPage('"Sorry, no match found",nil) - htShowPage() - -htCopyProplist htPage == [[x,:y] for [x,:y] in htpPropertyList htPage] - -dbInfovec name == - 'category = GETDATABASE(name,'CONSTRUCTORKIND) => nil - GETDATABASE(name, 'ASHARP?) => nil - loadLibIfNotLoaded(name) - u := GET(name,'infovec) => u - -emptySearchPage(kind,filter,:options) == - skipNamePart := IFCAR options - heading := ['"No ",capitalize kind,'" Found"] - htInitPage(heading,nil) - exposePart := - null $includeUnexposed? => '"{\em exposed} " - '"" - htSay('"\vspace{1}\newline\centerline{There is no ",exposePart,kind,'" matching pattern}\newline\centerline{{\em ") - if filter then htPred2English filter - htSay '"}}" - htShowPage() - -isLoaded? conform == GET(constructor? opOf conform,'LOADED) - -string2Integer s == - and/[DIGIT_-CHAR_-P (s.i) for i in 0..MAXINDEX s] => PARSE_-INTEGER s - nil - -dbGetInputString htPage == - s := htpLabelInputString(htPage,'filter) - null s or s = '"" => '"*" - s - - - ---======================================================================= --- Error Pages ---======================================================================= -bcErrorPage u == - u is ['error,:r] => - htInitPage(first r,nil) - bcBlankLine() - for x in rest r repeat htSay x - htShowPage() - systemError '"Unexpected error message" - -errorPage(htPage,[heading,kind,:info]) == - kind = 'invalidType => kInvalidTypePage first info - if heading = 'error then htInitPage('"Error",nil) else - htInitPage(heading,nil) - bcBlankLine() - for x in info repeat htSay x - htShowPage() - -htErrorStar() == - errorPage(nil,['"{\em *} not a valid search string",nil,'"\vspace{3}\centerline{{\em *} is not a valid search string for a general search}\centerline{\em {it would match everything!}}"]) - -htQueryPage(htPage,heading,message,query,fn) == - htInitPage(heading,nil) - htSay message - htQuery(query,fn) - htShowPage() - -htQuery(question,fn,:options) == - upLink? := IFCAR options - if question then - htSay('"\vspace{1}\centerline{") - htSay question - htSay('"}") - htSay('"\centerline{") - htMakePage [['bcLispLinks,['"\fbox{Yes}",'"",fn,'yes]]] - htBlank 4 - if upLink? - then htSay('"\downlink{\fbox{No}}{UpPage}") - else htMakePage [['bcLispLinks,['"\fbox{No}",'"",fn,'no]]] - htSay('"}") - -kInvalidTypePage form == - htInitPage('"Error",nil) - bcBlankLine() - htSay('"\centerline{You gave an invalid type:}\newline\centerline{{\sf ") - htSay(form2HtString form,'"}}") - htShowPage() - -dbNotAvailablePage(:options) == - htInitPage('"Missing Page",nil) - bcBlankLine() - htSay(IFCAR options or '"\centerline{This page is not available yet}") - htShowPage() - ---======================================================================= --- Utility Functions for Manipulating Browse Datalines ---======================================================================= -dbpHasDefaultCategory? s == #s > 1 and s.1 = char 'x --s is part 3 of line - -dbKind line == line.0 - -dbKindString kind == LASSOC(kind,$dbKindAlist) - -dbName line == escapeString SUBSTRING(line,1,charPosition($tick,line,1) - 1) - -dbAttr line == STRCONC(dbName line,escapeString dbPart(line,4,0)) - -dbPart(line,n,k) == --returns part n of line (n=1,..) beginning in column k - n = 1 => SUBSTRING(line,k + 1,charPosition($tick,line,k + 1) - k - 1) - dbPart(line,n - 1,charPosition($tick,line,k + 1)) - -dbXParts(line,n,m) == - [.,nargs,:r] := dbParts(line,n,m) - [dbKindString line.0,dbName line,PARSE_-INTEGER nargs,:r] - -dbParts(line,n,m) == --split line into n parts beginning in column m - n = 0 => nil - [SUBSTRING(line,m,-m + (k := charPosition($tick,line,m))), - :dbParts(line,n - 1,k + 1)] - -dbConname(line) == dbPart(line,5,1) - -dbComments line == dbReadComments(string2Integer dbPart(line,7,1)) - -dbNewConname(line) == --dbName line unless kind is 'a or 'o => name in 5th pos. - (kind := line.0) = char 'a or kind = char 'o => - conform := dbPart(line,5,1) - k := charPosition(char '_(,conform,1) - SUBSTRING(conform,1,k - 1) - dbName line - -dbTickIndex(line,n,k) == --returns index of nth tick in line starting at k - n = 1 => charPosition($tick,line,k) - dbTickIndex(line,n - 1,1 + charPosition($tick,line,k)) - -mySort u == listSort(function GLESSEQP,u) - - - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document}