diff --git a/changelog b/changelog index c7d7f88..d648db2 100644 --- a/changelog +++ b/changelog @@ -1,5 +1,9 @@ +20090711 tpd src/axiom-website/patches.html 20090711.06.tpd.patch +20090711 tpd src/interp/Makefile remove ht-root.boot +20090711 tpd src/interp/ht-util.boot merge ht-root +20090711 tpd src/interp/ht-root.boot removed, merge with ht-util 20090711 tpd src/axiom-website/patches.html 20090711.05.tpd.patch -20090711 tpd src/interp/Makefile remove htsetvar.boot +20090711 tpd src/interp/Makefile remove ht-util.boot 20090711 tpd src/interp/ht-util.boot merge ht-util 20090711 tpd src/interp/htsetvar.boot removed, merge with ht-util 20090711 tpd src/axiom-website/patches.html 20090711.04.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index c0b2eee..cf7b7c7 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1705,5 +1705,7 @@ books/bookvol7 htsearch moved to $AXIOM/bin
merge bc-matrix and bc-util
20090711.05.tpd.patch merge ht-util and htsetvar
+20090711.06.tpd.patch +merge ht-util and ht-root
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 673b13d..6f2f529 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -285,7 +285,6 @@ browser. These files should probably be autoloaded. <>= BROBJS= ${AUTO}/bc-matrix.${O} \ ${AUTO}/ht-util.${O} \ - ${AUTO}/ht-root.${O} \ ${AUTO}/br-con.${O} \ ${AUTO}/br-data.${O} ${AUTO}/showimp.${O} \ ${AUTO}/br-op1.${O} ${AUTO}/br-op2.${O} \ @@ -456,7 +455,6 @@ DOCFILES=${DOC}/alql.boot.dvi \ ${DOC}/g-timer.boot.dvi \ ${DOC}/g-util.boot.dvi ${DOC}/hashcode.boot.dvi \ ${DOC}/hash.lisp.dvi ${DOC}/htcheck.boot.dvi \ - ${DOC}/ht-root.boot.dvi \ ${DOC}/ht-util.boot.dvi \ ${DOC}/i-analy.boot.dvi ${DOC}/i-code.boot.dvi \ ${DOC}/i-coerce.boot.dvi ${DOC}/i-coerfn.boot.dvi \ @@ -5696,55 +5694,6 @@ ${DOC}/record.boot.dvi: ${IN}/record.boot.pamphlet @ -\subsection{ht-root.boot} -<>= -${AUTO}/ht-root.${O}: ${OUT}/ht-root.${O} - @ echo 449 making ${AUTO}/ht-root.${O} from ${OUT}/ht-root.${O} - @ cp ${OUT}/ht-root.${O} ${AUTO} - -@ -<>= -${OUT}/ht-root.${O}: ${MID}/ht-root.clisp - @ echo 450 making ${OUT}/ht-root.${O} from ${MID}/ht-root.clisp - @ (cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/ht-root.clisp"' \ - ':output-file "${OUT}/ht-root.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/ht-root.clisp"' \ - ':output-file "${OUT}/ht-root.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/ht-root.clisp: ${IN}/ht-root.boot.pamphlet - @ echo 451 making ${MID}/ht-root.clisp from ${IN}/ht-root.boot.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/ht-root.boot.pamphlet >ht-root.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "ht-root.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "ht-root.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm ht-root.boot ) - -@ -<>= -${DOC}/ht-root.boot.dvi: ${IN}/ht-root.boot.pamphlet - @echo 452 making ${DOC}/ht-root.boot.dvi \ - from ${IN}/ht-root.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/ht-root.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} ht-root.boot ; \ - rm -f ${DOC}/ht-root.boot.pamphlet ; \ - rm -f ${DOC}/ht-root.boot.tex ; \ - rm -f ${DOC}/ht-root.boot ) - -@ - \subsection{htcheck.boot} <>= ${AUTO}/htcheck.${O}: ${OUT}/htcheck.${O} @@ -8068,11 +8017,6 @@ clean: <> <> -<> -<> -<> -<> - <> <> <> diff --git a/src/interp/ht-root.boot.pamphlet b/src/interp/ht-root.boot.pamphlet deleted file mode 100644 index cee0cc7..0000000 --- a/src/interp/ht-root.boot.pamphlet +++ /dev/null @@ -1,311 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp ht-root.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. - -@ -<<*>>= -<> - -$historyDisplayWidth := 120 -$newline := char 10 - -downlink page == - $saturn => downlinkSaturn page - htInitPage('"Bridge",nil) - htSay('"\replacepage{", page, '"}") - htShowPage() - -downlinkSaturn fn == - u := dbReadLines(fn) - lines := '"" - while u is [line,:u] repeat - n := MAXINDEX line - n < 1 => nil - line.0 = (char '_%) => nil - lines := STRCONC(lines,line) - issueHTSaturn lines - -dbNonEmptyPattern pattern == - null pattern => '"*" - pattern := STRINGIMAGE pattern - #pattern > 0 => pattern - '"*" - -htSystemVariables() == main where - main == - not $fullScreenSysVars => htSetVars() - classlevel := $UserLevel - $levels : local := '(compiler development interpreter) - $heading : local := nil - while classlevel ^= first $levels repeat $levels := rest $levels - table := NREVERSE fn($setOptions,nil,true) - htInitPage('"System Variables",nil) - htSay '"\beginmenu" - lastHeading := nil - for [heading,name,message,.,key,variable,options,func] in table repeat - htSay('"\newline\item ") - if heading = lastHeading then htSay '"\tab{8}" else - htSay(heading,'"\tab{8}") - lastHeading := heading - htSay('"{\em ",name,"}\tab{22}",message) - htSay('"\tab{80}") - key = 'FUNCTION => - null options => htMakePage [['bcLinks,['"reset",'"",func,nil]]] - [msg,class,var,valuesOrFunction,:.] := first options --skip first message - functionTail(name,class,var,valuesOrFunction) - for option in rest options repeat - option is ['break,:.] => 'skip - [msg,class,var,valuesOrFunction,:.] := option - htSay('"\newline\tab{22}", msg,'"\tab{80}") - functionTail(name,class,var,valuesOrFunction) - val := eval variable - displayOptions(name,key,variable,val,options) - htSay '"\endmenu" - htShowPage() - functionTail(name,class,var,valuesOrFunction) == - val := eval var - atom valuesOrFunction => - htMakePage '((domainConditions (isDomain STR (String)))) - htMakePage [['bcLinks,['"reset",'"",'htSetSystemVariableKind,[var,name,nil]]]] - htMakePage [['bcStrings,[30,STRINGIMAGE val,name,valuesOrFunction]]] - displayOptions(name,class,var,val,valuesOrFunction) - displayOptions(name,class,variable,val,options) == - class = 'INTEGER => - htMakePage [['bcLispLinks,[[['text,options.0,'"-",options.1 or '""]],'"",'htSetSystemVariableKind,[variable,name,'PARSE_-INTEGER]]]] - htMakePage '((domainConditions (isDomain INT (Integer)))) - htMakePage [['bcStrings,[5,STRINGIMAGE val,name,'INT]]] - class = 'STRING => - htSay('"{\em ",val,'"}\space{1}") - for x in options repeat - val = x or val = true and x = 'on or null val and x = 'off => - htSay('"{\em ",x,'"}\space{1}") - htMakePage [['bcLispLinks,[x,'" ",'htSetSystemVariable,[variable,x]]]] - fn(t,al,firstTime) == - atom t => al - if firstTime then $heading := opOf first t - fn(rest t,gn(first t,al),firstTime) - gn(t,al) == - [.,.,class,key,.,options,:.] := t - not MEMQ(class,$levels) => al - key = 'LITERALS or key = 'INTEGER or key = 'STRING => [[$heading,:t],:al] - key = 'TREE => fn(options,al,false) - key = 'FUNCTION => [[$heading,:t],:al] - systemError key - -htSetSystemVariableKind(htPage,[variable,name,fun]) == - value := htpLabelInputString(htPage,name) - if STRINGP value and fun then value := FUNCALL(fun,value) ---SCM::what to do??? if not FIXP value then userError ??? - SET(variable,value) - htSystemVariables () - -htSetSystemVariable(htPage,[name,value]) == - value := - value = 'on => true - value = 'off => nil - value - SET(name,value) - htSystemVariables () - -htGloss(pattern) == htGlossPage(nil,dbNonEmptyPattern pattern or '"*",true) - -htGlossPage(htPage,pattern,tryAgain?) == - $wildCard: local := char '_* - pattern = '"*" => downlink 'GlossaryPage - filter := pmTransFilter pattern - grepForm := mkGrepPattern(filter,'none) - $key: local := 'none - results := applyGrep(grepForm,'gloss) - --pathname := STRCONC('"/tmp/",PNAME resultFile,'".text.", getEnv '"SPADNUM") - --instream := MAKE_-INSTREAM pathname - defstream := MAKE_-INSTREAM STRCONC(getEnv '"AXIOM",'"/algebra/glossdef.text") - lines := gatherGlossLines(results,defstream) - -- OBEY STRCONC('"rm -f ", pathname) - --PROBE_-FILE(pathname) and DELETE_-FILE(pathname) - --SHUT instream - heading := - pattern = '"" => '"Glossary" - null lines => ['"No glossary items match {\em ",pattern,'"}"] - ['"Glossary items matching {\em ",pattern,'"}"] - null lines => - tryAgain? and #pattern > 0 => - (pattern.(k := MAXINDEX(pattern))) = char 's => - htGlossPage(htPage,SUBSTRING(pattern,0,k),true) - UPPER_-CASE_-P pattern.0 => - htGlossPage(htPage,DOWNCASE pattern,false) - errorPage(htPage,['"Sorry",nil,['"\centerline{",:heading,'"}"]]) - errorPage(htPage,['"Sorry",nil,['"\centerline{",:heading,'"}"]]) - htInitPageNoScroll(nil,heading) - htSay('"\beginscroll\beginmenu") - for line in lines repeat - tick := charPosition($tick,line,1) - htSay('"\item{\em \menuitemstyle{}}\tab{0}{\em ",escapeString SUBSTRING(line,0,tick),'"} ",SUBSTRING(line,tick + 1,nil)) - htSay '"\endmenu " - htSay '"\endscroll\newline " - htMakePage [['bcLinks,['"Search",'"",'htGlossSearch,nil]]] - htSay '" for glossary entry matching " - htMakePage [['bcStrings, [24,'"*",'filter,'EM]]] - htShowPageNoScroll() - -gatherGlossLines(results,defstream) == - acc := nil - for keyline in results repeat - --keyline := READLINE instream - n := charPosition($tick,keyline,0) - keyAndTick := SUBSTRING(keyline,0,n + 1) - byteAddress := string2Integer SUBSTRING(keyline,n + 1,nil) - FILE_-POSITION(defstream,byteAddress) - line := READLINE defstream - k := charPosition($tick,line,1) - pointer := SUBSTRING(line,0,k) - def := SUBSTRING(line,k + 1,nil) - xtralines := nil - while not EOFP defstream and (x := READLINE defstream) and - (j := charPosition($tick,x,1)) and (nextPointer := SUBSTRING(x,0,j)) - and (nextPointer = pointer) repeat - xtralines := [SUBSTRING(x,j + 1,nil),:xtralines] - acc := [STRCONC(keyAndTick,def, "STRCONC"/NREVERSE xtralines),:acc] - REVERSE acc - -htGlossSearch(htPage,junk) == htGloss htpLabelInputString(htPage,'filter) - -htGreekSearch(filter) == - ss := dbNonEmptyPattern filter - s := pmTransFilter ss - s is ['error,:.] => bcErrorPage s - not s => errorPage(nil,[['"Missing search string"],nil, - '"\vspace{2}\centerline{To select one of the greek letters:}\newline ", - '"\centerline{{\em first} enter a search key into the input area}\newline ", - '"\centerline{{\em then } move the mouse cursor to the work {\em search} and click}"]) - filter := patternCheck s - names := '(alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu pi) - for x in names repeat - superMatch?(filter,PNAME x) => matches := [x,:matches] - nonmatches := [x,:nonmatches] - matches := NREVERSE matches - nonmatches := NREVERSE nonmatches - htInitPage('"Greek Names",nil) - null matches => - htInitPage(['"Greek names matching search string {\em ",ss,'"}"],nil) - htSay("\vspace{2}\centerline{Sorry, but no greek letters match your search string}\centerline{{\em ",ss,"}}\centerline{Click on the up-arrow to try again}") - htShowPage() - htInitPage(['"Greek letters matching search string {\em ",ss,'"}"],nil) - if nonmatches - then htSay('"The greek letters that {\em match} your search string {\em ",ss,'"}:") - else htSay('"Your search string {\em ",ss,"} matches all of the greek letters:") - htSay('"{\em \table{") - for x in matches repeat htSay('"{",x,'"}") - htSay('"}}\vspace{1}") - if nonmatches then - htSay('"The greek letters that {\em do not match} your search string:{\em \table{") - for x in nonmatches repeat htSay('"{",x,'"}") - htSay('"}}") - htShowPage() - -htTextSearch(filter) == - s := pmTransFilter dbNonEmptyPattern filter - s is ['error,:.] => bcErrorPage s - not s => errorPage(nil,[['"Missing search string"],nil, - '"\vspace{2}\centerline{To select one of the lines of text:}\newline ", - '"\centerline{{\em first} enter a search key into the input area}\newline ", - '"\centerline{{\em then } move the mouse cursor to the work {\em search} and click}"]) - filter := s - lines := ['"{{\em Fruit flies} *like* a {\em banana and califlower ears.}}", - '"{{\em Sneak Sears Silas with Savings Snatch}}"] - for x in lines repeat - superMatch?(filter,x) => matches := [x,:matches] - nonmatches := [x,:nonmatches] - matches := NREVERSE matches - nonmatches := NREVERSE nonmatches - htInitPage('"Text Matches",nil) - null matches => - htInitPage(['"Lines matching search string {\em ",s,'"}"],nil) - htSay("\vspace{2}\centerline{Sorry, but no lines match your search string}\centerline{{\em ",s,"}}\centerline{Click on the up-arrow to try again}") - htShowPage() - htInitPage(['"Lines matching search string {\em ",s,'"}"],nil) - if nonmatches - then htSay('"The lines that {\em match} your search string {\em ",s,'"}:") - else htSay('"Your search string {\em ",s,"} matches both lines:") - htSay('"{\em \table{") - for x in matches repeat htSay('"{",x,'"}") - htSay('"}}\vspace{1}") - if nonmatches then - htSay('"The line that {\em does not match} your search string:{\em \table{") - for x in nonmatches repeat htSay('"{",x,'"}") - htSay('"}}") - htShowPage() - -htTutorialSearch pattern == - s := dbNonEmptyPattern pattern or return - errorPage(nil,['"Empty search key",nil,'"\vspace{3}\centerline{You must enter some search string"]) - s := mkUnixPattern s - source := '"$AXIOM/doc/hypertex/pages/ht.db" - target :='"/tmp/temp.text.$SPADNUM" - OBEY STRCONC('"$AXIOM/lib/hthits",'" _"",s,'"_" ",source,'" > ",target) - lines := dbReadLines 'temp - htInitPageNoScroll(nil,['"Tutorial Pages mentioning {\em ",pattern,'"}"]) - htSay('"\beginscroll\table{") - for line in lines repeat - [name,title,.] := dbParts(line,3,0) - htSay ['"{\downlink{",title,'"}{",name,'"}}"] - htSay '"}" - htShowPage() - -mkUnixPattern s == - u := mkUpDownPattern s - starPositions := REVERSE [i for i in 1..(-1 + MAXINDEX u) | u.i = $wild] - for i in starPositions repeat - u := STRCONC(SUBSTRING(u,0,i),'".*",SUBSTRING(u,i + 1,nil)) - if u.0 ^= $wild then u := STRCONC('"[^a-zA-Z]",u) - else u := SUBSTRING(u,1,nil) - if u.(k := MAXINDEX u) ^= $wild then u := STRCONC(u,'"[^a-zA-Z]") - else u := SUBSTRING(u,0,k) - u - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/ht-util.boot.pamphlet b/src/interp/ht-util.boot.pamphlet index 4fb0b3a..def38cd 100644 --- a/src/interp/ht-util.boot.pamphlet +++ b/src/interp/ht-util.boot.pamphlet @@ -1181,6 +1181,263 @@ htCacheOne names == htSetvarDoneButton('"Select to Set Value",'htCacheSet) htShowPage() +$historyDisplayWidth := 120 +$newline := char 10 + +downlink page == + $saturn => downlinkSaturn page + htInitPage('"Bridge",nil) + htSay('"\replacepage{", page, '"}") + htShowPage() + +downlinkSaturn fn == + u := dbReadLines(fn) + lines := '"" + while u is [line,:u] repeat + n := MAXINDEX line + n < 1 => nil + line.0 = (char '_%) => nil + lines := STRCONC(lines,line) + issueHTSaturn lines + +dbNonEmptyPattern pattern == + null pattern => '"*" + pattern := STRINGIMAGE pattern + #pattern > 0 => pattern + '"*" + +htSystemVariables() == main where + main == + not $fullScreenSysVars => htSetVars() + classlevel := $UserLevel + $levels : local := '(compiler development interpreter) + $heading : local := nil + while classlevel ^= first $levels repeat $levels := rest $levels + table := NREVERSE fn($setOptions,nil,true) + htInitPage('"System Variables",nil) + htSay '"\beginmenu" + lastHeading := nil + for [heading,name,message,.,key,variable,options,func] in table repeat + htSay('"\newline\item ") + if heading = lastHeading then htSay '"\tab{8}" else + htSay(heading,'"\tab{8}") + lastHeading := heading + htSay('"{\em ",name,"}\tab{22}",message) + htSay('"\tab{80}") + key = 'FUNCTION => + null options => htMakePage [['bcLinks,['"reset",'"",func,nil]]] + [msg,class,var,valuesOrFunction,:.] := first options --skip first message + functionTail(name,class,var,valuesOrFunction) + for option in rest options repeat + option is ['break,:.] => 'skip + [msg,class,var,valuesOrFunction,:.] := option + htSay('"\newline\tab{22}", msg,'"\tab{80}") + functionTail(name,class,var,valuesOrFunction) + val := eval variable + displayOptions(name,key,variable,val,options) + htSay '"\endmenu" + htShowPage() + functionTail(name,class,var,valuesOrFunction) == + val := eval var + atom valuesOrFunction => + htMakePage '((domainConditions (isDomain STR (String)))) + htMakePage [['bcLinks,['"reset",'"",'htSetSystemVariableKind,[var,name,nil]]]] + htMakePage [['bcStrings,[30,STRINGIMAGE val,name,valuesOrFunction]]] + displayOptions(name,class,var,val,valuesOrFunction) + displayOptions(name,class,variable,val,options) == + class = 'INTEGER => + htMakePage [['bcLispLinks,[[['text,options.0,'"-",options.1 or '""]],'"",'htSetSystemVariableKind,[variable,name,'PARSE_-INTEGER]]]] + htMakePage '((domainConditions (isDomain INT (Integer)))) + htMakePage [['bcStrings,[5,STRINGIMAGE val,name,'INT]]] + class = 'STRING => + htSay('"{\em ",val,'"}\space{1}") + for x in options repeat + val = x or val = true and x = 'on or null val and x = 'off => + htSay('"{\em ",x,'"}\space{1}") + htMakePage [['bcLispLinks,[x,'" ",'htSetSystemVariable,[variable,x]]]] + fn(t,al,firstTime) == + atom t => al + if firstTime then $heading := opOf first t + fn(rest t,gn(first t,al),firstTime) + gn(t,al) == + [.,.,class,key,.,options,:.] := t + not MEMQ(class,$levels) => al + key = 'LITERALS or key = 'INTEGER or key = 'STRING => [[$heading,:t],:al] + key = 'TREE => fn(options,al,false) + key = 'FUNCTION => [[$heading,:t],:al] + systemError key + +htSetSystemVariableKind(htPage,[variable,name,fun]) == + value := htpLabelInputString(htPage,name) + if STRINGP value and fun then value := FUNCALL(fun,value) +--SCM::what to do??? if not FIXP value then userError ??? + SET(variable,value) + htSystemVariables () + +htSetSystemVariable(htPage,[name,value]) == + value := + value = 'on => true + value = 'off => nil + value + SET(name,value) + htSystemVariables () + +htGloss(pattern) == htGlossPage(nil,dbNonEmptyPattern pattern or '"*",true) + +htGlossPage(htPage,pattern,tryAgain?) == + $wildCard: local := char '_* + pattern = '"*" => downlink 'GlossaryPage + filter := pmTransFilter pattern + grepForm := mkGrepPattern(filter,'none) + $key: local := 'none + results := applyGrep(grepForm,'gloss) + --pathname := STRCONC('"/tmp/",PNAME resultFile,'".text.", getEnv '"SPADNUM") + --instream := MAKE_-INSTREAM pathname + defstream := MAKE_-INSTREAM STRCONC(getEnv '"AXIOM",'"/algebra/glossdef.text") + lines := gatherGlossLines(results,defstream) + -- OBEY STRCONC('"rm -f ", pathname) + --PROBE_-FILE(pathname) and DELETE_-FILE(pathname) + --SHUT instream + heading := + pattern = '"" => '"Glossary" + null lines => ['"No glossary items match {\em ",pattern,'"}"] + ['"Glossary items matching {\em ",pattern,'"}"] + null lines => + tryAgain? and #pattern > 0 => + (pattern.(k := MAXINDEX(pattern))) = char 's => + htGlossPage(htPage,SUBSTRING(pattern,0,k),true) + UPPER_-CASE_-P pattern.0 => + htGlossPage(htPage,DOWNCASE pattern,false) + errorPage(htPage,['"Sorry",nil,['"\centerline{",:heading,'"}"]]) + errorPage(htPage,['"Sorry",nil,['"\centerline{",:heading,'"}"]]) + htInitPageNoScroll(nil,heading) + htSay('"\beginscroll\beginmenu") + for line in lines repeat + tick := charPosition($tick,line,1) + htSay('"\item{\em \menuitemstyle{}}\tab{0}{\em ",escapeString SUBSTRING(line,0,tick),'"} ",SUBSTRING(line,tick + 1,nil)) + htSay '"\endmenu " + htSay '"\endscroll\newline " + htMakePage [['bcLinks,['"Search",'"",'htGlossSearch,nil]]] + htSay '" for glossary entry matching " + htMakePage [['bcStrings, [24,'"*",'filter,'EM]]] + htShowPageNoScroll() + +gatherGlossLines(results,defstream) == + acc := nil + for keyline in results repeat + --keyline := READLINE instream + n := charPosition($tick,keyline,0) + keyAndTick := SUBSTRING(keyline,0,n + 1) + byteAddress := string2Integer SUBSTRING(keyline,n + 1,nil) + FILE_-POSITION(defstream,byteAddress) + line := READLINE defstream + k := charPosition($tick,line,1) + pointer := SUBSTRING(line,0,k) + def := SUBSTRING(line,k + 1,nil) + xtralines := nil + while not EOFP defstream and (x := READLINE defstream) and + (j := charPosition($tick,x,1)) and (nextPointer := SUBSTRING(x,0,j)) + and (nextPointer = pointer) repeat + xtralines := [SUBSTRING(x,j + 1,nil),:xtralines] + acc := [STRCONC(keyAndTick,def, "STRCONC"/NREVERSE xtralines),:acc] + REVERSE acc + +htGlossSearch(htPage,junk) == htGloss htpLabelInputString(htPage,'filter) + +htGreekSearch(filter) == + ss := dbNonEmptyPattern filter + s := pmTransFilter ss + s is ['error,:.] => bcErrorPage s + not s => errorPage(nil,[['"Missing search string"],nil, + '"\vspace{2}\centerline{To select one of the greek letters:}\newline ", + '"\centerline{{\em first} enter a search key into the input area}\newline ", + '"\centerline{{\em then } move the mouse cursor to the work {\em search} and click}"]) + filter := patternCheck s + names := '(alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu pi) + for x in names repeat + superMatch?(filter,PNAME x) => matches := [x,:matches] + nonmatches := [x,:nonmatches] + matches := NREVERSE matches + nonmatches := NREVERSE nonmatches + htInitPage('"Greek Names",nil) + null matches => + htInitPage(['"Greek names matching search string {\em ",ss,'"}"],nil) + htSay("\vspace{2}\centerline{Sorry, but no greek letters match your search string}\centerline{{\em ",ss,"}}\centerline{Click on the up-arrow to try again}") + htShowPage() + htInitPage(['"Greek letters matching search string {\em ",ss,'"}"],nil) + if nonmatches + then htSay('"The greek letters that {\em match} your search string {\em ",ss,'"}:") + else htSay('"Your search string {\em ",ss,"} matches all of the greek letters:") + htSay('"{\em \table{") + for x in matches repeat htSay('"{",x,'"}") + htSay('"}}\vspace{1}") + if nonmatches then + htSay('"The greek letters that {\em do not match} your search string:{\em \table{") + for x in nonmatches repeat htSay('"{",x,'"}") + htSay('"}}") + htShowPage() + +htTextSearch(filter) == + s := pmTransFilter dbNonEmptyPattern filter + s is ['error,:.] => bcErrorPage s + not s => errorPage(nil,[['"Missing search string"],nil, + '"\vspace{2}\centerline{To select one of the lines of text:}\newline ", + '"\centerline{{\em first} enter a search key into the input area}\newline ", + '"\centerline{{\em then } move the mouse cursor to the work {\em search} and click}"]) + filter := s + lines := ['"{{\em Fruit flies} *like* a {\em banana and califlower ears.}}", + '"{{\em Sneak Sears Silas with Savings Snatch}}"] + for x in lines repeat + superMatch?(filter,x) => matches := [x,:matches] + nonmatches := [x,:nonmatches] + matches := NREVERSE matches + nonmatches := NREVERSE nonmatches + htInitPage('"Text Matches",nil) + null matches => + htInitPage(['"Lines matching search string {\em ",s,'"}"],nil) + htSay("\vspace{2}\centerline{Sorry, but no lines match your search string}\centerline{{\em ",s,"}}\centerline{Click on the up-arrow to try again}") + htShowPage() + htInitPage(['"Lines matching search string {\em ",s,'"}"],nil) + if nonmatches + then htSay('"The lines that {\em match} your search string {\em ",s,'"}:") + else htSay('"Your search string {\em ",s,"} matches both lines:") + htSay('"{\em \table{") + for x in matches repeat htSay('"{",x,'"}") + htSay('"}}\vspace{1}") + if nonmatches then + htSay('"The line that {\em does not match} your search string:{\em \table{") + for x in nonmatches repeat htSay('"{",x,'"}") + htSay('"}}") + htShowPage() + +htTutorialSearch pattern == + s := dbNonEmptyPattern pattern or return + errorPage(nil,['"Empty search key",nil,'"\vspace{3}\centerline{You must enter some search string"]) + s := mkUnixPattern s + source := '"$AXIOM/doc/hypertex/pages/ht.db" + target :='"/tmp/temp.text.$SPADNUM" + OBEY STRCONC('"$AXIOM/lib/hthits",'" _"",s,'"_" ",source,'" > ",target) + lines := dbReadLines 'temp + htInitPageNoScroll(nil,['"Tutorial Pages mentioning {\em ",pattern,'"}"]) + htSay('"\beginscroll\table{") + for line in lines repeat + [name,title,.] := dbParts(line,3,0) + htSay ['"{\downlink{",title,'"}{",name,'"}}"] + htSay '"}" + htShowPage() + +mkUnixPattern s == + u := mkUpDownPattern s + starPositions := REVERSE [i for i in 1..(-1 + MAXINDEX u) | u.i = $wild] + for i in starPositions repeat + u := STRCONC(SUBSTRING(u,0,i),'".*",SUBSTRING(u,i + 1,nil)) + if u.0 ^= $wild then u := STRCONC('"[^a-zA-Z]",u) + else u := SUBSTRING(u,1,nil) + if u.(k := MAXINDEX u) ^= $wild then u := STRCONC(u,'"[^a-zA-Z]") + else u := SUBSTRING(u,0,k) + u + + @ \eject \begin{thebibliography}{99}