aboutsummaryrefslogtreecommitdiff
path: root/src/interp/ht-root.boot.pamphlet
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/ht-root.boot.pamphlet')
-rw-r--r--src/interp/ht-root.boot.pamphlet311
1 files changed, 311 insertions, 0 deletions
diff --git a/src/interp/ht-root.boot.pamphlet b/src/interp/ht-root.boot.pamphlet
new file mode 100644
index 00000000..3d8d08af
--- /dev/null
+++ b/src/interp/ht-root.boot.pamphlet
@@ -0,0 +1,311 @@
+\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}
+<<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.
+
+@
+<<*>>=
+<<license>>
+
+$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/share/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}