diff options
author | dos-reis <gdr@axiomatics.org> | 2007-11-14 01:19:25 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2007-11-14 01:19:25 +0000 |
commit | 62b279b28cf02d59e0f860aac46968223c43cfc3 (patch) | |
tree | 52b6bd0af8e2cbd1bcc5bc60fdaf1ee1c293d4b4 /src/interp/br-saturn.boot.pamphlet | |
parent | fabbf02ee4b80241b75826536502c2d683e8462e (diff) | |
download | open-axiom-62b279b28cf02d59e0f860aac46968223c43cfc3.tar.gz |
remove more pamphlets
Diffstat (limited to 'src/interp/br-saturn.boot.pamphlet')
-rw-r--r-- | src/interp/br-saturn.boot.pamphlet | 1919 |
1 files changed, 0 insertions, 1919 deletions
diff --git a/src/interp/br-saturn.boot.pamphlet b/src/interp/br-saturn.boot.pamphlet deleted file mode 100644 index 212411af..00000000 --- a/src/interp/br-saturn.boot.pamphlet +++ /dev/null @@ -1,1919 +0,0 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/br-saturn.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\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>> - -import '"bc-util" -)package "BOOT" - ---====================> WAS b-saturn.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) --- OBEY '"cat /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 ---======================================================================= - ---------------------> OLD DEFINITION (override in br-util.boot.pamphlet) -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 - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -bcHt line == - $newPage => --this path affects both saturn and old lines - text := - PAIRP line => [['text, :line]] - STRINGP line => line - [['text, line]] - if $saturn then htpAddToPageDescription($saturnPage, text) - if $standard then htpAddToPageDescription($curPage, text) - PAIRP line => - $htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList) - $htLineList := [basicStringize line, :$htLineList] - ---======================================================================= --- New issueHT ---======================================================================= - ---------------------> NEW DEFINITION (see ht-util.boot.pamphlet) -htShowPage() == --- show the page which has been computed - htSayStandard '"\endscroll" - htShowPageNoScroll() - -------------------> NEW DEFINITION (see ht-util.boot.pamphlet) -htShowPageNoScroll() == --- show the page which has been computed - htSayStandard '"\autobuttons" - if $standard then - htpSetPageDescription($curPage, nreverse htpPageDescription $curPage) - if $saturn then - htpSetPageDescription($saturnPage, nreverse htpPageDescription $saturnPage) - $newPage := false - ---------------------- - if $standard then - $htLineList := nil - htMakePage htpPageDescription $curPage - if $htLineList then line := APPLY(function CONCAT, nreverse $htLineList) - issueHTStandard line - ---------------------- - if $saturn then - $htLineList := nil - htMakePage htpPageDescription $saturnPage - if $htLineList then line := APPLY(function CONCAT, nreverse $htLineList) - issueHTSaturn line - ---------------------- - endHTPage() - ---------------------> NEW DEFINITION <-------------------------- -issueHTSaturn line == --called by htMakePageNoScroll and htMakeErrorPage - if $saturn then - $marg : local := 0 - $linelength: local := 80 - writeSaturn '"\inputonce{<AXIOM>/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 := - STRINGIMAGE ($saturnContextMenuIndex := $saturnContextMenuIndex + 1) - writeSaturnLines - ['"\newmenu{BCM", index, - '"}{",:nreverse $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) - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -htMakeErrorPage htPage == - $newPage := false - $htLineList := nil - if $standard then $curPage := htPage - if $saturn then $saturnPage := htPage - htMakePage htpPageDescription htPage - line := APPLY(function CONCAT, nreverse $htLineList) - issueHT line - endHTPage() - -writeSaturnLines lines == - for line in lines repeat - if line ^= '"" and line.0 = char '_\ then saturnTERPRI() - saturnPRINTEXP line - -writeSaturn(line) == - k := 0 - n := MAXINDEX line - while --advance k if true - k > n => false - 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, nil) - code = 2 => - writeSaturnPrint('" &") - writeSaturn SUBSTRING(line,k + 4, nil) - code = 3 => - writeSaturnPrint('"\item") - writeSaturn SUBSTRING(line,k + 5,nil) - code = 4 => - writeSaturnPrint('"\newline") - writeSaturn SUBSTRING(line,k + 8,nil) - code = 5 => - writeSaturnPrint('"\table{") - $marg := $marg + 3 - writeSaturnTable SUBSTRING(line,k + 7,nil) - code = 6 => - i := charPosition(char '_},line,k + 4) - tabCode := SUBSTRING(line,k, i - k + 1) - writeSaturnPrint tabCode - line := SUBSTRING(line,i + 1, nil) - writeSaturn line - code = 7 => - saturnTERPRI() - writeSaturn SUBSTRING(line, k + 2,nil) - 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,nil) - 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,nil) - $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 => PRINTEXP(s,$browserOutputStream) - PRINTEXP s - -saturnTERPRI() == - $browserOutputStream => TERPRI($browserOutputStream) - TERPRI() - -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,nil) - $marg := $marg - 3 - writeSaturnPrint SUBSTRING(line,0,close + 1) - writeSaturn SUBSTRING(line, close + 1,nil) - -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 - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -htMakePage itemList == - if $newPage then - if $saturn then htpAddToPageDescription($saturnPage, saturnTran itemList) - if $standard then htpAddToPageDescription($curPage, itemList) - htMakePage1 itemList - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -htMakePage1 itemList == --- make a page given the description in itemList - for u in itemList repeat - itemType := 'text - items := - STRINGP u => u - ATOM u => STRINGIMAGE u - STRINGP 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 MEMQ(kind,'(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 := - atom s => [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 atom code then code := [code] - if atom s then s := [s] - ['"\lispLink[d]{\verb!", :code, '"!}{", :s, '"}"] - -saturnTranText x == - STRINGP 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 = STRING_<('"\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 ---======================================================================= ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -endHTPage() == - $standard => sockSendInt($MenuServer, $EndOfPage) - nil - ---======================================================================= --- Redefinitions from ht-util.boot ---======================================================================= -htSayHrule() == bcHt - $saturn => '"\hrule{}\newline{}" - '"\horizontalline{}\newline{}" - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -htpAddInputAreaProp(htPage, label, prop) == -------------> Add STRINGIMAGE - SETELT(htPage, 5, [[label, nil, nil, nil, :prop], :ELT(htPage, 5)]) - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -htpSetLabelInputString(htPage, label, val) == -------------> Add STRINGIMAGE --- value user typed as input string on page - props := LASSOC(label, htpInputAreaAlist htPage) - props => SETELT(props, 0, STRINGIMAGE val) - nil - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -htDoneButton(func, htPage, :optionalArgs) == -------> Handle argument values passed from page if present - if optionalArgs then - htpSetInputAreaAlist(htPage,CAR optionalArgs) - typeCheckInputAreas htPage => - htMakeErrorPage htPage - NULL FBOUNDP func => - systemError ['"unknown function", func] - FUNCALL(SYMBOL_-FUNCTION func, htPage) - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -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 - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -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 := - STRINGP pageDescrip => [pageDescrip, :ELT(htPage, 7)] - nconc(nreverse COPY_-LIST pageDescrip, ELT(htPage, 7)) - SETELT(htPage, 7, newDescript) - - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -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 := CONCAT(mess2, bcSadFaces()) - htpSetLabelErrorMsg(page(), stringName, nil) - iht ['"\inputstring{", stringName, '"}{", - numChars, '"}{", htpLabelDefault(page(),stringName), '"} ", mess2] - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -setUpDefault(name, props) == - htpAddInputAreaProp(page(), name, props) - ---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet) -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,:options) == - name := IFCAR options or GENTEMP() - if not $saturn then - $activePageList := [name, :$activePageList] - SET(name, val := VECTOR(name, nil, nil, nil, nil, nil, propList, nil)) - val - ---======================================================================= --- 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" - RPLACA(parts,kind) - conform := mkConform(kind,name,args) - $kPageSaturnArguments: local := rest conform - conname := opOf conform - capitalKind := capitalize kind - signature := ncParseFromString sig - sourceFileName := dbSourceFile INTERN 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) - if asharpConstructorName? conname then - htpSetProperty(page,'isAsharpConstructor,true) - 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]]] - if not asharpConstructorName? conname then - htSay '"}{" - htMakePage [['bcLinks,['Dependents,'"",'kcdePage,nil]]] - if kind = '"category" then - htSay '"}{" - htMakePage [['bcLinks,['Descendents,'"",'kcdPage,nil]]] - if kind = '"category" then - htSay '"}{" - if not asharpConstructorName? conname then - htMakePage [['bcLinks,['Domains,'"",'kcdoPage,nil]]] - else htSay '"{\em Domains}" - 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 '"}{" - if not asharpConstructorName? conname - then htMakePage [['bcLinks,["Search Path",'"",'ksPage,nil]]] - else htSay '"{\em Search Path}" - 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]]] - if not asharpConstructorName? conname then - htMakePage [['bcLinks,['"\&Dependents",'"",'kcdePage,nil]]] - if kind = '"category" then - htMakePage [['bcLinks,['"Desce\&ndents",'"",'kcdPage,nil]]] - if kind = '"category" then - if not asharpConstructorName? conname then - htMakePage [['bcLinks,['"Do\&mains",'"",'kcdoPage,nil]]] - else htSayCold '"Do\&mains" - 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"]]] - if not asharpConstructorName? conname - then htMakePage [['bcLinks,['"Search O\&rder",'"",'ksPage,nil]]] - else htSayCold '"Search Order" - 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(CAR(CDR(lname)), '"\endcsname}{E&xamples}") - -$exampleConstructors := nil - -saturnHasExamplePage conname == - if not $exampleConstructors then - $exampleConstructors := getSaturnExampleList() - ASSQ(conname, $exampleConstructors) - -getSaturnExampleList() == - file := STRCONC(systemRootDirectory(), "/doc/axug/examples.lsp") - not PROBE_-FILE file => nil - fp := MAKE_-INSTREAM file - lst := READ fp - SHUT fp - lst - ---------------------> NEW DEFINITION (see br-con.boot.pamphlet) -dbPresentCons(htPage,kind,:exclusions) == - $saturn => dbPresentConsSaturn(htPage,kind,exclusions) - htpSetProperty(htPage,'exclusion,first exclusions) - cAlist := htpProperty(htPage,'cAlist) - empty? := null cAlist - one? := null CDR 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 member('abbrs,exclusions) - then htSay '"{\em Abbreviations}" - else htMakePage [['bcLispLinks,['"Abbreviations",'"",'dbShowCons,'abbrs]]] - htSay '"}{" - if one? or member('conditions,exclusions) or "and"/[CDR x = true for x in cAlist] - then htSay '"{\em Conditions}" - else htMakePage [['bcLispLinks,['"Conditions",'"",'dbShowCons,'conditions]]] - htSay '"}{" - if empty? or member('documentation,exclusions) - then htSay '"{\em Descriptions}" - else htMakePage [['bcLispLinks,['"Descriptions",'"",'dbShowCons,'documentation]]] - htSay '"}{" - if one? or null CDR cAlist - then htSay '"{\em Filter}" - else htMakePage - [['bcLinks,['"Filter",'"",'htFilterPage,['dbShowCons,'filter]]]] - htSay '"}{" - if one? or member('kinds,exclusions) or kind ^= 'constructor - then htSay '"{\em Kinds}" - else htMakePage [['bcLispLinks,['"Kinds",'"",'dbShowCons,'kinds]]] - htSay '"}{" - if one? or member('names,exclusions) - then htSay '"{\em Names}" - else htMakePage [['bcLispLinks,['"Names",'"",'dbShowCons,'names]]] - htSay '"}{" - if one? or member('parameters,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 member('abbrs,exclusions) - then htSayCold '"\&Abbreviations" - else htMakePage [['bcLispLinks,['"\&Abbreviations",'"",'dbShowCons,'abbrs]]] - if one? or member('conditions,exclusions) or "and"/[CDR x = true for x in cAlist] - then htSayCold '"\&Conditions" - else htMakePage [['bcLispLinks,['"\&Conditions",'"",'dbShowCons,'conditions]]] - if empty? or member('documentation,exclusions) - then htSayCold '"\&Descriptions" - else htMakePage [['bcLispLinks,['"\&Descriptions",'"",'dbShowCons,'documentation]]] - if one? or null CDR cAlist - then htSayCold '"\&Filter" - else htMakeSaturnFilterPage ['dbShowCons, 'filter] - if one? or member('kinds,exclusions) or kind ^= 'constructor - then htSayCold '"\&Kinds" - else htMakePage [['bcLispLinks,['"\&Kinds",'"",'dbShowCons,'kinds]]] - if one? or member('names,exclusions) - then htSayCold '"\&Names" - else htMakePage [['bcLispLinks,['"\&Names",'"",'dbShowCons,'names]]] - if one? or member('parameters,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 op - kind = 'category => cats := [x,:cats] - kind = 'domain => doms := [x,:doms] - kind = 'package => paks := [x,:paks] - defs := [x,:defs] - lists := [NREVERSE cats,NREVERSE doms,NREVERSE paks,NREVERSE 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 REMDUP [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 - CDR parlist => '"s:" - '":" - htSaySaturn '"}" - if CDR 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 SUBLIS(argSublis,par) - htSaySaturn '"}{" - htSaySaturn argstring - htSaySaturn '"}}" - htEndTabular() - ---------------------> NEW DEFINITION (see br-con.boot.pamphlet) -kPageArgs([op,:args],[.,.,:source]) == - htSaySaturn '"\begin{tabular}{p{.25in}lp{0in}}" - firstTime := true - coSig := rest GETDATABASE(op,'COSIG) - 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{",STRINGIMAGE( # PNAME x),'"}, ") - htSaySaturnAmpersand() - htSay - pred => '"a domain of category " - '"an element of the domain " - bcConform(typeForm,true) - htEndTabular() - ---======================================================================= --- Redefinitions from br-op1.boot ---======================================================================= ---------------------> NEW DEFINITION (see br-op1.boot.pamphlet) -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,'"}"] - ---------------------> NEW DEFINITION (see br-op1.boot.pamphlet) -htTab s == if $standard then htSayStandard ('"\tab{",s,'"}") - ---------------------> NEW DEFINITION (see br-op1.boot.pamphlet) -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" - INTEGERP thing => '"unexported" - constructorIfTrue => - htSay word - atom thing => '" an unknown constructor" - '"" - atom thing => '"unconditional" - '"" - htSay '"}" - if null atom thing then - if constructorIfTrue then htSay('" {\em ",dbShowKind thing,'"}") - htSay '" " - FUNCALL(fn,thing) - htSay('":\newline ") - dbShowOpSigList(which,items,(1 + bincount) * 8192) - bincount := bincount + 1 - htEndMenu 'description - ---------------------> NEW DEFINITION (see br-op1.boot.pamphlet) -dbPresentOps(htPage,which,:exclusions) == - $saturn => dbPresentOpsSaturn(htPage,which,exclusions) - asharp? := htpProperty(htPage,'isAsharpConstructor) - fromConPage? := (conname := opOf htpProperty(htPage,'conform)) - usage? := nil - star? := not fromConPage? or which = '"package operation" - implementation? := not asharp? and - $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed? - rightmost? := star? or (implementation? and not $includeUnexposed?) - if INTEGERP 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 member('conditions,exclusions) - or (htpProperty(htPage,'condition?) = 'no) - then htSay '"{\em Conditions}" - else htMakePage [['bcLispLinks,['"Conditions",'"",'dbShowOps,which,'conditions]]] - htSay '"}{" - if empty? or member('documentation,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 member('names,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 member('implementation,exclusions) or which = '"attribute" or - ((conname := opOf htpProperty(htPage,'conform)) - and GETDATABASE(conname,'CONSTRUCTORKIND) = 'category) - then htSay '"{\em Implementations}" - else htMakePage - [['bcLispLinks,['"Implementations",'"",'dbShowOps,which,'implementation]]] - htSay '"}{" - if one? or member('origins,exclusions) - then htSay '"{\em Origins}" - else htMakePage [['bcLispLinks,['"Origins",'"",'dbShowOps,which,'origins]]] - htSay '"}{" - if one? or member('parameters,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 member('signatures,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 - asharp? := htpProperty(htPage,'isAsharpConstructor) - fromConPage? := (conname := opOf htpProperty(htPage,'conform)) - usage? := nil - star? := not fromConPage? or which = '"package operation" - implementation? := not asharp? and - $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed? - rightmost? := star? or (implementation? and not $includeUnexposed?) - if INTEGERP 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 member('conditions,exclusions) - or (htpProperty(htPage,'condition?) = 'no) - then htSayCold '"\&Conditions" - else htMakePage [['bcLispLinks,['"\&Conditions",'"",'dbShowOps,which,'conditions]]] - if empty? or member('documentation,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 member('implementation,exclusions) or which = '"attribute" or - ((conname := opOf htpProperty(htPage,'conform)) - and GETDATABASE(conname,'CONSTRUCTORKIND) = 'category) - then htSayCold '"\&Implementations" - else htMakePage - [['bcLispLinks,['"\&Implementations",'"",'dbShowOps,which,'implementation]]] - if one? or member('names,exclusions) or null KDR opAlist - then htSayCold '"\&Names" - else htMakePage [['bcLispLinks,['"\&Names",'"",'dbShowOps,which,'names]]] - if one? or member('origins,exclusions) - then htSayCold '"\&Origins" - else htMakePage [['bcLispLinks,['"\&Origins",'"",'dbShowOps,which,'origins]]] - if one? or member('parameters,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 member('signatures,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 ---======================================================================= ----------------------> OLD DEFINITION (override in br-search.boot.pamphlet) -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 ---======================================================================= - ---------------> 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 LASSOC('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}") - n = 3 and LASSOC('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 GETDATABASE(op,'NILADIC) or member(op,'(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 GETDATABASE(conname,'CONSTRUCTORKIND) - $conlength : local := #constring - $conform : local := conform - $conargs : local := rest conform - if which = '"operation" then - $signature : local := - MEMQ(conname,$Primitives) => nil - CDAR getConstructorModemap conname - --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 := SUBLISLIS($FormalMapVariableList,tvarlist,$signature) - $sig := - which = '"attribute" or which = '"constructor" => sig - $conkind ^= '"package" => sig - symbolsUsed := [x for x in rest conform | IDENTP x] - $DomainList := SETDIFFERENCE($DomainList,symbolsUsed) - getSubstSigIfPossible sig - ----------------------------------------------------------- - htSaySaturn '"\begin{tabular}{lp{0in}}" - ----------------------------------------------------------- - if member(which,'("operation" "constructor")) then - $displayReturnValue: local := nil - if args then - htSayStandard('"\newline\tab{2}{\em Arguments:}") - htSaySaturn '"{\em Arguments:}" - htSaySaturnAmpersand() - firstTime := true - coSig := KDR GETDATABASE(op,'COSIG) --check if op is constructor - 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 MEMQ(predicate,'(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 SUBST($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 ASSOC("$",$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 and (doc ^= '"" 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 - CONSP 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 := GETDATABASE(conname,'ABBREVIATION)) 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 CAR(CDR(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 := (GETDATABASE(conname,'SOURCEFILE) or '"none") - filename := extractFileNameFromPath sourceFileName - htMakePage [['text,'"\unixcommand{",filename,'"}{_\$AXIOM/lib/SPADEDIT ", - sourceFileName, '" ", conname, '"}"]] - ---------------------> NEW DEFINITION (see br-op2.boot.pamphlet) -htSayIndentRel(n,:options) == - flag := IFCAR options - m := ABSVAL n - if flag then m := m + 2 - if $standard then htSayStandard - n > 0 => - flag => ['"\indent{",STRINGIMAGE m,'"}\tab{-2}"] - ['"\indent{",STRINGIMAGE m,'"}\tab{0}"] - n < 0 => ['"\indent{0}\newline "] - -htSayUnexposed() == - htSay '"{\em *}" - $atLeastOneUnexposed := true ---======================================================================= --- Page Operations ---======================================================================= - -htEndTabular() == - htSaySaturn '"\end{tabular}" - -htPopSaturn s == - pageDescription := ELT($saturnPage, 7) - pageDescription is [=s,:b] => SETELT($saturnPage, 7, CDR 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,'"|)}"] - ---------------------> NEW DEFINITION (see ht-util.boot.pamphlet) -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{",STRINGIMAGE n,'"}") - htSaySaturn '"\phantom{*}" - htSayStandard '"\space{1}" - -unTab s == - STRINGP s => unTab1 s - atom s => s - [unTab1 first s, :rest s] - -unTab1 s == - STRING_<('"\tab{", s) = 5 and (k := charPosition(char '_}, s, 4)) => - SUBSTRING(s, k + 1, nil) - 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. <key><name>`<args>`<exposure>`<sig>`<args>`<abbrev>`<doc> --- for constructors where <key> 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`<sig>`(R)`MATRIX`<com>" --- where <sig> is "(Ring)->Join(MatrixCategory(R,Vector(R),Vector(R)),etc)". --- The comment field <com> 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<nnnnn>`<ccccc>, where <nnnnn> is the character --- address of the line "dMatrix`.." in dlibdb.text (the first character --- "d" tells which lidbdb file it comes from, the <ccccc> 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" --- PRINTEXP(0, comstream) --- PRINTEXP($tick,comstream) --- PRINTEXP('"", comstream) --- TERPRI(comstream) --- while not EOFP instream repeat --- line := READLINE instream --- comP := FILE_-POSITION comstream --- if key ^= line.0 then --- if outstream then SHUT outstream --- key := line . 0 --- outstream := MAKE_-OUTSTREAM STRCONC(STRINGIMAGE key,'"libdb.text") --- outP := FILE_-POSITION outstream --- [prefix,:comments] := dbSplit(line,6,1) --- PRINTEXP(prefix,outstream) --- PRINTEXP($tick ,outstream) --- null comments => --- PRINTEXP(0,outstream) --- TERPRI(outstream) --- PRINTEXP(comP,outstream) --- TERPRI(outstream) --- PRINTEXP(key, comstream) --identifies file the backpointer is to --- PRINTEXP(outP ,comstream) --- PRINTEXP($tick ,comstream) --- PRINTEXP(first comments,comstream) --- TERPRI(comstream) --- for c in rest comments repeat --- PRINTEXP(key, comstream) --identifies file the backpointer is to --- PRINTEXP(outP ,comstream) --- PRINTEXP($tick ,comstream) --- PRINTEXP(c, comstream) --- TERPRI(comstream) --- SHUT instream --- SHUT outstream --- SHUT comstream ---OBEY '"rm libdb.text" - -dbSort(x,y) == - sin := STRINGIMAGE x - sout:= STRINGIMAGE y - OBEY STRCONC('"sort -f _"",sin,'".text_" > _"", sout, '".text_"") - OBEY STRCONC('"rm ", sin, '".text") - - ---======================================================================= --- from define.boot ---======================================================================= -----------------------> (override in define.boot.pamphlet) -compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], - m,oldE,$prefix,$formalArgList) == - [lineNumber,:specialCases] := specialCases - e := oldE - --1. bind global variables - $form: local - $op: local - $functionStats: local:= [0,0] - $argumentConditionList: local - $finalEnv: local - --used by ReplaceExitEtc to get a common environment - $initCapsuleErrorCount: local:= #$semanticErrorStack - $insideCapsuleFunctionIfTrue: local:= true - $CapsuleModemapFrame: local:= e - $CapsuleDomainsInScope: local:= get("$DomainsInScope","special",e) - $insideExpressionIfTrue: local:= true - $returnMode:= m - [$op,:argl]:= form - $form:= [$op,:argl] - argl:= stripOffArgumentConditions argl - $formalArgList:= [:argl,:$formalArgList] - - --let target and local signatures help determine modes of arguments - argModeList:= - identSig:= hasSigInTargetCategory(argl,form,first signature,e) => - (e:= checkAndDeclare(argl,form,identSig,e); rest identSig) - [getArgumentModeOrMoan(a,form,e) for a in argl] - argModeList:= stripOffSubdomainConditions(argModeList,argl) - signature':= [first signature,:argModeList] - if null identSig then --make $op a local function - oldE := put($op,'mode,['Mapping,:signature'],oldE) - - --obtain target type if not given - if null first signature' then signature':= - identSig => identSig - getSignature($op,rest signature',e) or return nil - - --replace ##1,.. in signature by arguments --- pp signature' - signature':= SUBLISLIS(argl,$FormalFunctionParameterList,signature') --- pp '"------after----" --- pp signature' - e:= giveFormalParametersValues(argl,e) - - $signatureOfForm:= signature' --this global is bound in compCapsuleItems - $functionLocations := [[[$op,$signatureOfForm],:lineNumber], - :$functionLocations] - e:= addDomain(first signature',e) - e:= compArgumentConditions e - - if $profileCompiler then - for x in argl for t in rest signature' repeat profileRecord('arguments,x,t) - - - --4. introduce needed domains into extendedEnv - for domain in signature' repeat e:= addDomain(domain,e) - - --6. compile body in environment with extended environment - rettype:= resolve(signature'.target,$returnMode) - - localOrExported := - null member($op,$formalArgList) and - getmode($op,e) is ['Mapping,:.] => 'local - 'exported - - --6a skip if compiling only certain items but not this one - -- could be moved closer to the top - formattedSig := formatUnabbreviated ['Mapping,:signature'] - $compileOnlyCertainItems and _ - not member($op, $compileOnlyCertainItems) => - sayBrightly ['" skipping ", localOrExported,:bright $op] - [nil,['Mapping,:signature'],oldE] - sayBrightly ['" compiling ",localOrExported, - :bright $op,'": ",:formattedSig] - - if $newComp = true then - wholeBody := ['DEF, form, signature', specialCases, body] - T := CATCH('compCapsuleBody, newComp(wholeBody,$NoValueMode,e)) - or ["",rettype,e] - T := [T.expr.2.2, rettype, T.env] - if $newCompCompare=true then - oldT := CATCH('compCapsuleBody, compOrCroak(body,rettype,e)) - or ["",rettype,e] - SAY '"The old compiler generates:" - prTriple oldT - SAY '"The new compiler generates:" - prTriple T - else - T := CATCH('compCapsuleBody, compOrCroak(body,rettype,e)) - or ["",rettype,e] ---+ - NRTassignCapsuleFunctionSlot($op,signature') - if $newCompCompare=true then - SAY '"The old compiler generates:" - prTriple T --- A THROW to the above CATCH occurs if too many semantic errors occur --- see stackSemanticError - catchTag:= MKQ GENSYM() - fun:= - body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode) - body':= addArgumentConditions(body',$op) - finalBody:= ["CATCH",catchTag,body'] - compileCases([$op,["LAM",[:argl,'_$],finalBody]],oldE) - $functorStats:= addStats($functorStats,$functionStats) - - --- 7. give operator a 'value property - val:= [fun,signature',e] - [fun,['Mapping,:signature'],oldE] -- oldE:= put($op,'value,removeEnv val,e) - ---from postpar ---------------------> NEW DEFINITION (override in postpar.boot.pamphlet) -postSignature ['Signature,op,sig] == - sig is ["->",:.] => - sig1:= postType sig - op:= postAtom (STRINGP op => INTERN op; op) - ["SIGNATURE",op,:removeSuperfluousMapping killColons postDoubleSharp sig1] - -postDoubleSharp sig == - sig is [['Mapping,target,:r]] => - -- replace #1,... by ##1,... - [['Mapping, SUBLISLIS($FormalFunctionParameterList, $FormalMapVariableList, target), - :r]] - sig - --- override in br-util.boot.pamphlet -bcConform1 form == main where - main() == - form is ['ifp,form1,:pred] => - hd form1 - bcPred pred - hd form - hd form == - atom form => - not MEMQ(form,$Primitives) and null constructor? form => - s := STRINGIMAGE form - (s.0 = char '_#) => - (n := POSN1(form, $FormalFunctionParameterList)) => - htSay form2HtString ($FormalMapVariableList . n) - htSay '"\" - htSay form - htSay escapeSpecialChars STRINGIMAGE form - s := STRINGIMAGE form - $italicHead? => htSayItalics s - $bcMultipleNames => - satTypeDownLink(s, ['"(|conPageChoose| '|",s,'"|)"]) - satTypeDownLink(s, ["(|conPage| '|",s,'"|)"]) - (head := QCAR form) = 'QUOTE => - htSay('"'") - hd CADR form - head = 'SIGNATURE => - htSay(CADR form,'": ") - mapping CADDR form - head = 'Mapping and rest form => rest form => mapping rest form - head = ":" => - hd CADR form - htSay '": " - hd CADDR form - QCDR form and dbEvalableConstructor? form - => bcConstructor(form,head) - hd head - null (r := QCDR form) => nil - tl QCDR form - mapping [target,:source] == - tuple source - bcHt - $saturn => '" {\ttrarrow} " - '" -> " - hd target - tuple u == - null u => bcHt '"()" - null rest u => hd u - bcHt '"(" - hd first u - for x in rest u repeat - bcHt '"," - hd x - bcHt '")" - tl u == - bcHt '"(" - firstTime := true - for x in u repeat - if not firstTime then bcHt '"," - firstTime := false - hd x - bcHt '")" - say x == - if $italics? then bcHt '"{\em " - if x = 'etc then x := '"..." - bcHt escapeSpecialIds STRINGIMAGE x - if $italics? then bcHt '"}" - ---======================================================================= --- 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") --- deleteFile '"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 := INTERN - k = char 'o or k = char 'a => - s := dbPart(line,5,1) - k := charPosition(char '_(,s,1) - SUBSTRING(s,1,k - 1) - dbName line - MEMQ(con, conlist) - ---------------> NEW DEFINITION (see br-data.boot.pamphlet) -purgeLocalLibdb() == --called by the user through a clear command? - $newConstructorList := nil - deleteFile '"libdb.text" - ---moveFile(before,after) == --- $saturn => MOVE_-FILE(before, after) --- RENAME_-FILE(before, after) --- --obey STRCONC('"mv ", before, '" ", after) - --- deleted JHD/MCD, since already one in pathname.boot ---deleteFile fn == --- $saturn => DELETE_-FILE fn --- obey STRCONC('"rm ",fn) - ---======================================================================= --- from DAASE.LISP ---======================================================================= ---library(args) == --- $newConlist: local := nil --- LOCALDATABASE(args,$options) --- extendLocalLibdb $newConlist --- TERSYSCOMMAND() - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |