-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. -- Copyright (C) 2007-2012, Gabriel Dos Reis. -- 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. import bc_-util namespace BOOT -- New file as of 6/95 $aixTestSaturn := false --These will be set in patches.lisp: --$saturn := false --true to write SATURN output to $browserOutputStream $standard := true --true to write browser output on AIX $saturnAmpersand := '"\&\&" $saturnFileNumber --true to write DOS files for Thinkpad (testing only) := false $kPageSaturnArguments := nil --bound by $kPageSaturn $atLeastOneUnexposed := false $saturnContextMenuLines := nil $saturnContextMenuIndex := 0 $saturnMacros := '( "\def\unixcommand#1#2{{\em #1}}"_ "\def\lispFunctionLink#1#2{\lispLink[d]{#1}{{\bf #2}}}"_ "\def\lispTypeLink#1#2{\lispLink[d]{#1}{{\sf #2}}}"_ "\def\menuitemstyle{\menubutton}"_ "\def\browseTitle#1{\windowTitle{#1}\section{#1}}"_ "\def\ttrarrow{$\rightarrow$}"_ "\def\spadtype#1{\lispLink[d]{\verb!(|spadtype| '|#1|)!}{\sf #1}}"_ "\def\spad#1{{\em #1}}"_ "\def\spadfun#1{{\em #1}}"_ ) $FormalFunctionParameterList := '(_#_#1 _#_#2 _#_#3 _#_#4 _#_#5 _#_#6 _#_#7 _#_#8 _#_#9 _#_#10 _#_#11 _#_#12 _#_#13 _#_#14 _#_#15) on() == $saturn := true $standard := false off()== $saturn := false $standard := true --======================================================================= -- Function for testing SATURN output --======================================================================= -- protectedEVAL x == -- $saturn => -- protectedEVAL0(x, true, false) -- if $aixTestSaturn then protectedEVAL0(x, false, true) -- protectedEVAL1 x -- --protectedEVAL0(x, $saturn, $standard) == -- protectedEVAL1 x -- --protectedEVAL1 x == -- error := true -- val := nil -- UNWIND_-PROTECT((val := saturnEVAL x; error := nil), -- error => (resetStackLimits(); sendHTErrorSignal())) -- val -- --saturnEVAL x == -- fn := -- $aixTestSaturn => '"/tmp/sat.text" -- '"/windows/temp/browser.text" -- $saturn => -- saturnEvalToFile(x, fn) -- displayTextFile '"/tmp/sat.text" -- eval x --======================================================================= -- Functions to write DOS files to disk --======================================================================= ts(command) == $saturn := true $saturnFileNumber := false $standard := false saturnEvalToFile(command, '"/tmp/sat.text") ut() == $saturn := false $standard := true 'done onDisk() == $saturnFileNumber := 1 obey '"dosdir" offDisk() == $saturnFileNumber := false page() == $standard => $curPage $saturnPage --======================================================================= -- Functions that affect $saturnPage --======================================================================= htSay(x,:options) == --say for possibly both $saturn and standard code htSayBind(x, options) htSayCold x == htSay '"\lispLink{}{" htSay x htSay '"}" htSayIfStandard(x, :options) == --do only for $standard $standard => htSayBind(x,options) htSayStandard(x, :options) == --do AT MOST for $standard $saturn: local := nil htSayBind(x, options) htSaySaturn(x, :options) == --do AT MOST for $saturn $standard: local := nil htSayBind(x, options) htSayBind(x, options) == bcHt x for y in options repeat bcHt y bcHt line == $newPage => --this path affects both saturn and old lines text := cons? line => [['text, :line]] string? line => line [['text, line]] if $saturn then htpAddToPageDescription($saturnPage, text) if $standard then htpAddToPageDescription($curPage, text) cons? line => $htLineList := append!(reverse! mapStringize copyList line, $htLineList) $htLineList := [basicStringize line, :$htLineList] --======================================================================= -- New issueHT --======================================================================= htShowPage() == -- show the page which has been computed htSayStandard '"\endscroll" htShowPageNoScroll() htShowPageNoScroll() == -- show the page which has been computed htSayStandard '"\autobuttons" if $standard then htpSetPageDescription($curPage, reverse! htpPageDescription $curPage) if $saturn then htpSetPageDescription($saturnPage, reverse! htpPageDescription $saturnPage) $newPage := false ---------------------- if $standard then $htLineList := nil htMakePage htpPageDescription $curPage if $htLineList then line := apply(function strconc, reverse! $htLineList) issueHTStandard line ---------------------- if $saturn then $htLineList := nil htMakePage htpPageDescription $saturnPage if $htLineList then line := apply(function strconc, reverse! $htLineList) issueHTSaturn line ---------------------- endHTPage() --------------------> NEW DEFINITION <-------------------------- issueHTSaturn line == --called by htMakePageNoScroll and htMakeErrorPage if $saturn then $marg : local := 0 $linelength: local := 80 writeSaturn '"\inputonce{/doc/browser/browmacs.tex}" writeSaturnPrefix() writeSaturn(line) writeSaturnSuffix() if $saturnFileNumber then fn := strconc('"sat", STRINGIMAGE $saturnFileNumber, '".tex") obey strconc('"doswrite -a saturn.tex ",fn, '".tex") $saturnFileNumber := $saturnFileNumber + 1 writeSaturnPrefix() == $saturnContextMenuLines => index := toString ($saturnContextMenuIndex := $saturnContextMenuIndex + 1) writeSaturnLines ['"\newmenu{BCM", index, '"}{",:reverse! $saturnContextMenuLines, '"}\usemenu{BCM", index,'"}{\vbox{"] writeSaturnSuffix() == $saturnContextMenuLines => saturnPRINTEXP '"}}" issueHTStandard line == --called by htMakePageNoScroll and htMakeErrorPage if $standard then --unescapeStringsInForm line sockSendInt($MenuServer, $SendLine) sockSendString($MenuServer, line) htMakeErrorPage htPage == $newPage := false $htLineList := nil if $standard then $curPage := htPage if $saturn then $saturnPage := htPage htMakePage htpPageDescription htPage line := apply(function strconc, reverse! $htLineList) issueHT line endHTPage() writeSaturnLines lines == for line in lines repeat if line ~= '"" and stringChar(line,0) = char "\" then saturnTERPRI() saturnPRINTEXP line writeSaturn(line) == k := 0 n := maxIndex line while --advance k if true k > n => false stringChar(line,k) ~= char "\" => true code := isBreakSegment?(line, k + 1,n) => false true repeat (k := k + 1) k > n => writeSaturnPrint(line) segment := subString(line,0,k) writeSaturnPrint(segment) code = 1 => writeSaturnPrint('"\\") writeSaturn subString(line,k + 2) code = 2 => writeSaturnPrint('" &") writeSaturn subString(line,k + 4) code = 3 => writeSaturnPrint('"\item") writeSaturn subString(line,k + 5) code = 4 => writeSaturnPrint('"\newline") writeSaturn subString(line,k + 8) code = 5 => writeSaturnPrint('"\table{") $marg := $marg + 3 writeSaturnTable subString(line,k + 7) code = 6 => i := charPosition(char "}",line,k + 4) tabCode := subString(line,k, i - k + 1) writeSaturnPrint tabCode line := subString(line,i + 1) writeSaturn line code = 7 => saturnTERPRI() writeSaturn subString(line, k + 2) code = 8 => i := substring?('"\beginmenu", line,k) => k + 9 substring?('"\beginscroll",line,k) => k + 11 charPosition(char "}",line,k) if char "[" = line.(i + 1) then i := charPosition(char "]", line, i + 2) beginCode := subString(line,k, i - k + 1) writeSaturnPrint(beginCode) line := subString(line,i + 1) writeSaturn line code = 9 => i := substring?('"\endmenu",line,k) => k + 7 substring?('"\endscroll",line,k) => k + 9 charPosition(char "}",line,k) endCode := subString(line,k, i - k + 1) writeSaturnPrint(endCode) line := subString(line,i + 1) $marg := $marg - 3 writeSaturn line systemError code isBreakSegment?(line, k, n) == k > n => nil char2 := line . k char2 = (char "\") => 1 char2 = (char "&") => substring?('"&\&", line, k) => 2 nil char2 = char "i" => substring?('"item",line,k) => 3 nil char2 = char "n" => substring?('"newline",line,k) => 4 nil char2 = char "t" => (k := k + 2) > n => nil line.(k - 1) = char "a" and line.k = char "b" => (k := k + 1) > n => nil line.k = char "{" => 6 substring?('"table",line,k - 3) => 5 nil char2 = char "!" => 7 char2 = char "b" => substring?('"begin",line,k) => 8 nil char2 = (char "e") => substring?('"end",line,k) => 9 nil nil writeSaturnPrint s == for i in 0..($marg - 1) repeat saturnPRINTEXP '" " saturnPRINTEXP s saturnTERPRI() saturnPRINTEXP s == $browserOutputStream => PRINC(s,$browserOutputStream) PRINC s saturnTERPRI() == $browserOutputStream => writeNewline $browserOutputStream finishLine $OutputStream writeSaturnTable line == open := charPosition(char "{",line,0) close:= charPosition(char "}",line,0) open < close => close := findBalancingBrace(line,open + 1,maxIndex line,0) or error '"no balancing brace" writeSaturnPrint subString(line,0,close + 1) writeSaturnTable subString(line,close + 1) $marg := $marg - 3 writeSaturnPrint subString(line,0,close + 1) writeSaturn subString(line, close + 1) findBalancingBrace(s,k,n,level) == k > n => nil c := s . k c = char "{" => findBalancingBrace(s, k + 1, n, level + 1) c = char "}" => level = 0 => k findBalancingBrace(s, k + 1, n, level - 1) findBalancingBrace(s, k + 1, n, level) --======================================================================= -- htMakePage and friends --======================================================================= htMakePageStandard itemList == $saturn => nil htMakePage itemList htMakePageSaturn itemList == $standard => nil htMakePage itemList htMakePage itemList == if $newPage then if $saturn then htpAddToPageDescription($saturnPage, saturnTran itemList) if $standard then htpAddToPageDescription($curPage, itemList) htMakePage1 itemList htMakePage1 itemList == -- make a page given the description in itemList for u in itemList repeat itemType := 'text items := string? u => u u isnt [.,:.] => STRINGIMAGE u string? first u => u u is ['text, :s] => s itemType := first u rest u itemType = 'text => iht items -- $saturn => bcHt items -- $standard => iht items itemType = 'lispLinks => htLispLinks items itemType = 'lispmemoLinks => htLispMemoLinks items itemType = 'bcLinks => htBcLinks items ---> itemType = 'bcLinksNS => htBcLinks(items,true) itemType = 'bcLispLinks => htBcLispLinks items ---> itemType = 'radioButtons => htRadioButtons items itemType = 'bcRadioButtons => htBcRadioButtons items itemType = 'inputStrings => htInputStrings items itemType = 'domainConditions => htProcessDomainConditions items itemType = 'bcStrings => htProcessBcStrings items itemType = 'toggleButtons => htProcessToggleButtons items itemType = 'bcButtons => htProcessBcButtons items itemType = 'doneButton => htProcessDoneButton items itemType = 'doitButton => htProcessDoitButton items systemError '"unexpected branch" saturnTran x == x is [[kind, [s1, s2, :callTail]]] and kind in '(bcLinks bcLispLinks) => text := saturnTranText s2 fs := getCallBackFn callTail y := isMenuItemStyle? s1 => ----> y is text for button in 2nd column t1 := mkDocLink(fs, mkMenuButton()) y = '"" => s2 = '"" => t1 mkTabularItem [t1, text] t2 := mkDocLink(fs, y) mkTabularItem [t1, t2, text] t := mkDocLink(fs, s1) [:t, :text] x is [['text,:r],:.] => r error nil mkBold s == secondPart := s isnt [.,:.] => [s, '"}"] [:s, '"}"] ['"{\bf ", :secondPart] mkMenuButton() == [menuButton()] menuButton() == '"\menuitemstyle{}" -- Saturn must translate \menuitemstyle ==> {\menuButton} --------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) --replaces htMakeButton getCallBackFn form == func := mkCurryFun(first form, rest form) strconc('"(|htDoneButton| '|", func, '"| ",htpName page(), '")") mkDocLink(code,s) == if code isnt [.,:.] then code := [code] if s isnt [.,:.] then s := [s] ['"\lispLink[d]{\verb!", :code, '"!}{", :s, '"}"] saturnTranText x == string? x => [unTab x] null x => nil r is [s,fn,:.] and s = '"\unixcommand{" => ['"{\it ",s,'".spad}"] x is [['text, :s],:r] => unTab [:s, :saturnTranText r] error nil isMenuItemStyle? s == 15 = ('"\menuitemstyle{" < s) => subString(s,15,(maxIndex s) - 15) nil getCallBack callTail == LASSOC(callTail, $callTailList) or callTail is [fn] => callTail error nil --======================================================================= -- Redefinitions from hypertex.boot --======================================================================= endHTPage() == $standard => sockSendInt($MenuServer, $EndOfPage) nil --======================================================================= -- Redefinitions from ht-util.boot --======================================================================= htSayHrule() == bcHt $saturn => '"\hrule{}\newline{}" '"\horizontalline{}\newline{}" htDoneButton(func, htPage, :optionalArgs) == ------> Handle argument values passed from page if present if optionalArgs ~= nil then htpSetInputAreaAlist(htPage,first optionalArgs) typeCheckInputAreas htPage => htMakeErrorPage htPage not functionSymbol? func => systemError ['"unknown function", func] apply(symbolFunction func, [htPage]) htBcLinks(links,:options) == skipStateInfo? := IFCAR options [links,options] := beforeAfter('options,links) for [message, info, func, :value] in links repeat link := $saturn => '"\lispLink[d]" '"\lispdownlink" htMakeButton(link,message, mkCurryFun(func, value),skipStateInfo?) bcIssueHt info htBcLispLinks links == [links,options] := beforeAfter('options,links) for [message, info, func, :value] in links repeat link := $saturn => '"\lispLink[n]" '"\lisplink" htMakeButton(link ,message, mkCurryFun(func, value)) bcIssueHt info htMakeButton(htCommand, message, func,:options) == $saturn => htMakeButtonSaturn(htCommand, message, func, options) skipStateInfo? := IFCAR options iht [htCommand, '"{"] bcIssueHt message skipStateInfo? => iht ['"}{(|htDoneButton| '|", func, '"| ",htpName $curPage, '")}"] iht ['"}{(|htDoneButton| '|", func, '"| (PROGN "] for [id, ., ., ., type, :.] in htpInputAreaAlist $curPage repeat iht ['"(|htpSetLabelInputString| ", htpName $curPage, '"'|", id, '"| "] if type = 'string then iht ['"_"\stringvalue{", id, '"}_""] else iht ['"_"\boxvalue{", id, '"}_""] iht '") " iht [htpName $curPage, '"))}"] htMakeButtonSaturn(htCommand, message, func,options) == skipStateInfo? := IFCAR options iht htCommand skipStateInfo? => iht ['"{\verb!(|htDoneButton| '|", func, '"| ",htpName page(), '")!}{"] bcIssueHt message iht '"}" iht ['"{\verb!(|htDoneButton| '|", func, '"| "] if $kPageSaturnArguments then iht '"(PROGN " for id in $kPageSaturnArguments for var in $PatternVariableList repeat iht ['"(|htpSetLabelInputString| ", htpName page(), '"'|", var, '"| "] iht ["'|!\", id, '"\verb!|"] iht '")" iht htpName $saturnPage iht '")" else iht htpName $saturnPage iht '")!}{" bcIssueHt message iht '"}" htpAddToPageDescription(htPage, pageDescrip) == newDescript := string? pageDescrip => [pageDescrip, :htPage.7] append!(reverse! copyList pageDescrip, htPage.7) htPage.7 := newDescript htProcessBcStrings strings == for [numChars, default, stringName, spadType, :filter] in strings repeat mess2 := '"" if null LASSOC(stringName, htpInputAreaAlist page()) then setUpDefault(stringName, ['string, default, spadType, filter]) if htpLabelErrorMsg(page(), stringName) then iht ['"\centerline{{\em ", htpLabelErrorMsg(page(), stringName), '"}}"] mess2 := strconc(mess2, bcSadFaces()) htpSetLabelErrorMsg(page(), stringName, nil) iht ['"\inputstring{", stringName, '"}{", numChars, '"}{", htpLabelDefault(page(),stringName), '"} ", mess2] setUpDefault(name, props) == htpAddInputAreaProp(page(), name, props) htInitPage(title, propList) == -- start defining a hyperTeX page htInitPageNoScroll(propList, title) htSayStandard '"\beginscroll " page() --------------------> NEW DEFINITION <-------------------------- htInitPageNoScroll(propList, :options) == --start defining a hyperTeX page $atLeastOneUnexposed := nil --reset every time a new page is initialized $saturnContextMenuLines := nil title := IFCAR options $curPage := $standard => htpMakeEmptyPage propList nil if $saturn then $saturnPage := htpMakeEmptyPage propList $newPage := true $htLineList := nil if title then if $standard then htSayStandard ['"\begin{page}{", htpName $curPage, '"}{"] htSaySaturn '"\browseTitle{" htSay title htSaySaturn '"}" htSayStandard '"} " page() --------------------> NEW DEFINITION <-------------------------- htInitPageNoHeading(propList) == --start defining a hyperTeX page $curPage := $standard => htpMakeEmptyPage propList if $saturn then $saturnPage := htpMakeEmptyPage propList $newPage := true $htLineList := nil page() --------------------> NEW DEFINITION <-------------------------- htpMakeEmptyPage propList == name := gensym() importSymbol name if not $saturn then $activePageList := [name, :$activePageList] symbolValue(name) := vector [name, nil, nil, nil, nil, nil, propList, nil] --======================================================================= -- Redefinitions from br-con.boot --======================================================================= kPage(line,:options) == --any cat, dom, package, default package --constructors Cname\#\E\sig \args \abb \comments (C is C, D, P, X) parts := dbXParts(line,7,1) [kind,name,nargs,xflag,sig,args,abbrev,comments] := parts form := IFCAR options isFile := null kind kind := kind or '"package" parts.first := kind conform := mkConform(kind,name,args) $kPageSaturnArguments: local := rest conform conname := opOf conform capitalKind := capitalize kind signature := ncParseFromString sig sourceFileName := getConstructorSourceFileFromDB makeSymbol name constrings := KDR form => dbConformGenUnder form [strconc(name,args)] emString := ['"{\sf ",:constrings,'"}"] heading := [capitalKind,'" ",:emString] if not isExposedConstructor conname then heading := ['"Unexposed ",:heading] if name=abbrev then abbrev := asyAbbreviation(conname,nargs) page := htInitPageNoScroll nil htAddHeading heading htSayStandard("\beginscroll ") htpSetProperty(page,'argSublis,mkConArgSublis rest conform) htpSetProperty(page,'isFile,true) htpSetProperty(page,'parts,parts) htpSetProperty(page,'heading,heading) htpSetProperty(page,'kind,kind) htpSetProperty(page,'conform,conform) htpSetProperty(page,'signature,signature) ---what follows is stuff from kiPage with domain = nil $conformsAreDomains := nil dbShowConsDoc1(page,conform,nil) if kind ~= 'category and nargs > 0 then addParameterTemplates(page,conform) if $atLeastOneUnexposed then htSay '"\newline{}{\em *} = unexposed" htSayStandard("\endscroll ") kPageContextMenu page htShowPageNoScroll() kPageContextMenu page == $saturn => kPageContextMenuSaturn page [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(page,'parts) conform := htpProperty(page,'conform) conname := opOf conform htBeginTable() htSay '"{" htMakePage [['bcLinks,['Ancestors,'"",'kcaPage,nil]]] htSay '"}{" htMakePage [['bcLinks,['Attributes,'"",'koPage,'"attribute"]]] if kind = '"category" then htSay '"}{" htMakePage [['bcLinks,['Children,'"",'kccPage,nil]]] htSay '"}{" htMakePage [['bcLinks,['Dependents,'"",'kcdePage,nil]]] if kind = '"category" then htSay '"}{" htMakePage [['bcLinks,['Descendents,'"",'kcdPage,nil]]] if kind = '"category" then htSay '"}{" htMakePage [['bcLinks,['Domains,'"",'kcdoPage,nil]]] htSay '"}{" if kind ~= '"category" and (pathname := dbHasExamplePage conname) then htMakePage [['bcLinks,['Examples,'"",'kxPage,pathname]]] else htSay '"{\em Examples}" htSay '"}{" htMakePage [['bcLinks,['Exports,'"",'kePage,nil]]] htSay '"}{" htMakePage [['bcLinks,['Operations,'"",'koPage,'"operation"]]] htSay '"}{" htMakePage [['bcLinks,['Parents,'"",'kcpPage,'"operation"]]] if kind ~= '"category" then htSay '"}{" htMakePage [['bcLinks,["Search Path",'"",'ksPage,nil]]] if kind ~= '"category" then htSay '"}{" htMakePage [['bcLinks,['Users,'"",'kcuPage,nil]]] htSay '"}{" htMakePage [['bcLinks,['Uses,'"",'kcnPage,nil]]] htSay '"}" if $standard then htEndTable() kPageContextMenuSaturn page == $newPage : local := nil [kind,name,nargs,xpart,sig,args,abbrev,comments] := htpProperty(page,'parts) $htLineList : local := nil conform := htpProperty(page,'conform) conname := opOf conform htMakePage [['bcLinks,['"\&Ancestors",'"",'kcaPage,nil]]] htMakePage [['bcLinks,['"Attri\&butes",'"",'koPage,'"attribute"]]] if kind = '"category" then htMakePage [['bcLinks,['"\&Children",'"",'kccPage,nil]]] htMakePage [['bcLinks,['"\&Dependents",'"",'kcdePage,nil]]] if kind = '"category" then htMakePage [['bcLinks,['"Desce\&ndents",'"",'kcdPage,nil]]] if kind = '"category" then htMakePage [['bcLinks,['"Do\&mains",'"",'kcdoPage,nil]]] if kind ~= '"category" and (name := saturnHasExamplePage conname) then saturnExampleLink name else htSayCold '"E\&xamples" htMakePage [['bcLinks,['"\&Exports",'"",'kePage,nil]]] htMakePage [['bcLinks,['"\&Operations",'"",'koPage,'"operation"]]] htMakePage [['bcLinks,['"\&Parents",'"",'kcpPage,'"operation"]]] htMakePage [['bcLinks,['"Search O\&rder",'"",'ksPage,nil]]] if kind ~= '"category" or dbpHasDefaultCategory? xpart then htMakePage [['bcLinks,['"\&Users",'"",'kcuPage,nil]]] htMakePage [['bcLinks,['"U\&ses",'"",'kcnPage,nil]]] else htSayCold '"\&Users" htSayCold '"U\&ses" $saturnContextMenuLines := $htLineList saturnExampleLink lname == htSay '"\docLink{\csname " htSay strconc(second lname, '"\endcsname}{E&xamples}") $exampleConstructors := nil saturnHasExamplePage conname == if not $exampleConstructors then $exampleConstructors := getSaturnExampleList() objectAssoc(conname, $exampleConstructors) getSaturnExampleList() == file := strconc(systemRootDirectory(), "/doc/axug/examples.lsp") not PROBE_-FILE file => nil fp := MAKE_-INSTREAM file lst := VMREAD fp SHUT fp lst dbPresentCons(htPage,kind,:exclusions) == $saturn => dbPresentConsSaturn(htPage,kind,exclusions) htpSetProperty(htPage,'exclusion,first exclusions) cAlist := htpProperty(htPage,'cAlist) empty? := null cAlist one? := null rest cAlist one? := empty? or one? exposedUnexposedFlag := $includeUnexposed? --used to be star? 4/92 star? := true --always include information on exposed/unexposed 4/92 if $standard then htBeginTable() htSay '"{" if one? or 'abbrs in exclusions then htSay '"{\em Abbreviations}" else htMakePage [['bcLispLinks,['"Abbreviations",'"",'dbShowCons,'abbrs]]] htSay '"}{" if one? or 'conditions in exclusions or "and"/[rest x = true for x in cAlist] then htSay '"{\em Conditions}" else htMakePage [['bcLispLinks,['"Conditions",'"",'dbShowCons,'conditions]]] htSay '"}{" if empty? or 'documentation in exclusions then htSay '"{\em Descriptions}" else htMakePage [['bcLispLinks,['"Descriptions",'"",'dbShowCons,'documentation]]] htSay '"}{" if one? or null rest cAlist then htSay '"{\em Filter}" else htMakePage [['bcLinks,['"Filter",'"",'htFilterPage,['dbShowCons,'filter]]]] htSay '"}{" if one? or 'kinds in exclusions or kind ~= 'constructor then htSay '"{\em Kinds}" else htMakePage [['bcLispLinks,['"Kinds",'"",'dbShowCons,'kinds]]] htSay '"}{" if one? or 'names in exclusions then htSay '"{\em Names}" else htMakePage [['bcLispLinks,['"Names",'"",'dbShowCons,'names]]] htSay '"}{" if one? or 'parameters in exclusions or not ("or"/[CDAR x for x in cAlist]) then htSay '"{\em Parameters}" else htMakePage [['bcLispLinks,['"Parameters",'"",'dbShowCons,'parameters]]] htSay '"}{" if $exposedOnlyIfTrue then if one? then htSay '"{\em Unexposed Also}" else htMakePage [['bcLinks,['"Unexposed Also",'"",'dbShowCons,'exposureOff]]] else if one? then htSay '"{\em Exposed Only}" else htMakePage [['bcLinks,['"Exposed Only",'"",'dbShowCons,'exposureOn]]] htSay '"}" if $standard then htEndTable() dbPresentConsSaturn(htPage,kind,exclusions) == $htLineList : local := nil $newPage : local := nil htpSetProperty(htPage,'exclusion,first exclusions) cAlist := htpProperty(htPage,'cAlist) empty? := null cAlist one? := null KDR cAlist one? := empty? or one? exposedUnexposedFlag := $includeUnexposed? --used to be star? 4/92 star? := true --always include information on exposed/unexposed 4/92 if $standard then htBeginTable() if one? or 'abbrs in exclusions then htSayCold '"\&Abbreviations" else htMakePage [['bcLispLinks,['"\&Abbreviations",'"",'dbShowCons,'abbrs]]] if one? or 'conditions in exclusions or "and"/[rest x = true for x in cAlist] then htSayCold '"\&Conditions" else htMakePage [['bcLispLinks,['"\&Conditions",'"",'dbShowCons,'conditions]]] if empty? or 'documentation in exclusions then htSayCold '"\&Descriptions" else htMakePage [['bcLispLinks,['"\&Descriptions",'"",'dbShowCons,'documentation]]] if one? or null rest cAlist then htSayCold '"\&Filter" else htMakeSaturnFilterPage ['dbShowCons, 'filter] if one? or 'kinds in exclusions or kind ~= 'constructor then htSayCold '"\&Kinds" else htMakePage [['bcLispLinks,['"\&Kinds",'"",'dbShowCons,'kinds]]] if one? or 'names in exclusions then htSayCold '"\&Names" else htMakePage [['bcLispLinks,['"\&Names",'"",'dbShowCons,'names]]] if one? or 'parameters in exclusions or not ("or"/[CDAR x for x in cAlist]) then htSayCold '"\&Parameters" else htMakePage [['bcLispLinks,['"\&Parameters",'"",'dbShowCons,'parameters]]] htSaySaturn '"\hrule" if $exposedOnlyIfTrue then if one? then htSayCold '"\&Unexposed Also" else htMakePage [['bcLinks,['"\&Unexposed Also",'"",'dbShowCons,'exposureOff]]] else if one? then htSayCold '"\Exposed Only\&y" else htMakePage [['bcLinks,['"Exposed Onl\&y",'"",'dbShowCons,'exposureOn]]] if $standard then htEndTable() $saturnContextMenuLines := $htLineList htFilterPage(htPage,args) == htInitPage("Filter String",htCopyProplist htPage) htSay "\centerline{Enter filter string (use {\em *} for wild card):}" htSay '"\centerline{" htMakePage [['bcStrings, [50,'"",'filter,'EM]]] htSay '"}\vspace{1}\centerline{" htMakePage [['bcLispLinks,['"\fbox{Filter}",'"",:args]]] htSay '"}" htShowPage() htMakeSaturnFilterPage [fn2Call,:args] == htSay '"\inputboxLink[\lispLink[d]{\verb+(|" htSay fn2Call htSay '"| " htSay htpName $saturnPage for x in args repeat htSay '" '|" htSay x htSay '"|" htSay '" _"+_\FILTERSTRING\verb+_")+}{}]{\FILTERSTRING}{*}" htSay '"{\centerline{Enter filter string (use {\em *} for wild card):}}" htSay '"{Filter Page}{\&Filter}" dbShowConsKinds cAlist == cats := doms := paks := defs := nil for x in cAlist repeat op := CAAR x kind := dbConstructorKind constructorDB op kind = 'category => cats := [x,:cats] kind = 'domain => doms := [x,:doms] kind = 'package => paks := [x,:paks] defs := [x,:defs] lists := [reverse! cats,reverse! doms,reverse! paks,reverse! defs] htBeginMenu 'description htSayStandard '"\indent{1}" kinds := +/[1 for x in lists | #x > 0] firstTime := true for kind in '("category" "domain" "package" "default package") for x in lists | #x > 0 repeat if firstTime then firstTime := false else htSaySaturn '"\\" htSaySaturn '"\item[" htSayStandard '"\item" if kinds = 1 then htSay menuButton() else htMakePage [['bcLinks,[menuButton(),'"",'dbShowConsKindsFilter,[kind,x]]]] htSaySaturn '"]" htSayStandard '"\tab{1}" htSay('"{\em ",c := #x,'" ") htSay(c > 1 => pluralize kind; kind) htSay '":}" htSaySaturn '"\\" bcConTable removeDuplicates [CAAR y for y in x] htEndMenu 'description htSayStandard '"\indent{0}" addParameterTemplates(page, conform) == ---------------> from kPage <----------------------- parlist := [STRINGIMAGE par for par in rest conform] manuelsCode? := "MAX"/[#s for s in parlist] > 10 w := (manuelsCode? => 55; 23) htSaySaturn '"\colorbuttonbox{lightgray}{" htSay '"Optional argument value" htSay rest parlist => '"s:" '":" htSaySaturn '"}" if rest conform then htSaySaturn '"\newline{}" htSaySaturn '"\begin{tabular}{p{.25in}l}" firstTime := true odd := false argSublis := htpProperty(page,'argSublis) for parname in $PatternVariableList for par in rest conform repeat htSayStandard (odd or manuelsCode? => "\newline";"\tab{29}") if firstTime then firstTime := false else htSaySaturn '"\\" odd := not odd argstring := $conArgstrings is [a,:r] => ($conArgstrings := r; a) '"" htMakePageStandard [['text,'"{\em ",par,'"} = "], ['bcStrings,[w - #STRINGIMAGE par,argstring,parname,'EM]]] if $saturn then setUpDefault(parname, ['string, '"", 'EM, nil]) htSaySaturn '"{\em " htSaySaturn par htSaySaturn '" = }" htSaySaturnAmpersand() htSaySaturn '"\colorbuttonbox{lightgray}{\inputbox[2.5in]{\" htSaySaturn applySubst(argSublis,par) htSaySaturn '"}{" htSaySaturn argstring htSaySaturn '"}}" htEndTabular() kPageArgs([op,:args],[.,.,:source]) == htSaySaturn '"\begin{tabular}{p{.25in}lp{0in}}" firstTime := true coSig := builtinConstructor? op => [true for . in args] rest getDualSignature op for x in args for t in source for pred in coSig repeat if firstTime then firstTime := false else htSaySaturn '"\\" htSayStandard '", and" htSayStandard '"\newline " htSaySaturnAmpersand() typeForm := (t is [":",.,t1] => t1; t) if pred = true then htMakePage [['bcLinks,[x,'"",'kArgPage,x]]] else htSay('"{\em ",x,'"}") htSayStandard( '"\tab{",toString(#PNAME x),'"}, ") htSaySaturnAmpersand() htSay pred => '"a domain of category " '"an element of the domain " bcConform(typeForm,true) htEndTabular() --======================================================================= -- Redefinitions from br-op1.boot --======================================================================= dbConform form == --one button for the main constructor page of a type $saturn => ["\lispLink[d]{\verb!(|conPage| '",:form2Fence dbOuttran form,'")!}{", :form2StringList opOf form,"}"] ["\conf{",:form2StringList opOf form,'"}{",:form2Fence dbOuttran form,'"}"] htTab s == $standard => htSayStandard ('"\tab{",s,'"}") nil dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) == single? := null rest data htBeginMenu 'description bincount := 0 for [thing,exposeFlag,:items] in data repeat htSaySaturn '"\item[" htSayStandard ('"\item") if single? then htSay(menuButton()) else htMakePageStandard [['bcLinks,[menuButton(),'"",'dbShowOps,which,bincount]]] button := mkButtonBox (1 + bincount) htMakePageSaturn [['bcLinks,[button,'"",'dbShowOps,which,bincount]]] htSaySaturn '"]" htSay '"{\em " htSay thing = 'nowhere => '"implemented nowhere" thing = 'constant => '"constant" thing = '_$ => '"by the domain" integer? thing => '"unexported" constructorIfTrue => htSay word thing isnt [.,:.] => '" an unknown constructor" '"" thing isnt [.,:.] => '"unconditional" '"" htSay '"}" if cons? thing then if constructorIfTrue then htSay('" {\em ",dbShowKind thing,'"}") htSay '" " apply(fn,[thing]) htSay('":\newline ") dbShowOpSigList(which,items,(1 + bincount) * 8192) bincount := bincount + 1 htEndMenu 'description dbPresentOps(htPage,which,:exclusions) == $saturn => dbPresentOpsSaturn(htPage,which,exclusions) fromConPage? := (conname := opOf htpProperty(htPage,'conform)) usage? := nil star? := not fromConPage? or which = '"package operation" implementation? := $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed? rightmost? := star? or (implementation? and not $includeUnexposed?) if integer? first exclusions then exclusions := ['documentation] htpSetProperty(htPage,'exclusion,first exclusions) opAlist := which = '"operation" => htpProperty(htPage,'opAlist) htpProperty(htPage,'attrAlist) empty? := null opAlist one? := opAlist is [entry] and 2 = #entry one? := empty? or one? htBeginTable() htSay '"{" if one? or 'conditions in exclusions or (htpProperty(htPage,'condition?) = 'no) then htSay '"{\em Conditions}" else htMakePage [['bcLispLinks,['"Conditions",'"",'dbShowOps,which,'conditions]]] htSay '"}{" if empty? or 'documentation in exclusions then htSay '"{\em Descriptions}" else htMakePage [['bcLispLinks,['"Descriptions",'"",'dbShowOps,which,'documentation]]] htSay '"}{" if null IFCDR opAlist then htSay '"{\em Filter}" else htMakePage [['bcLinks,['"Filter ",'"",'htFilterPage,['dbShowOps,which,'filter]]]] htSay '"}{" if one? or 'names in exclusions or null KDR opAlist then htSay '"{\em Names}" else htMakePage [['bcLispLinks,['"Names",'"",'dbShowOps,which,'names]]] if not star? then htSay '"}{" if not implementation? or 'implementation in exclusions or which = '"attribute" or ((conname := opOf htpProperty(htPage,'conform)) and getConstructorKindFromDB conname = "category") then htSay '"{\em Implementations}" else htMakePage [['bcLispLinks,['"Implementations",'"",'dbShowOps,which,'implementation]]] htSay '"}{" if one? or 'origins in exclusions then htSay '"{\em Origins}" else htMakePage [['bcLispLinks,['"Origins",'"",'dbShowOps,which,'origins]]] htSay '"}{" if one? or 'parameters in exclusions --also test for some parameter or not dbDoesOneOpHaveParameters? opAlist then htSay '"{\em Parameters}" else htMakePage [['bcLispLinks,['"Parameters",'"",'dbShowOps,which,'parameters]]] htSay '"}{" if which ~= '"attribute" then if one? or 'signatures in exclusions then htSay '"{\em Signatures}" else htMakePage [['bcLispLinks,['"Signatures",'"",'dbShowOps,which,'signatures]]] htSay '"}" if star? then htSay '"{" if $exposedOnlyIfTrue then if one? then htSay '"{\em Unexposed Also}" else htMakePage [['bcLinks,['"Unexposed Also",'"",'dbShowOps,which,'exposureOff]]] else if one? then htSay '"{\em Exposed Only}" else htMakePage [['bcLinks,['"Exposed Only",'"",'dbShowOps, which,'exposureOn]]] htSay '"}" htEndTable() dbPresentOpsSaturn(htPage,which,exclusions) == $htLineList : local := nil $newPage : local := nil fromConPage? := (conname := opOf htpProperty(htPage,'conform)) usage? := nil star? := not fromConPage? or which = '"package operation" implementation? := $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed? rightmost? := star? or (implementation? and not $includeUnexposed?) if integer? first exclusions then exclusions := ['documentation] htpSetProperty(htPage,'exclusion,first exclusions) opAlist := which = '"operation" => htpProperty(htPage,'opAlist) htpProperty(htPage,'attrAlist) empty? := null opAlist one? := opAlist is [entry] and 2 = #entry one? := empty? or one? if one? or 'conditions in exclusions or (htpProperty(htPage,'condition?) = 'no) then htSayCold '"\&Conditions" else htMakePage [['bcLispLinks,['"\&Conditions",'"",'dbShowOps,which,'conditions]]] if empty? or 'documentation in exclusions then htSayCold '"\&Descriptions" else htMakePage [['bcLispLinks,['"\&Descriptions",'"",'dbShowOps,which,'documentation]]] if null IFCDR opAlist then htSayCold '"\&Filter" else htMakeSaturnFilterPage ['dbShowOps, which, 'filter] if not implementation? or 'implementation in exclusions or which = '"attribute" or ((conname := opOf htpProperty(htPage,'conform)) and getConstructorKindFromDB conname = "category") then htSayCold '"\&Implementations" else htMakePage [['bcLispLinks,['"\&Implementations",'"",'dbShowOps,which,'implementation]]] if one? or 'names in exclusions or null KDR opAlist then htSayCold '"\&Names" else htMakePage [['bcLispLinks,['"\&Names",'"",'dbShowOps,which,'names]]] if one? or 'origins in exclusions then htSayCold '"\&Origins" else htMakePage [['bcLispLinks,['"\&Origins",'"",'dbShowOps,which,'origins]]] if one? or 'parameters in exclusions --also test for some parameter or not dbDoesOneOpHaveParameters? opAlist then htSayCold '"\&Parameters" else htMakePage [['bcLispLinks,['"\&Parameters",'"",'dbShowOps,which,'parameters]]] if which ~= '"attribute" then if one? or 'signatures in exclusions then htSayCold '"\&Signatures" else htMakePage [['bcLispLinks,['"\&Signatures",'"",'dbShowOps,which,'signatures]]] if star? then htSay '"\hrule" if $exposedOnlyIfTrue then if one? then htSayCold '"\&Unexposed Also" else htMakePage [['bcLinks,['"\&Unexposed Also",'"",'dbShowOps,which,'exposureOff]]] else if one? then htSayCold '"Exposed Onl\&y" else htMakePage [['bcLinks,['"Exposed Onl\&y",'"",'dbShowOps,which,'exposureOn]]] $saturnContextMenuLines := $htLineList --======================================================================= -- Redefinitions from br-search.boot --======================================================================= htShowPageStar() == $saturn => htShowPageStarSaturn() htSayStandard '"\endscroll " if $exposedOnlyIfTrue then htMakePage [['bcLinks,['"Unexposed Also",'"",'repeatSearch,nil]]] else htMakePage [['bcLinks,['"Exposed Only",'"",'repeatSearch,'T]]] htShowPageNoScroll() htShowPageStarSaturn() == $newPage : local := nil $htLineList : local := nil if $exposedOnlyIfTrue then htMakePage [['bcLinks,['"Unexposed Also",'"",'repeatSearch,nil]]] else htMakePage [['bcLinks,['"Exposed Only",'"",'repeatSearch,'T]]] $saturnContextMenuLines := $htLineList htShowPageNoScroll() --======================================================================= -- Redefinitions from br-op2.boot --======================================================================= ++ returns true if op designate a niladic constructor. Note that ++ constructors are symbols whereas ordinary operations are strings. operationIsNiladicConstructor op == ident? op => niladicConstructor? op false ++ Like operationIsNiladicConstructor() except that we just want ++ to know whether `op' is a constructor, arity is unimportant. operationIsConstructor op == ident? op => getDualSignature op nil --------------> NEW DEFINITION (see br-op2.boot.pamphlet) displayDomainOp(htPage,which,origin,op,sig,predicate, doc,index,chooseFn,unexposed?,$generalSearch?) == $chooseDownCaseOfType : local := true --see dbGetContrivedForm $whereList : local := nil $NumberList : local := '(i j k l m n i1 j1 k1 l1 m1 n1 i2 j2 k2 l2 m2 n2 i3 j3 k3 l3 m3 n3 i4 j4 k4 l4 m4 n4 ) $ElementList: local := '(x y z u v w x1 y1 z1 u1 v1 w1 x2 y2 z2 u2 v2 w2 x3 y3 z3 u3 v3 w3 x4 y4 z4 u4 v4 w4 ) $FunctionList:local := '(f g h d e F G H) $DomainList: local := '(D R S E T A B C M N P Q U V W) exactlyOneOpSig := null index conform := htpProperty(htPage,'domname) or htpProperty(htPage,'conform) or origin if $generalSearch? then $DomainList := rest $DomainList opform := which = '"attribute" => null sig => [op] [op,sig] which = '"constructor" => origin dbGetDisplayFormForOp(op,sig,doc) htSayStandard('"\newline") ----------------------------------------------------------- htSaySaturn '"\item[" if exactlyOneOpSig then htSay menuButton() else htMakePage [['bcLinks,[menuButton(),'"",chooseFn,which,index]]] htSaySaturn '"]" htSayStandard '"\tab{2}" op := IFCAR opform args := IFCDR opform ops := escapeSpecialChars STRINGIMAGE op n := #sig do n = 2 and symbolTarget('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}") n = 3 and symbolTarget('Led,PROPLIST op) => htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}") if unexposed? and $includeUnexposed? then htSayUnexposed() htSay(ops) predicate='ASCONST or operationIsNiladicConstructor op or op in '(0 1) => 'skip which = '"attribute" and null args => 'skip htSay('"(") if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}") for x in IFCDR args repeat htSay('",{\em ",quickForm2HtString x,'"}") htSay('")") -----------prepare to print description--------------------- constring := form2HtString conform conname := first conform $conkind : local := htpProperty(htPage,'kind) -- a string e.g. "category" or STRINGIMAGE getConstructorKindFromDB conname $conlength : local := #constring $conform : local := conform $conargs : local := rest conform if which = '"operation" then $signature : local := builtinFunctorName? conname => nil getConstructorModemap(conname).mmSignature --RDJ: this next line is necessary until compiler bug is fixed --that forgets to substitute #variables for t#variables; --check the signature for SegmentExpansionCategory, e.g. tvarlist := take(# $conargs,$TriangleVariableList) $signature := applySubst(pairList(tvarlist,$FormalMapVariableList),$signature) $sig := which = '"attribute" or which = '"constructor" => sig $conkind ~= '"package" => sig symbolsUsed := [x for x in rest conform | ident? x] $DomainList := setDifference($DomainList,symbolsUsed) getSubstSigIfPossible sig ----------------------------------------------------------- htSaySaturn '"\begin{tabular}{lp{0in}}" ----------------------------------------------------------- if which in '("operation" "constructor") then $displayReturnValue: local := nil if args then htSayStandard('"\newline\tab{2}{\em Arguments:}") htSaySaturn '"{\em Arguments:}" htSaySaturnAmpersand() firstTime := true coSig := builtinConstructor? op => [true for . in args] not constructor? op => nil --check if op is constructor getDualSignature op for a in args for t in rest $sig repeat if not firstTime then htSaySaturn '"\\ " htSaySaturnAmpersand() firstTime := false htSayIndentRel(15, true) position := KAR relatives relatives := KDR relatives if KAR coSig and t ~= '(Type) then htMakePage [['bcLinks,[a,'"",'kArgPage,a]]] else htSay('"{\em ",form2HtString(a),'"}") htSay ", " coSig := KDR coSig htSayValue t htSayIndentRel(-15,true) htSayStandard('"\newline ") htSaySaturn '"\\" if first $sig then $displayReturnValue := true htSayStandard('"\newline\tab{2}") htSay '"{\em Returns:}" htSaySaturnAmpersand() htSayIndentRel(15, true) htSayValue first $sig htSayIndentRel(-15, true) htSaySaturn '"\\" ----------------------------------------------------------- if origin and ($generalSearch? or origin ~= conform) and op~=opOf origin then htSaySaturn '"{\em Origin:}" htSaySaturnAmpersand() htSayStandard('"\newline\tab{2}{\em Origin:}") htSayIndentRel(15) if not isExposedConstructor opOf origin and $includeUnexposed? then htSayUnexposed() bcConform(origin,true) htSayIndentRel(-15) htSaySaturn '"\\" ----------------------------------------------------------- if not (predicate in '(T ASCONST)) then pred := sublisFormal(KDR conform,predicate) count := #pred htSaySaturn '"{\em Conditions:}" htSayStandard('"\newline\tab{2}{\em Conditions:}") firstTime := true for p in displayBreakIntoAnds substitute($conform,"$",pred) repeat if not firstTime then htSaySaturn '"\\" htSayIndentRel(15,count > 1) firstTime := false htSaySaturnAmpersand() bcPred(p,$conform,true) htSayIndentRel(-15,count > 1) htSayStandard('"\newline ") htSaySaturn '"\\" ----------------------------------------------------------- if $whereList then count := #$whereList htSaySaturn '"{\em Where:}" htSayStandard('"\newline\tab{2}{\em Where:}") firstTime := true if symbolAssoc("$",$whereList) then htSayIndentRel(15,true) htSaySaturnAmpersand() htSayStandard '"{\em \$} is " htSaySaturn '"{\em \%} is " htSay $conkind = '"category" => '"of category " '"the domain " bcConform(conform,true,true) firstTime := false htSayIndentRel(-15,true) for [d,key,:t] in $whereList | d ~= "$" repeat htSayIndentRel(15,count > 1) if not firstTime then htSaySaturn '"\\ " htSaySaturnAmpersand() firstTime := false htSay("{\em ",d,"} is ") htSayConstructor(key,sublisFormal(KDR conform,t)) htSayIndentRel(-15,count > 1) htSaySaturn '"\\" ----------------------------------------------------------- if doc ~= nil and doc isnt '"" and (doc isnt [d] or d ~= '"") then htSaySaturn '"{\em Description:}" htSaySaturnAmpersand() htSayStandard('"\newline\tab{2}{\em Description:}") htSayIndentRel(15) if doc = $charFauxNewline then htSay $charNewline else ndoc:= -- we are confused whether doc is a string or a list of strings cons? doc => [SUBSTITUTE($charNewline, $charFauxNewline, i) for i in doc] SUBSTITUTE($charNewline, $charFauxNewline,doc) htSay ndoc -- htSaySaturn '"\\" htSayIndentRel(-15) --------> print abbr and source file for constructors <--------- if which = '"constructor" then if (abbr := getConstructorAbbreviationFromDB conname) then htSaySaturn '"\\" htSaySaturn '"{\em Abbreviation:}" htSaySaturnAmpersand() htSayStandard('"\tab{2}{\em Abbreviation:}") htSayIndentRel(15) htSay abbr htSayIndentRel(-15) htSayStandard('"\newline{}") if ( $saturn and (link := saturnHasExamplePage conname)) then htSaySaturn '"\\" htSaySaturn '"{\em Examples:}" htSaySaturnAmpersand() htSayIndentRel(15) htSay '"\spadref{" htSay second link htSay '"}" htSayIndentRel(-15) htSayStandard('"\newline{}") htSaySaturn '"\\" htSaySaturn '"{\em Source File:}" htSaySaturnAmpersand() htSayStandard('"\tab{2}{\em Source File:}") htSayIndentRel(15) htSaySourceFile conname htSayIndentRel(-15) ------------------> remove profile printouts for now <------------------- if $standard and exactlyOneOpSig and (infoAlist := htpProperty(htPage,'infoAlist)) then displayInfoOp(htPage,infoAlist,op,sig) ----------------------------------------------------------- htSaySaturn '"\end{tabular}" htSaySourceFile conname == sourceFileName := (getConstructorSourceFileFromDB conname or '"none") filename := extractFileNameFromPath sourceFileName htMakePage [['text,'"\unixcommand{",filename,'"}{", textEditor(), '" ", sourceFileName, '" ", conname, '"}"]] htSayIndentRel(n,:options) == flag := IFCAR options m := abs n if flag then m := m + 2 if $standard then htSayStandard n > 0 => flag => ['"\indent{",toString m,'"}\tab{-2}"] ['"\indent{",toString m,'"}\tab{0}"] n < 0 => ['"\indent{0}\newline "] htSayUnexposed() == htSay '"{\em *}" $atLeastOneUnexposed := true --======================================================================= -- Page Operations --======================================================================= htEndTabular() == htSaySaturn '"\end{tabular}" htPopSaturn s == pageDescription := $saturnPage.7 pageDescription is [=s,:b] => $saturnPage.7 := rest pageDescription nil htBeginTable() == htSaySaturn '"\begin{dirlist}[lv]" htSayStandard '"\table{" htEndTable() == htSaySaturn '"\end{dirlist}" htSayStandard '"}" htBeginMenu(kind,:options) == skip := IFCAR options if $saturn then kind = 'description => htSaySaturn '"\begin{description}" htSaySaturn '"\begin{tabular}" htSaySaturn kind = 3 => '"{llp{0in}}" kind = 2 => '"{lp{0in}}" error nil null skip => htSayStandard '"\beginmenu " nil htEndMenu(kind) == if $saturn then kind = 'description => htSaySaturn '"\end{description}" htPopSaturn '"\\" htSaySaturn '"\end{tabular}" htSayStandard '"\endmenu " htSayConstructorName(nameShown, name) == if $saturn then code := ['"(|conPage| '|", name, '"|)"] htSaySaturn mkDocLink(code,nameShown) if $standard then htSayStandard ["\lispdownlink{",nameShown,'"}{(|conPage| '|",name,'"|)}"] htAddHeading(title) == htNewPage title page() ------------> called by htAddHeading, htInitPageNoScroll <----------- htNewPage title == if $saturn then htSaySaturn '"\browseTitle{" htSaySaturn title htSaySaturn '"}" if $standard then htSayStandard('"\begin{page}{", htpName $curPage, '"}{") htSayStandard title htSayStandard '"}" --======================================================================= -- Utilities --======================================================================= mkTabularItem u == [:first u,:fn rest u] where fn x == null x => nil [$saturnAmpersand, x,:fn rest x] htSaySaturnAmpersand() == htSaySaturn $saturnAmpersand htBlank(:options) == options is [n] => htSaySaturn(strconc/['"\phantom{*}" for i in 1..n]) htSayStandard strconc('"\space{",toString n,'"}") htSaySaturn '"\phantom{*}" htSayStandard '"\space{1}" unTab s == string? s => unTab1 s s isnt [.,:.] => s [unTab1 first s, :rest s] unTab1 s == ('"\tab{" < s) = 5 and (k := charPosition(char "}", s, 4)) => subString(s, k + 1) s satBreak() == htSaySaturn '"\\ " htSayStandard '"\item " htBigSkip() == htSaySaturn '"\bigskip{}" htSayStandard '"\vspace{1}\newline " htSaturnBreak() == htSaySaturn '"\!" satDownLink(s,code) == htSaySaturn '"\lispFunctionLink{\verb!" htSaySaturn code htSaySaturn '"!}{" htSaySaturn s htSaySaturn '"}" ------------------ htSayStandard '"\lispdownlink{" htSayStandard s htSayStandard '"}{" htSayStandard code htSayStandard '"}" satTypeDownLink(s,code) == htSaySaturn '"\lispLink[d]{\verb!" htSaySaturn code htSaySaturn '"!}{" htSaySaturn s htSaySaturn '"}" ------------------ htSayStandard '"\lispdownlink{" htSayStandard s htSayStandard '"}{" htSayStandard code htSayStandard '"}" mkButtonBox n == strconc('"\buttonbox{", STRINGIMAGE n, '"}") --======================================================================= -- Create separate databases for operations, constructors --======================================================================= -----------> use br-data.boot definition --dbSplitLibdb() == --This function splits lidbd.text into files to make searching quicker. -- alibdb.text attributes -- clibdb.text categories -- dlibdb.text domains -- plibdb.text packages -- olibdb.text operations -- xlibdb.text default packages --These files have the same format as the single file libdb.text did in old -- version: e.g. `````` -- for constructors where is a single character, one of acdopx -- (identifying it as an attribute, category, domain, operator, package, -- or default package), its name, number of arguments, whether exposed or -- unexposed, its signature (sometimes abbreviated), its arguments as given -- in the original definition, its abbreviation, and documentation. -- For example, domain Matrix has line "dMatrix`1`x``(R)`MATRIX`" -- where is "(Ring)->Join(MatrixCategory(R,Vector(R),Vector(R)),etc)". -- The comment field contains the character address of the comments -- for Matrix in file comdb.text. --There is thus ONE file comdb.text for documentation of all structures -- (to facilitate a general search through all documentation) -- into for comments. The format of entries in comdb.text are lines with -- two fields of the form d`, where is the character -- address of the line "dMatrix`.." in dlibdb.text (the first character -- "d" tells which lidbdb file it comes from, the is the -- documentation for Matrix. --NOTE: In each file, the first character, one of acdpox, is retained -- so that lines have the same format as the previous version of the browser -- (this minimized the number of lines of code that had to be changed from -- previous version of the browser). -- key := nil --dummy first key -- instream := MAKE_-INSTREAM '"libdb.text" -- comstream := MAKE_-OUTSTREAM '"comdb.text" -- PRINC(0, comstream) -- PRINC($tick,comstream) -- PRINC('"", comstream) -- finishLine(comstream) -- while (line := readLine instream) ~= %nothing repeat -- comP := getFileCursor comstream -- if key ~= line.0 then -- if outstream then SHUT outstream -- key := line . 0 -- outstream := MAKE_-OUTSTREAM strconc(STRINGIMAGE key,'"libdb.text") -- outP := getFileCursor outstream -- [prefix,:comments] := dbSplit(line,6,1) -- PRINC(prefix,outstream) -- PRINC($tick ,outstream) -- null comments => -- PRINC(0,outstream) -- finishLine(outstream) -- PRINC(comP,outstream) -- finishLine(outstream) -- PRINC(key, comstream) --identifies file the backpointer is to -- PRINC(outP ,comstream) -- PRINC($tick ,comstream) -- PRINC(first comments,comstream) -- finishLine(comstream) -- for c in rest comments repeat -- PRINC(key, comstream) --identifies file the backpointer is to -- PRINC(outP ,comstream) -- PRINC($tick ,comstream) -- PRINC(c, comstream) -- finishLine(comstream) -- SHUT instream -- SHUT outstream -- SHUT comstream --removeFile '"libdb.text" dbSort(x,y) == sin := STRINGIMAGE x sout:= STRINGIMAGE y runCommand strconc('"sort -f _"",sin,'".text_" > _"", sout, '".text_"") removeFile strconc(sin, '".text") bcConform1 form == main where main() == form is ['ifp,form1,:pred] => hd form1 bcPred pred hd form hd form == form isnt [.,:.] => -- string literals, e.g. "failed", are constructor arguments -- too, until we fix that. string? form or not (ident? form and isConstructorName form) => s := string? form => strconc('"_"",form,'"_"") STRINGIMAGE form stringChar(s,0) = char "#" => (n := symbolPosition(form,$FormalFunctionParameterList)) => htSay form2HtString ($FormalMapVariableList . n) htSay '"\" htSay form htSay escapeSpecialChars s s := STRINGIMAGE form $italicHead? => htSayItalics s $bcMultipleNames => satTypeDownLink(s, ['"(|conPageChoose| '|",s,'"|)"]) satTypeDownLink(s, ["(|conPage| '|",s,'"|)"]) (head := form.op) = 'QUOTE => htSay('"'") hd second form head = 'SIGNATURE => htSay(second form,'": ") mapping third form head = 'Mapping and rest form => rest form => mapping rest form head = ":" => hd second form htSay '": " hd third form form.args and dbEvalableConstructor? form => bcConstructor(form,head) hd head null (r := form.args) => nil tl form.args 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 '"}" --======================================================================= -- Code for Private Libdbs --======================================================================= --extendLocalLibdb conlist == --called by function "compiler"(see above) -- buildLibdb conlist --> puts datafile into temp.text -- $newConstructorList := union(conlist, $newConstructorList) -- localLibdb := '"libdb.text" -- not isExistingFile '"libdb.text" => RENAME_-FILE('"temp.text",'"libdb.text") -- oldlines := purgeNewConstructorLines(dbReadLines localLibdb, conlist) -- newlines := dbReadLines '"temp.text" -- dbWriteLines(MSORT union(oldlines,newlines), '"libdb.text") -- removeFile '"temp.text" purgeNewConstructorLines(lines, conlist) == [x for x in lines | not screenLocalLine(x, conlist)] -- Got rid of debugging statement and deleted screenLocalLine1, MCD 26/3/96 --screenLocalLine(line,conlist) == -- u := screenLocalLine1(line,conlist) -- if u then -- sayBrightly ['"Purging--->", line] -- u -- screenLocalLine1(line, conlist) == screenLocalLine(line, conlist) == k := dbKind line con := makeSymbol k = char "o" or k = char "a" => s := dbPart(line,5,1) k := charPosition(char "(",s,1) subString(s,1,k - 1) dbName line symbolMember?(con, conlist) purgeLocalLibdb() == --called by the user through a clear command? $newConstructorList := nil removeFile '"libdb.text" --======================================================================= -- from DAASE.LISP --======================================================================= --library(args) == -- $newConlist: local := nil -- LOCALDATABASE(args,$options) -- extendLocalLibdb $newConlist -- terminateSystemCommand()