Revert commits to the wrong tree.

1 files changed, 1040 insertions, 0 deletions

diff --git a/src/interp/br-search.boot.pamphlet b/src/interp/br-search.boot.pamphlet
new file mode 100644
index 00000000..f886a96a
--- /dev/null
+++ b/src/interp/br-search.boot.pamphlet
@@ -0,0 +1,1040 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/br-search.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>>
+
+--====================> WAS b-search.boot <================================
+
+--=======================================================================
+--              Grepping Database libdb.text
+-- Redone 12/95 for Saturn; previous function grep renamed as grepFile
+-- This function now either returns a filename or a list of strings
+--=======================================================================
+grepConstruct(s,key,:options) == --key = a o c d p x k (all) . (aok) w (doc)
+--Called from genSearch with key = "." and "w"
+--key = "." means a o c d p x
+--option1 = true means return the result as a file
+--All searches of the database call this function to get relevant lines
+--from libdb.text. Returns either a list of lines (usual case) or else
+--an alist of the form ((kind . <list of lines for that kind>) ...)
+  $localLibdb : local := fnameExists? '"libdb.text" and '"libdb.text"
+  lines := grepConstruct1(s,key)
+  IFCAR options => grepSplit(lines,key = 'w)    --leave now if a constructor
+  MEMQ(key,'(o a)) => dbScreenForDefaultFunctions lines --kill default lines if a/o
+  lines
+
+grepConstruct1(s,key) ==
+--returns the name of file (WITHOUT .text.$SPADNUM on the end)
+  $key     : local := key
+  if key = 'k and          --convert 'k to 'y if name contains an "&"
+    or/[s . i = char '_& for i in 0..MAXINDEX s] then key := 'y
+  filter := pmTransFilter STRINGIMAGE s  --parses and-or-not form
+  filter is ['error,:.] => filter        --exit on parser error
+  pattern := mkGrepPattern(filter,key)  --create string to pass to "grep"
+  grepConstructDo(pattern, key)  --do the "grep"---see b-saturn.boot
+
+grepConstructDo(x, key) ==
+  $orCount := 0
+--atom x => grepFile(x, key,'i)
+  $localLibdb =>
+    oldLines := purgeNewConstructorLines(grepf(x,key,false),$newConstructorList)
+    newLines := grepf(x,$localLibdb,false)
+    union(oldLines, newLines)
+  grepf(x,key,false)
+
+dbExposed?(line,kind) == -- does line come from an unexposed constructor?
+  conname := INTERN
+    kind = char 'a or kind = char 'o => dbNewConname line --get conname from middle
+    dbName line
+  isExposedConstructor conname
+
+dbScreenForDefaultFunctions lines == [x for x in lines | not isDefaultOpAtt x]
+
+isDefaultOpAtt x == x.(1 + dbTickIndex(x,4,0)) = char 'x
+
+grepForAbbrev(s,key) ==
+--checks that filter s is not * and is all uppercase; if so, look for abbrevs
+  u := HGET($lowerCaseConTb,s) => ['Abbreviations,u]    --try cheap test first
+  s := STRINGIMAGE s
+  someLowerCaseChar := false
+  someUpperCaseChar := false
+  for i in 0..MAXINDEX s repeat
+    c := s . i
+    LOWER_-CASE_-P c => return (someLowerCaseChar := true)
+    UPPER_-CASE_-P c => someUpperCaseChar := true
+  someLowerCaseChar or not someUpperCaseChar => false
+  pattern := DOWNCASE s
+  ['Abbreviations ,:[GETDATABASE(x,'CONSTRUCTORFORM)
+    for x in allConstructors() | test]] where test ==
+         not $includeUnexposed? and not isExposedConstructor x => false
+         a := GETDATABASE(x,'ABBREVIATION)
+         match?(pattern,PNAME a) and not HGET($defaultPackageNamesHT,x)
+
+applyGrep(x,filename) ==   --OBSELETE with $saturn--> see applyGrepSaturn
+  atom x => grepFile(x,filename,'i)
+  $localLibdb =>
+    a := purgeNewConstructorLines(grepf(x,filename,false),$newConstructorList)
+    b := grepf(x,$localLibdb,false)
+    grepCombine(a,b)
+  grepf(x,filename,false)
+
+grepCombine(a,b) == MSORT union(a,b)
+
+grepf(pattern,s,not?) ==  --s=sourceFile or list of strings
+  pattern is [op,:argl] =>
+    op = "and" =>
+      while argl is [arg,:argl] repeat
+        s := grepf(arg,s,not?)  -- filter by successive greps
+      s
+    op = "or" =>
+      targetStack := nil
+      "union"/[grepf(arg,s,not?) for arg in argl]
+    op = "not" =>
+      not? => grepf(first argl,s,false)
+      --could be the first time so have to get all of same $key
+      lines := grepf(mkGrepPattern('"*",$key),s,false)
+      grepf(first argl,lines,true)
+    systemError nil
+  option :=
+    not? => 'iv
+    'i
+  source :=
+    LISTP s => dbWriteLines s
+    s
+  grepFile(pattern,source,option)
+
+pmTransFilter s ==
+--result is either a string or (op ..) where op= and,or,not and arg are results
+  if $browseMixedCase = true then s := DOWNCASE s
+  or/[isFilterDelimiter? s.i or s.i = $charUnderscore for i in 0..MAXINDEX s]
+    => (parse := pmParseFromString s) and checkPmParse parse or
+        ['error,'"Illegal search string",'"\vspace{3}\center{{\em Your search string} ",escapeSpecialChars s,'" {\em has incorrect syntax}}"]
+  or/[s . i = char '_* and s.(i + 1) = char '_*
+      and (i=0 or s . (i - 1) ^= char $charUnderscore) for i in 0..(MAXINDEX s - 1)]
+       => ['error,'"Illegal search string",'"\vspace{3}\center{Consecutive {\em *}'s are not allowed in search patterns}"]
+  s
+
+checkPmParse parse ==
+  STRINGP parse => parse
+  fn parse => parse where fn(u) ==
+    u is [op,:args] =>
+      MEMQ(op,'(and or not)) and and/[checkPmParse x for x in args]
+    STRINGP u => true
+    false
+  nil
+
+dnForm x ==
+  STRINGP x => x
+  x is ['not,argl] =>
+    argl is ['or,:orargs]=>
+       ['and, :[dnForm negate u for u in orargs]] where negate s ==
+          s is ['not,argx] => argx
+          ['not,s]
+    argl is ['and,:andargs]=>
+       ['or,:[dnForm negate u for u in andargs]]
+    argl is ['not,notargl]=>
+       dnForm notargl
+    x
+  x is ['or,:argl1] => ['or,:[dnForm u for u in argl1]]
+  x is ['and,:argl2] => ['and,:[dnForm u for u in argl2]]
+  x
+
+pmParseFromString s ==
+  u := ncParseFromString pmPreparse s
+  dnForm flatten u where flatten s ==
+    s is [op,:argl] =>
+      STRINGP op => STRCONC(op,"STRCONC"/[STRCONC('" ",x) for x in argl])
+      [op,:[flatten x for x in argl]]
+    s
+
+pmPreparse s == hn fn(s,0,#s) where--stupid insertion of chars to get correct parse
+  hn x == SUBLISLIS('(and or not),'("and" "or" "not"),x)
+  fn(s,n,siz) ==  --main function: s is string, n is origin
+    n = siz => '""
+    i := firstNonDelim(s,n) or return SUBSTRING(s,n,nil)
+    j := firstDelim(s,i + 1) or siz
+    t := gn(s,i,j - 1)
+    middle :=
+      member(t,'("and" "or" "not")) => t
+      --the following 2 lines make commutative("*") parse correctly!!!!
+      t.0 = char '_" => t
+      j < siz - 1 and s.j = char '_( => t
+      STRCONC(char '_",t,char '_")
+    STRCONC(SUBSTRING(s,n,i - n),middle,fn(s,j,siz))
+  gn(s,i,j) ==    --replace each underscore by 4 underscores!
+    n := or/[k for k in i..j | s.k = $charUnderscore] =>
+      STRCONC(SUBSTRING(s,i,n - i + 1),$charUnderscore,gn(s,n + 1,j))
+    SUBSTRING(s,i,j - i + 1)
+
+firstNonDelim(s,n) ==  or/[k for k in n..MAXINDEX s | not isFilterDelimiter? s.k]
+firstDelim(s,n) ==  or/[k for k in n..MAXINDEX s | isFilterDelimiter? s.k]
+
+isFilterDelimiter? c == MEMQ(c,$pmFilterDelimiters)
+
+grepSplit(lines,doc?) ==
+  if doc? then
+    instream2 := OPEN STRCONC(getEnv '"AXIOM",'"/algebra/libdb.text")
+  cons := atts := doms := nil
+  while lines is [line, :lines] repeat
+    if doc? then
+        N:=PARSE_-INTEGER dbPart(line,1,-1)
+        if NUMBERP N then 
+           FILE_-POSITION(instream2,N)
+           line := READLINE instream2
+    kind := dbKind line
+    not $includeUnexposed? and not dbExposed?(line,kind) => 'skip
+    (kind = char 'a or kind = char 'o) and isDefaultOpAtt line => 'skip
+    PROGN
+      kind = char 'c => cats := insert(line,cats)
+      kind = char 'd => doms := insert(line,doms)
+      kind = char 'x => defs := insert(line,defs)
+      kind = char 'p => paks := insert(line,paks)
+      kind = char 'a => atts := insert(line,atts)
+      kind = char 'o => ops :=  insert(line,ops)
+      kind = char '_- => 'skip                --for now
+      systemError 'kind
+  if doc? then CLOSE instream2
+  [['"attribute",:NREVERSE atts],
+     ['"operation",:NREVERSE ops],
+       ['"category",:NREVERSE cats],
+         ['"domain",:NREVERSE doms],
+           ['"package",:NREVERSE paks]
+--           ['"default_ package",:NREVERSE defs]   -- drop defaults
+               ]
+
+mkUpDownPattern s == recurse(s,0,#s) where
+  recurse(s,i,n) ==
+    i = n => '""
+    STRCONC(fixchar(s.i),recurse(s,i + 1,n))
+  fixchar(c) ==
+    ALPHA_-CHAR_-P c =>
+      STRCONC(char '_[,CHAR_-UPCASE c,CHAR_-DOWNCASE c,char '_])
+    c
+
+mkGrepPattern(s,key) ==
+  --called by grepConstruct1 and grepf
+  atom s => mkGrepPattern1(s,key)
+  [first s,:[mkGrepPattern(x,key) for x in rest s]]
+
+mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?)
+  $options : local := options
+  s := STRINGIMAGE x
+--s := DOWNCASE STRINGIMAGE x
+  addOptions remUnderscores addWilds split(g s,char '_*) where
+    addWilds sl ==    --add wild cards (sl is list of parts between *'s)
+      IFCAR sl = '"" => h(IFCDR sl,[$wild1])
+      h(sl,nil)
+    g s  ==    --remove "*"s around pattern for text match
+      not MEMQ('w,$options) => s
+      if s.0 = char '_* then s := SUBSTRING(s,1,nil)
+      if s.(k := MAXINDEX s) = char '_* then s := SUBSTRING(s,0,k)
+      s
+    h(sl,res) == --helper for wild cards
+      sl is [s,:r] => h(r,[$wild1,s,:res])
+      res := rest res
+      if not MEMQ('w,$options) then
+        if first res ^= '"" then res := ['"`",:res]
+        else if res is [.,p,:r] and p = $wild1 then res := r
+      "STRCONC"/NREVERSE res
+    remUnderscores s ==
+      (k := charPosition(char $charUnderscore,s,0)) < MAXINDEX s =>
+        STRCONC(SUBSTRING(s,0,k),'"[",s.(k + 1),'"]",
+                remUnderscores(SUBSTRING(s,k + 2,nil)))
+      s
+    split(s,char) ==
+      max := MAXINDEX s + 1
+      f := -1
+      [SUBSTRING(s,i,f-i)
+        while ((i := f + 1) <= max) and (f := charPosition(char,s,i))]
+    charPosition(c,t,startpos) ==  --honors underscores
+      n := SIZE t
+      if startpos < 0 or startpos > n then error "index out of range"
+      k:= startpos
+      for i in startpos .. n-1 while c ^= ELT(t,i)
+        or i > startpos and ELT(t,i-1) = '__ repeat  (k := k+1)
+      k
+    addOptions s ==  --add front anchor
+      --options a o c d p x   denote standard items
+      --options w             means  comments
+      --option  t             means  text
+      --option  s             means  signature
+      --option  n             means  number of arguments
+      --option  i             means  predicate
+      --option  none          means  NO PREFIX
+      one := ($options is [x,:$options] and x => x; '"[^x]")
+      tick := '"[^`]*`"
+      one = 'w => s
+      one = 'none => (s = '"`" => '"^."; STRCONC('"^",s))
+      prefix :=
+        one = 't => STRCONC(tick,tick,tick,tick,tick,".*")
+        one = 'n => tick
+        one = 'i => STRCONC(tick,tick,tick,tick)
+        one = 's => STRCONC(tick,tick,tick)
+--      true => '""    ----> never put on following prefixes
+        one = 'k => '"[cdp]"
+        one = 'y => '"[cdpx]"
+        STRINGIMAGE one
+      s = $wild1 => STRCONC('"^",prefix)
+      STRCONC('"^",prefix,s)
+
+conform2OutputForm(form) ==
+  [op,:args] := form
+  null args => form
+  cosig := rest GETDATABASE(op,'COSIG)
+  atypes := rest CDAR GETDATABASE(op,'CONSTRUCTORMODEMAP)
+  sargl := [fn for x in args for atype in atypes for pred in cosig] where fn ==
+    pp [x,atype,pred]
+    pred => conform2OutputForm x
+    typ := sublisFormal(args,atype)
+    if x is ['QUOTE,a] then x := a
+    algCoerceInteractive(x,typ,'(OutputForm))
+  [op,:sargl]
+
+oPage(a,:b) == --called by \spadfun{opname}
+  oSearch (IFCAR b or a) --always take slow path
+
+oPageFrom(opname,conname) == --called by \spadfunFrom{opname}{conname}
+  htPage := htInitPage(nil,nil) --create empty page and fill in needed properties
+  htpSetProperty(htPage,'conform,conform := getConstructorForm conname)
+  htpSetProperty(htPage,'kind,STRINGIMAGE GETDATABASE(conname,'CONSTRUCTORKIND))
+  itemlist := ASSOC(opname,koOps(conform,nil)) --all operations name "opname"
+  null itemlist => systemError [conform,'" has no operation named ",opname]
+  opAlist := [itemlist]
+  dbShowOperationsFromConform(htPage,'"operation",opAlist)
+
+aPage(a,:b) ==  --called by \spadatt{a}
+  $attributeArgs : local := nil
+  arg := IFCAR b or a
+  s   := pmParseFromString STRINGIMAGE arg
+  searchOn :=
+    ATOM s => s
+    IFCAR s
+  $attributeArgs : local := IFCAR IFCDR s
+  aSearch searchOn
+--must recognize that not all attributes can be found in database
+--e.g. constant(deriv) is not but appears in a conditional in LODO
+
+spadType(x) ==  --called by \spadtype{x} from HyperDoc
+  s := PNAME x
+  form := ncParseFromString s or
+            systemError ['"Argument: ",s,'" to spadType won't parse"]
+  if atom form then form := [form]
+  op    := opOf form
+  looksLikeDomainForm form => APPLY(function conPage,form)
+  conPage(op)
+
+looksLikeDomainForm x ==
+  entry := getCDTEntry(opOf x,true) or return false
+  coSig := LASSOC('coSig,CDDR entry)
+  k := #coSig
+  atom x => k = 1
+  k ^= #x => false
+  and/[p for key in rest coSig for arg in rest x] where
+    p ==
+      key => looksLikeDomainForm arg
+      not IDENTP arg
+
+spadSys(x) ==   --called by \spadsyscom{x}
+  s := PNAME x
+  if s.0 = char '_) then s := SUBSTRING(s,1,nil)
+  form := ncParseFromString s or
+           systemError ['"Argument: ",s,'" to spadType won't parse"]
+  htSystemCommands PNAME opOf form
+
+--=======================================================================
+--                   Name and General Search
+--=======================================================================
+aokSearch filter ==  genSearch(filter,true)  --"General" from HD (see man0.ht)
+--General search for constructs but NOT documentation
+
+genSearch(filter,:options) == --"Complete" from HD (see man0.ht) and aokSearch
+--General + documentation search
+  null (filter := checkFilter filter) => nil  --in case of filter error
+  filter = '"*" => htErrorStar()
+  includeDoc? := not IFCAR options
+--give summaries for how many a o c d p x match filter
+  regSearchAlist := grepConstruct(STRINGIMAGE filter,".",true)
+  regSearchAlist is ['error,:.] => bcErrorPage regSearchAlist
+  key := removeSurroundingStars filter
+  if includeDoc? then
+    docSearchAlist := grepConstruct(key,'w,true)
+    docSearchAlist is ['error,:.] => bcErrorPage docSearchAlist
+    docSearchAlist := [x for x in docSearchAlist | x.0 ^= char 'x]--drop defaults
+  genSearch1(filter,genSearchTran regSearchAlist,genSearchTran docSearchAlist)
+
+genSearchTran alist == [[x,y,:y] for [x,:y] in alist]
+
+
+genSearch1(filter,reg,doc) ==
+  regSearchAlist := searchDropUnexposedLines reg
+  docSearchAlist := searchDropUnexposedLines doc
+  key := removeSurroundingStars filter
+  regCount := searchCount regSearchAlist
+  docCount := searchCount docSearchAlist
+  count := regCount + docCount
+  count = 0 => emptySearchPage('"entry",filter,true)
+  count = 1 =>
+    alist := (regCount = 1 => regSearchAlist; docSearchAlist)
+    showNamedConstruct(or/[x for x in alist | CADR x])
+  summarize? :=
+    docSearchAlist => true
+    nonEmpties := [pair for pair in regSearchAlist | #(CADR pair) > 0]
+    not(nonEmpties is [pair])
+  not summarize? => showNamedConstruct pair
+  -----------generate a summary page---------------------------
+  plural :=
+    $exposedOnlyIfTrue => '"exposed entries match"
+    '"entries match"
+  prefix := pluralSay(count,'"", plural)
+  emfilter := ['"{\em ",escapeSpecialChars STRINGIMAGE filter,'"}"]
+  header := [:prefix,'" ",:emfilter]
+  page := htInitPage(header,nil)
+  htpSetProperty(page,'regSearchAlist,regSearchAlist)
+  htpSetProperty(page,'docSearchAlist,docSearchAlist)
+  htpSetProperty(page,'filter,filter)
+  if docSearchAlist then
+      dbSayItems(['"{\bf Construct Summary:} ",regCount],'"name matches",'"names match")
+  for [kind,:pair] in regSearchAlist for i in 0.. | #(first pair) > 0 repeat
+    bcHt '"\newline{}"
+    htSayStandard '"\tab{2}"
+    genSearchSay(pair,summarize?,kind,i,'showConstruct)
+  if docSearchAlist then
+    htSaySaturn '"\bigskip{}"
+    dbSayItems(['"\newline{\bf Documentation Summary:} ",docCount],'"mention",'"mentions",'" of {\em ",key,'"}")
+    for [kind,:pair] in docSearchAlist for i in 0.. | #(first pair) > 0 repeat
+      bcHt "\newline{}"
+      htSayStandard '"\tab{2}"
+      genSearchSay(pair,true,kind,i,'showDoc)
+  htShowPageStar()
+searchDropUnexposedLines alist ==
+  [[op,[pred for line in lines | pred],:lines] for [op,.,:lines] in alist] where
+    pred ==
+      not $exposedOnlyIfTrue or dbExposed?(line,dbKind line) => line
+      nil
+
+htShowPageStar() ==
+------------> OBSELETE
+  htSayStandard '"\endscroll "
+  if $exposedOnlyIfTrue then
+    htMakePage [['bcLinks,['"Exposed",'" {\em only}",'repeatSearch,NIL]]]
+  else
+    htSay('"*{\em =}")
+    htMakePage [['bcLinks,['"unexposed",'"",'repeatSearch,'T]]]
+  htShowPageNoScroll()
+
+repeatSearch(htPage,newValue) ==
+  $exposedOnlyIfTrue := newValue
+  filter := htpProperty(htPage,'filter)
+  reg    := htpProperty(htPage,'regSearchAlist)
+  doc    := htpProperty(htPage,'docSearchAlist)
+  reg => genSearch1(filter,reg,doc)
+  docSearch1(filter,doc)
+
+searchCount u == +/[# y for [x,y,:.] in u]
+
+showDoc(htPage,count) ==
+  showIt(htPage,count,htpProperty(htPage,'docSearchAlist))
+
+showConstruct(htPage,count) ==
+  showIt(htPage,count,htpProperty(htPage,'regSearchAlist))
+
+showIt(htPage,index,searchAlist) ==
+  filter      := htpProperty(htPage,'filter)
+  [relativeIndex,n] := DIVIDE(index,8)
+  relativeIndex = 0 => showNamedConstruct(searchAlist.n)
+  [kind,items,:.] := searchAlist . n
+  for j in 1.. while j < relativeIndex repeat items := rest items
+  firstName := dbName first items --select name then gather all of same name
+  lines := [line for line in items while dbName line = firstName]
+  showNamedConstruct [kind,nil,:lines]
+
+showNamedConstruct([kind,.,:lines]) == dbSearch(lines,kind,'"")
+
+genSearchSay(pair,summarize,kind,who,fn) ==
+  [u,:fullLineList] := pair
+  count := #u
+  uniqueCount := genSearchUniqueCount u
+  short := summarize and uniqueCount >= $browseCountThreshold
+  htMakePage
+    [['bcLinks,[menuButton(),'"",'genSearchSayJump,[fullLineList,kind]]]]
+  if count = 0 then htSay('"{\em No ",kind,'"} ")
+  else if count = 1 then
+    htSay('"{\em 1 ",kind,'"} ")
+  else
+    htSay('"{\em ",count,'" ",pluralize kind,'"} ")
+  short => 'done	
+  if uniqueCount ^= 1 then
+    htSayStandard '"\indent{4}"
+    htSay '"\newline "
+    htBeginTable()
+  lastid := nil
+  groups := organizeByName u
+  i := 1
+  for group in groups repeat
+    id := dbGetName first group
+    if $includeUnexposed? then
+      exposed? := or/[dbExposed?(item,dbKind item) for item in group]
+    bcHt '"{"
+    if $includeUnexposed? then
+        exposed? => htBlank()
+        htSayUnexposed()
+    htMakePage [['bcLinks, [id,'"",fn,who + 8*i]]]
+    i := i + #group
+    bcHt '"}"
+  if uniqueCount ^= 1 then
+     htEndTable()
+     htSayStandard '"\indent{0}"
+
+organizeByName u ==
+  [[(u := rest u; x) while u and head = dbName (x := first u)]
+      while u and (head := dbName first u)]
+
+genSearchSayJump(htPage,[lines,kind]) ==
+  filter := htpProperty(htPage,'filter)
+  dbSearch(lines,kind,filter)
+
+genSearchUniqueCount(u) ==
+--count the unique number of items (if less than $browseCountThreshold)
+  count := 0
+  lastid := nil
+  for item in u while count < $browseCountThreshold repeat
+    id := dbGetName item
+    if id ^= lastid then
+      count := count + 1
+      lastid := id
+  count
+
+dbGetName line == SUBSTRING(line,1,charPosition($tick,line,1) - 1)
+
+pluralSay(count,singular,plural,:options) ==
+  item := (options is [x,:options] => x; '"")
+  colon := (IFCAR options => '":"; '"")
+  count = 0 => concat('"No ",singular,item)
+  count = 1 => concat('"1 ",singular,item,colon)
+  concat(count,'" ",plural,item,colon)
+
+
+--=======================================================================
+--                   Documentation Search
+--=======================================================================
+docSearch filter ==  --"Documentation" from HD (see man0.ht)
+  null (filter := checkFilter filter) => nil  --in case of filter error
+  filter = '"*" => htErrorStar()
+  key := removeSurroundingStars filter
+  docSearchAlist := grepConstruct(filter,'w,true)
+  docSearchAlist is ['error,:.] => bcErrorPage docSearchAlist
+  docSearchAlist := [x for x in docSearchAlist | x.0 ^= char 'x] --drop defaults
+  docSearch1(filter,genSearchTran docSearchAlist)
+
+docSearch1(filter,doc) ==
+  docSearchAlist := searchDropUnexposedLines doc
+  count := searchCount docSearchAlist
+  count = 0 => emptySearchPage('"entry",filter,true)
+  count = 1 => showNamedConstruct(or/[x for x in docSearchAlist | CADR x],1)
+  prefix := pluralSay(count,'"entry matches",'"entries match")
+  emfilter := ['"{\em ",escapeSpecialChars STRINGIMAGE filter,'"}"]
+  header := [:prefix,'" ",:emfilter]
+  page := htInitPage(header,nil)
+  htpSetProperty(page,'docSearchAlist,docSearchAlist)
+  htpSetProperty(page,'regSearchAlist,nil)
+  htpSetProperty(page,'filter,filter)
+  dbSayItems(['"\newline Documentation Summary: ",count],'"mention",'"mentions",'" of {\em ",filter,'"}")
+  for [kind,:pair] in docSearchAlist for i in 0.. | #(first pair) > 0 repeat
+    bcHt '"\newline{}"
+    htSayStandard '"\tab{2}"
+    genSearchSay(pair,true,kind,i,'showDoc)
+  htShowPageStar()
+
+removeSurroundingStars filter ==
+  key := STRINGIMAGE filter
+  if key.0 = char '_* then key := SUBSTRING(key,1,nil)
+  if key.(max := MAXINDEX key) = char '_* then key := SUBSTRING(key,0,max)
+  key
+
+showNamedDoc([kind,:lines],index) ==
+  dbGather(kind,lines,index - 1,true)
+
+sayDocMessage message ==
+  htSay('"{\em ")
+  if message is [leftEnd,left,middle,right,rightEnd] then
+    htSay(leftEnd,left,'"}")
+    if left ^= '"" and left.(MAXINDEX left) = $blank then htBlank()
+    htSay middle
+    if right ^= '"" and right.0 = $blank then htBlank()
+    htSay('"{\em ",right,rightEnd)
+  else
+    htSay message
+  htSay ('"}")
+
+stripOffSegments(s,n) ==
+  progress := true
+  while n > 0 and progress = true repeat
+    n := n - 1
+    k := charPosition(char '_`,s,0)
+    new := SUBSTRING(s,k + 1,nil)
+    #new < #s => s := new
+    progress := false
+  n = 0 => s
+  nil
+
+replaceTicksBySpaces s ==
+  n := -1
+  max := MAXINDEX s
+  while (n := charPosition(char '_`,s,n + 1)) <= max repeat SETELT(s,n,char '_ )
+  s
+
+checkFilter filter ==
+  filter := STRINGIMAGE filter
+  filter = '"" => '"*"
+  trimString filter
+
+aSearch filter ==  --called from HD (man0.ht): general attribute search
+  null (filter := checkFilter filter) => nil  --in case of filter error
+  dbSearch(grepConstruct(filter,'a),'"attribute",filter)
+
+oSearch filter == -- called from HD (man0.ht): operation search
+  opAlist := opPageFastPath filter => opPageFast opAlist
+  key := 'o
+  null (filter := checkFilter filter) => nil  --in case of filter error
+  filter = '"*" => grepSearchQuery('"operation",[filter,key,'"operation",'oSearchGrep])
+  oSearchGrep(filter,key,'"operation")
+
+oSearchGrep(filter,key,kind) == --called from grepSearchQuery/oSearch
+  dbSearch(grepConstruct(filter,'o),kind,filter)
+
+grepSearchQuery(kind,items) ==
+  page := htInitPage('"Query Page",nil)
+  htpSetProperty(page,'items,items)
+  htQuery(['"{\em Do you want a list of {\em all} ",pluralize kind,'"?\vspace{1}}"],'grepSearchJump,true)
+  htShowPage()
+
+cSearch filter ==  --called from HD (man0.ht): category search
+   constructorSearch(checkFilter filter,'c,'"category")
+
+dSearch filter ==  --called from HD (man0.ht): domain search
+   constructorSearch(checkFilter filter,'d,'"domain")
+
+pSearch filter ==  --called from HD (man0.ht): package search
+   constructorSearch(checkFilter filter,'p,'"package")
+
+xSearch filter ==  --called from HD (man0.ht): default package search
+   constructorSearch(checkFilter filter,'x,'"default package")
+
+kSearch filter ==  --called from HD (man0.ht): constructor search (no defaults)
+   constructorSearch(checkFilter filter,'k,'"constructor")
+
+ySearch filter == --called from conPage: like kSearch but defaults included
+  constructorSearch(checkFilter filter,'y,'"constructor")
+
+constructorSearch(filter,key,kind) ==
+  null filter => nil      --in case of filter error
+  (parse := conSpecialString? filter) => conPage parse
+  pageName := LASSOC(DOWNCASE filter,'(("union" . DomainUnion)("record" . DomainRecord)("mapping" . DomainMapping) ("enumeration" . DomainEnumeration))) =>
+    downlink pageName
+  name := (STRINGP filter => INTERN filter; filter)
+  if u := HGET($lowerCaseConTb,name) then filter := STRINGIMAGE first u
+  line := conPageFastPath DOWNCASE filter =>
+    code := dbKind line
+    newkind :=
+      code = char 'p => '"package"
+      code = char 'd => '"domain"
+      code = char 'c => '"category"
+      nil
+    kind = '"constructor" or kind = newkind => kPage line
+    page := htInitPage('"Query Page",nil)
+    htpSetProperty(page,'line,line)
+    message :=
+      ['"{\em ",dbName line,'"} is not a {\em ",kind,'"} but a {\em ",
+        newkind,'"}. Would you like to view it?\vspace{1}"]
+    htQuery(message, 'grepConstructorSearch,true)
+    htShowPage()
+  filter = '"*" => grepSearchQuery(kind,[filter,key,kind,'constructorSearchGrep])
+  constructorSearchGrep(filter,key,kind)
+
+grepConstructorSearch(htPage,yes) == kPage htpProperty(htPage,'line)
+
+conSpecialString?(filter,:options) ==
+  secondTime := IFCAR options
+  parse :=
+    words := string2Words filter is [s] => ncParseFromString s
+    and/[not member(x,'("and" "or" "not")) for x in words] => ncParseFromString filter
+    false
+  null parse => nil
+  form := conLowerCaseConTran parse
+  MEMQ(KAR form,'(and or not)) or CONTAINED("*",form) => nil
+  filter = '"Mapping" =>nil
+  u := kisValidType form => u
+  secondTime => false
+  u := "STRCONC"/[string2Constructor x for x in dbString2Words filter]
+  conSpecialString?(u, true)
+
+dbString2Words l ==
+  i := 0
+  [w while dbWordFrom(l,i) is [w,i]]
+
+$dbDelimiters := [char " " , char "(", char ")"]
+
+dbWordFrom(l,i) ==
+  maxIndex := MAXINDEX l
+  while maxIndex >= i and l.i = char " " repeat i := i + 1
+  if maxIndex >= i and member(l.i, $dbDelimiters) then return [l.i, i + 1]
+  k := or/[j for j in i..maxIndex | not member(l.j, $dbDelimiters)] or return nil
+  buf := '""
+  while k <= maxIndex and not member(c := l.k, $dbDelimiters) repeat
+    ch :=
+      c = char '__   => l.(k := 1+k)  --this may exceed bounds
+      c
+    buf := STRCONC(buf,ch)
+    k := k + 1
+  [buf,k]
+
+conLowerCaseConTran x ==
+  IDENTP x => IFCAR HGET($lowerCaseConTb, x) or x
+  atom x   => x
+  [conLowerCaseConTran y for y in x]
+
+string2Constructor x ==
+  not STRINGP x => x
+  IFCAR HGET($lowerCaseConTb, INTERN DOWNCASE x) or x
+
+conLowerCaseConTranTryHarder x ==
+  IDENTP x => IFCAR HGET($lowerCaseConTb,DOWNCASE x) or x
+  atom x   => x
+  [conLowerCaseConTranTryHarder y for y in x]
+
+constructorSearchGrep(filter,key,kind) ==
+  dbSearch(grepConstruct(filter,key),kind,filter)
+
+grepSearchJump(htPage,yes) ==
+  [filter,key,kind,fn] := htpProperty(htPage,'items)
+  FUNCALL(fn,filter,key,kind)
+
+--=======================================================================
+--            Branch Functions After Database Search
+--=======================================================================
+dbSearch(lines,kind,filter) == --called by attribute, operation, constructor search
+  lines is ['error,:.] => bcErrorPage lines
+  null filter => nil      --means filter error
+  lines is ['Abbreviations,:r] => dbSearchAbbrev(lines,kind,filter)
+  if member(kind,'("attribute" "operation")) then --should not be necessary!!
+    lines := dbScreenForDefaultFunctions lines
+  count := #lines
+  count = 0 => emptySearchPage(kind,filter)
+  member(kind,'("attribute" "operation")) => dbShowOperationLines(kind,lines)
+  dbShowConstructorLines lines
+
+dbSearchAbbrev([.,:conlist],kind,filter) ==
+  null conlist => emptySearchPage('"abbreviation",filter)
+  kind := intern kind
+  if kind ^= 'constructor then
+    conlist := [x for x in conlist | LASSOC('kind,IFCDR IFCDR x) = kind]
+  conlist is [[nam,:.]] => conPage DOWNCASE nam
+  cAlist := [[con,:true] for con in conlist]
+  htPage := htInitPage('"",nil)
+  htpSetProperty(htPage,'cAlist,cAlist)
+  htpSetProperty(htPage,'thing,nil)
+  return dbShowCons(htPage,'names)
+  page := htInitPage([#conlist,
+    '" Abbreviations Match {\em ",STRINGIMAGE filter,'"}"],nil)
+  for [nam,abbr,:r] in conlist repeat
+    kind := LASSOC('kind,r)
+    htSay('"\newline{\em ",s := STRINGIMAGE abbr)
+    htSayStandard '"\tab{10}"
+    htSay '"}"
+    htSay kind
+    htSayStandard '"\tab{19}"
+    bcCon nam
+  htShowPage()
+
+--=======================================================================
+--                   Selectable Search
+--=======================================================================
+detailedSearch(filter) ==
+  page := htInitPage('"Detailed Search with Options",nil)
+  filter   := escapeSpecialChars PNAME filter
+  bcHt '"Select what you want to search for, then click on {\em Search} below"
+  bcHt '"\newline{\it Note:} Logical searches using {\em and}, {\em or}, and {\em not} are not permitted here."
+  htSayHrule()
+  htMakePage '(
+    (text . "\newline")
+    (bcRadioButtons which
+      (  "\tab{3}{\em Operations}"
+         ((text . "\newline\space{3}")
+          (text . "name")       (bcStrings (14 "*" opname EM))
+          (text . " \#args")    (bcStrings (1  "*" opnargs EM))
+          (text . " signature") (bcStrings (14 "*" opsig EM))
+          (text . "\vspace{1}\newline "))
+         ops)
+      (  "\tab{3}{\em Attributes}"
+         ((text . "\newline\space{3}")
+          (text . "name")       (bcStrings (14 "*" attrname EM))
+          (text . " \#args ")   (bcStrings (1  "*" attrnargs EM))
+          (text . " arguments ")(bcStrings (14 "*" attrargs EM))
+          (text . "\vspace{1}\newline "))
+         attrs)
+      (  "\tab{3}{\em Constructors}"
+         ((text . "\tab{17}")
+          (bcButtons (1 cats)) (text . " {\em categories} ")
+          (bcButtons (1 doms)) (text . " {\em domains} ")
+          (bcButtons (1 paks)) (text . " {\em packages} ")
+          (bcButtons (1 defs)) (text . " {\em defaults} ")
+          (text . "\newline\tab{3}")
+          (text . "name")   (bcStrings (14 "*" conname EM))
+          (text . " \#args") (bcStrings (1  "*" connargs EM))
+          (text . "signature") (bcStrings (14 "*" consig EM))
+          (text . "\vspace{1}\newline "))
+          cons)
+--      (   "\tab{3}{\em Documentation}"
+--          ((text . "\tab{26}key")
+--           (bcStrings (28 "*" docfilter EM)))
+--          doc)
+                )
+    (text . "\vspace{1}\newline\center{ ")
+    (bcLinks ("\box{Search}" "" generalSearchDo NIL))
+    (text . "}"))
+  htShowPage()
+
+generalSearchDo(htPage,flag) ==
+--$exposedOnlyIfTrue := (flag => 'T; nil)
+  $htPage := htPage
+  alist := htpInputAreaAlist htPage
+  which := htpButtonValue(htPage,'which)
+  selectors :=
+    which = 'cons => '(conname connargs consig)
+    which = 'ops  => '(opname  opnargs  opsig)
+    '(attrname attrnargs attrargs)
+  name := generalSearchString(htPage,selectors.0)
+  nargs:= generalSearchString(htPage,selectors.1)
+  npat := standardizeSignature generalSearchString(htPage,selectors.2)
+  kindCode :=
+    which = 'ops => char 'o
+    which = 'attrs => char 'a
+    acc := '""
+    if htButtonOn?(htPage,'cats) then acc := STRCONC(char 'c,acc)
+    if htButtonOn?(htPage,'doms) then acc := STRCONC(char 'd,acc)
+    if htButtonOn?(htPage,'paks) then acc := STRCONC(char 'p,acc)
+    if htButtonOn?(htPage,'defs) then acc := STRCONC(char 'x,acc)
+    n := #acc
+    n = 0 or n = 4 => '"[cdpx]"
+    n = 1 => acc
+    STRCONC(char '_[,acc,char '_])
+  form := mkDetailedGrepPattern(kindCode,name,nargs,npat)
+  lines := applyGrep(form,'libdb)
+--lines := dbReadLines resultFile
+  if MEMQ(which,'(ops attrs)) then lines := dbScreenForDefaultFunctions lines
+  kind :=
+    which = 'cons =>
+      n = 1 =>
+        htButtonOn?(htPage,'cats) => '"category"
+        htButtonOn?(htPage,'doms) => '"domain"
+        htButtonOn?(htPage,'paks) => '"package"
+        '"default package"
+      '"constructor"
+    which = 'ops  => '"operation"
+    '"attribute"
+  null lines => emptySearchPage(kind,nil)
+  dbSearch(lines,kind,'"filter")
+
+generalSearchString(htPage,sel) ==
+  string := htpLabelInputString(htPage,sel)
+  string = '"" => '"*"
+  string
+
+htButtonOn?(htPage,key) ==
+  LASSOC(key,htpInputAreaAlist htPage) is [a,:.] and a = '" t"
+
+mkDetailedGrepPattern(kind,name,nargs,argOrSig) == main where
+  main ==
+    nottick := '"[^`]"
+    name := replaceGrepStar name
+    firstPart :=
+      $saturn => STRCONC(char '_^,name)
+      STRCONC(char '_^,kind,name)
+    nargsPart := replaceGrepStar nargs
+    exposedPart := char '_.   --always get exposed/unexposed
+    patPart := replaceGrepStar argOrSig
+    simp STRCONC(conc(firstPart,conc(nargsPart,conc(exposedPart, patPart))),$tick)
+  conc(a,b) ==
+    b = '"[^`]*" or b = char '_. => a
+    STRCONC(a,$tick,b)
+  simp a ==
+    m := MAXINDEX a
+    m > 6 and a.(m-5) = char '_[ and a.(m-4) = char '_^
+      and     a.(m-3) = $tick    and a.(m-2) = char '_]
+          and a.(m-1) = char '_* and a.m = $tick
+            => simp SUBSTRING(a,0,m-5)
+    a
+
+replaceGrepStar s ==
+  s = "" => s
+  final := MAXINDEX s
+  i := charPosition(char '_*,s,0)
+  i > final => s
+  STRCONC(SUBSTRING(s,0,i),'"[^`]*",replaceGrepStar SUBSTRING(s,i + 1,nil))
+
+standardizeSignature(s) == underscoreDollars
+  s.0 = char '_( => s
+  k := STRPOS('"->",s,0,nil) or return s --will fail except perhaps on constants
+  s.(k - 1) = char '_) => STRCONC(char '_(,s)
+  STRCONC(char '_(,SUBSTRING(s,0,k),char '_),SUBSTRING(s,k,nil))
+
+underscoreDollars(s) == fn(s,0,MAXINDEX s) where
+  fn(s,i,n) ==
+    i > n => '""
+    (m := charPosition(char '_$,s,i)) > n => SUBSTRING(s,i,nil)
+    STRCONC(SUBSTRING(s,i,m - i),'"___$",fn(s,m + 1,n))
+
+--=======================================================================
+--                     Code dependent on $saturn
+--=======================================================================
+
+obey x ==
+  $saturn and not $aixTestSaturn => nil
+  OBEY x
+
+--=======================================================================
+--                         I/O Code
+--=======================================================================
+
+getTempPath kind ==
+  pathname := mkGrepFile kind
+  obey STRCONC('"rm -f ", pathname)
+  pathname
+
+dbWriteLines(s, :options) ==
+  pathname := IFCAR options or getTempPath 'source
+  $outStream: local := MAKE_-OUTSTREAM pathname
+  for x in s repeat writedb x
+  SHUT $outStream
+  pathname
+
+dbReadLines target == --AIX only--called by grepFile
+  instream := OPEN target
+  lines := [READLINE instream while not EOFP instream]
+  CLOSE instream
+  lines
+
+dbGetCommentOrigin line ==
+--Given a comment line in comdb, returns line in libdb pointing to it
+--Comment lines have format  [dcpxoa]xxxxxx`ccccc... where
+--x's give pointer into libdb, c's are comments
+  firstPart := dbPart(line,1,-1)
+  key := INTERN SUBSTRING(firstPart,0,1)    --extract this and throw away
+  address := SUBSTRING(firstPart, 1, nil)   --address in libdb
+  instream := OPEN grepSource key           --this always returns libdb now
+  FILE_-POSITION(instream,PARSE_-INTEGER address)
+  line := READLINE instream
+  CLOSE instream
+  line
+
+grepSource key ==
+  key = 'libdb   => STRCONC($SPADROOT,'"/algebra/libdb.text")
+  key = 'gloss   => STRCONC($SPADROOT,'"/algebra/glosskey.text")
+  key = $localLibdb => $localLibdb
+  mkGrepTextfile
+    MEMQ(key, '(_. a c d k o p x)) => 'libdb
+    'comdb
+
+mkGrepTextfile s == STRCONC($SPADROOT,"/algebra/", STRINGIMAGE s, '".text")
+
+mkGrepFile s ==  --called to generate a path name for a temporary grep file
+  prefix :=
+    $standard or $aixTestSaturn => '"/tmp/"
+    STRCONC($SPADROOT,'"/algebra/")
+  suffix := getEnv '"SPADNUM"
+  STRCONC(prefix, PNAME s,'".txt.", suffix)
+
+--=======================================================================
+--                     Grepping Code
+--=======================================================================
+
+grepFile(pattern,:options) ==
+  key := (x := IFCAR options => (options := rest options; x); nil)
+  source := grepSource key
+  lines :=
+    not PROBE_-FILE source => NIL
+    $standard or $aixTestSaturn =>
+    -----AIX Version----------
+      target := getTempPath 'target
+      casepart :=
+        MEMQ('iv,options)=> '"-vi"
+        '"-i"
+      command := STRCONC('"grep ",casepart,'" _'",pattern,'"_' ",source)
+      obey
+        member(key,'(a o c d p x)) =>
+          STRCONC(command, '" | sed 's/~/", STRINGIMAGE key, '"/' > ", target)
+        STRCONC(command, '" > ",target)
+      dbReadLines target
+    ----Windows Version------
+    invert? := MEMQ('iv, options)
+    GREP(source, pattern, false, not invert?)
+  dbUnpatchLines lines
+
+dbUnpatchLines lines ==  --concatenate long lines together, skip blank lines
+  dash := char '_-
+  acc := nil
+  while lines is [line, :lines] repeat
+    #line = 0 => 'skip     --skip blank lines
+    acc :=
+      line.0 = dash and line.1 = dash =>
+        [STRCONC(first acc,SUBSTRING(line,2,nil)),:rest acc]
+      [line,:acc]
+  -- following call to NREVERSE needed to keep lines properly sorted
+  NREVERSE acc  ------> added by BMT 12/95
+
+
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}