path: root/src/interp/br-saturn.boot

-- 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{<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 :=
      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 := 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 := KDR operationIsConstructor op  --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 (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. <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"
--  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()