1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 2-- All rights reserved. 3-- 4-- Redistribution and use in source and binary forms, with or without 5-- modification, are permitted provided that the following conditions are 6-- met: 7-- 8-- - Redistributions of source code must retain the above copyright 9-- notice, this list of conditions and the following disclaimer. 10-- 11-- - Redistributions in binary form must reproduce the above copyright 12-- notice, this list of conditions and the following disclaimer in 13-- the documentation and/or other materials provided with the 14-- distribution. 15-- 16-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 17-- names of its contributors may be used to endorse or promote products 18-- derived from this software without specific prior written permission. 19-- 20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 32)package "BOOT" 33 34$historyDisplayWidth := 120 35$newline := char 10 36 37downlink page == 38 htInitPage('"Bridge",nil) 39 htSayList(['"\replacepage{", page, '"}"]) 40 htShowPage() 41 42dbNonEmptyPattern pattern == 43 null pattern => '"*" 44 pattern := STRINGIMAGE pattern 45 #pattern > 0 => pattern 46 '"*" 47 48htSystemVariables() == main where 49 main == 50 not $fullScreenSysVars => htSetVars() 51 classlevel := $UserLevel 52 $levels : local := '(compiler development interpreter) 53 $heading : local := nil 54 while classlevel ~= first $levels repeat $levels := rest $levels 55 table := NREVERSE fn($setOptions,nil,true) 56 htInitPage('"System Variables",nil) 57 htSay '"\beginmenu" 58 lastHeading := nil 59 for [heading,name,message,.,key,variable,options,func] in table repeat 60 htSay('"\newline\item ") 61 if heading = lastHeading then htSay '"\tab{8}" else 62 htSayList([heading, '"\tab{8}"]) 63 lastHeading := heading 64 htSayList(['"{\em ", name, "}\tab{22}", message]) 65 htSay('"\tab{80}") 66 key = 'FUNCTION => 67 null options => htMakePage [['bcLinks,['"reset",'"",func,nil]]] 68 [msg,class,var,valuesOrFunction,:.] := first options --skip first message 69 functionTail(name,class,var,valuesOrFunction) 70 for option in rest options repeat 71 option is ['break,:.] => 'skip 72 [msg,class,var,valuesOrFunction,:.] := option 73 htSayList(['"\newline\tab{22}", msg,'"\tab{80}"]) 74 functionTail(name,class,var,valuesOrFunction) 75 val := eval variable 76 displayOptions(name,key,variable,val,options) 77 htSay '"\endmenu" 78 htShowPage() 79 functionTail(name,class,var,valuesOrFunction) == 80 val := eval var 81 atom valuesOrFunction => 82 htMakePage '((domainConditions (isDomain STR (String)))) 83 htMakePage [['bcLinks,['"reset",'"",'htSetSystemVariableKind,[var,name,nil]]]] 84 htMakePage [['bcStrings,[30,STRINGIMAGE val,name,valuesOrFunction]]] 85 displayOptions(name,class,var,val,valuesOrFunction) 86 displayOptions(name,class,variable,val,options) == 87 class = 'INTEGER => 88 htMakePage [['bcLispLinks,[[['text,options.0,'"-",options.1 or '""]],'"",'htSetSystemVariableKind,[variable,name,'PARSE_-INTEGER]]]] 89 htMakePage '((domainConditions (isDomain INT (Integer)))) 90 htMakePage [['bcStrings,[5,STRINGIMAGE val,name,'INT]]] 91 class = 'STRING => 92 htSayList ['"{\em ", val, '"}\space{1}"] 93 for x in options repeat 94 val = x or val = true and x = 'on or null val and x = 'off => 95 htSayList ['"{\em ", x, '"}\space{1}"] 96 htMakePage [['bcLispLinks,[x,'" ",'htSetSystemVariable,[variable,x]]]] 97 fn(t,al,firstTime) == 98 atom t => al 99 if firstTime then $heading := opOf first t 100 fn(rest t,gn(first t,al),firstTime) 101 gn(t,al) == 102 [.,.,class,key,.,options,:.] := t 103 not MEMQ(class,$levels) => al 104 key = 'LITERALS or key = 'INTEGER or key = 'STRING => [[$heading,:t],:al] 105 key = 'TREE => fn(options,al,false) 106 key = 'FUNCTION => [[$heading,:t],:al] 107 systemError key 108 109htSetSystemVariableKind(htPage,[variable,name,fun]) == 110 value := htpLabelInputString(htPage,name) 111 if STRINGP value and fun then value := FUNCALL(fun,value) 112--SCM::what to do??? if not FIXP value then userError ??? 113 SET(variable,value) 114 htSystemVariables () 115 116htSetSystemVariable(htPage,[name,value]) == 117 value := 118 value = 'on => true 119 value = 'off => nil 120 value 121 SET(name,value) 122 htSystemVariables () 123 124htGloss(pattern) == htGlossPage(nil,dbNonEmptyPattern pattern or '"*",true) 125 126htGlossPage(htPage,pattern,tryAgain?) == 127 $wildCard: local := char '_* 128 pattern = '"*" => downlink 'GlossaryPage 129 filter := pmTransFilter pattern 130 grepForm := mkGrepPattern(filter,'none) 131 $key: local := 'none 132 results := applyGrep(grepForm,'gloss) 133 --pathname := STRCONC('"/tmp/",PNAME resultFile,'".text.", getEnv '"SPADNUM") 134 --instream := MAKE_INSTREAM(pathname) 135 defstream := MAKE_INSTREAM(STRCONC(getEnv '"FRICAS", 136 '"/algebra/glossdef.text")) 137 lines := gatherGlossLines(results,defstream) 138 -- OBEY STRCONC('"rm -f ", pathname) 139 --PROBE_-FILE(pathname) and DELETE_-FILE(pathname) 140 --SHUT instream 141 heading := 142 pattern = '"" => '"Glossary" 143 null lines => ['"No glossary items match {\em ",pattern,'"}"] 144 ['"Glossary items matching {\em ",pattern,'"}"] 145 null lines => 146 tryAgain? and #pattern > 0 => 147 (pattern.(k := MAXINDEX(pattern))) = char 's => 148 htGlossPage(htPage,SUBSTRING(pattern,0,k),true) 149 UPPER_-CASE_-P pattern.0 => 150 htGlossPage(htPage,DOWNCASE pattern,false) 151 errorPage(htPage,['"Sorry",nil,['"\centerline{",:heading,'"}"]]) 152 errorPage(htPage,['"Sorry",nil,['"\centerline{",:heading,'"}"]]) 153 htInitPageNoScroll(nil,heading) 154 htSay('"\beginscroll\beginmenu") 155 for line in lines repeat 156 tick := charPosition($tick,line,1) 157 htSayList(['"\item{\em \menuitemstyle{}}\tab{0}{\em ", 158 escapeString SUBSTRING(line,0,tick),'"} ", 159 SUBSTRING(line,tick + 1,nil)]) 160 htSay '"\endmenu " 161 htSay '"\endscroll\newline " 162 htMakePage [['bcLinks,['"Search",'"",'htGlossSearch,nil]]] 163 htSay '" for glossary entry matching " 164 htMakePage [['bcStrings, [24,'"*",'filter,'EM]]] 165 htShowPageNoScroll() 166 167gatherGlossLines(results,defstream) == 168 acc := nil 169 for keyline in results repeat 170 --keyline := read_line instream 171 n := charPosition($tick,keyline,0) 172 keyAndTick := SUBSTRING(keyline,0,n + 1) 173 byteAddress := string2Integer SUBSTRING(keyline,n + 1,nil) 174 FILE_-POSITION(defstream,byteAddress) 175 line := read_line defstream 176 k := charPosition($tick,line,1) 177 pointer := SUBSTRING(line,0,k) 178 def := SUBSTRING(line,k + 1,nil) 179 xtralines := nil 180 while not EOFP defstream and (x := read_line defstream) and 181 (j := charPosition($tick,x,1)) and (nextPointer := SUBSTRING(x,0,j)) 182 and (nextPointer = pointer) repeat 183 xtralines := [SUBSTRING(x,j + 1,nil),:xtralines] 184 acc := [STRCONC(keyAndTick,def, "STRCONC"/NREVERSE xtralines),:acc] 185 REVERSE acc 186 187htGlossSearch(htPage,junk) == htGloss htpLabelInputString(htPage,'filter) 188 189htGreekSearch(filter) == 190 ss := dbNonEmptyPattern filter 191 s := pmTransFilter ss 192 s is ['error,:.] => bcErrorPage s 193 not s => errorPage(nil,[['"Missing search string"],nil, 194 '"\vspace{2}\centerline{To select one of the greek letters:}\newline ", 195 '"\centerline{{\em first} enter a search key into the input area}\newline ", 196 '"\centerline{{\em then } move the mouse cursor to the work {\em search} and click}"]) 197 filter := patternCheck s 198 names := '(alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu pi) 199 for x in names repeat 200 superMatch?(filter,PNAME x) => matches := [x,:matches] 201 nonmatches := [x,:nonmatches] 202 matches := NREVERSE matches 203 nonmatches := NREVERSE nonmatches 204 htInitPage('"Greek Names",nil) 205 null matches => 206 htInitPage(['"Greek names matching search string {\em ",ss,'"}"],nil) 207 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}") 208 htShowPage() 209 htInitPage(['"Greek letters matching search string {\em ",ss,'"}"],nil) 210 if nonmatches 211 then htSayList([ 212 '"The greek letters that {\em match} your search string {\em ", 213 ss, '"}:"]) 214 else htSay('"Your search string {\em ",ss,"} matches all of the greek letters:") 215 htSay('"{\em \table{") 216 for x in matches repeat htSayList(['"{", x, '"}"]) 217 htSay('"}}\vspace{1}") 218 if nonmatches then 219 htSay('"The greek letters that {\em do not match} your search string:{\em \table{") 220 for x in nonmatches repeat htSayList(['"{", x, '"}"]) 221 htSay('"}}") 222 htShowPage() 223 224htTextSearch(filter) == 225 s := pmTransFilter dbNonEmptyPattern filter 226 s is ['error,:.] => bcErrorPage s 227 not s => errorPage(nil,[['"Missing search string"],nil, 228 '"\vspace{2}\centerline{To select one of the lines of text:}\newline ", 229 '"\centerline{{\em first} enter a search key into the input area}\newline ", 230 '"\centerline{{\em then } move the mouse cursor to the work {\em search} and click}"]) 231 filter := s 232 lines := ['"{{\em Fruit flies} *like* a {\em banana and califlower ears.}}", 233 '"{{\em Sneak Sears Silas with Savings Snatch}}"] 234 for x in lines repeat 235 superMatch?(filter,x) => matches := [x,:matches] 236 nonmatches := [x,:nonmatches] 237 matches := NREVERSE matches 238 nonmatches := NREVERSE nonmatches 239 htInitPage('"Text Matches",nil) 240 null matches => 241 htInitPage(['"Lines matching search string {\em ",s,'"}"],nil) 242 htSay("\vspace{2}\centerline{Sorry, but no lines match your search string}\centerline{{\em ",s,"}}\centerline{Click on the up-arrow to try again}") 243 htShowPage() 244 htInitPage(['"Lines matching search string {\em ",s,'"}"],nil) 245 if nonmatches 246 then htSayList([ 247 '"The lines that {\em match} your search string {\em ", 248 s, '"}:"]) 249 else htSay('"Your search string {\em ",s,"} matches both lines:") 250 htSay('"{\em \table{") 251 for x in matches repeat htSayList(['"{", x, '"}"]) 252 htSay('"}}\vspace{1}") 253 if nonmatches then 254 htSay('"The line that {\em does not match} your search string:{\em \table{") 255 for x in nonmatches repeat htSayList(['"{", x, '"}"]) 256 htSay('"}}") 257 htShowPage() 258 259mkUnixPattern s == 260 u := mkUpDownPattern s 261 starPositions := REVERSE [i for i in 1..(-1 + MAXINDEX u) | u.i = $wild] 262 for i in starPositions repeat 263 u := STRCONC(SUBSTRING(u,0,i),'".*",SUBSTRING(u,i + 1,nil)) 264 if u.0 ~= $wild then u := STRCONC('"[^a-zA-Z]",u) 265 else u := SUBSTRING(u,1,nil) 266 if u.(k := MAXINDEX u) ~= $wild then u := STRCONC(u,'"[^a-zA-Z]") 267 else u := SUBSTRING(u,0,k) 268 u 269