Misc cleanups

ChangeLog

@@ -1,3 +1,28 @@
+2024-04-30  Waldek Hebisch  <[email protected]>
+
+	* src/interp/br-con.boot, src/interp/br-data.boot,
+	src/interp/br-saturn.boot, src/interp/br-search.boot,
+	src/interp/br-util.boot, src/interp/c-doc.boot,
+	src/interp/c-util.boot, src/interp/compiler.boot,
+	src/interp/define.boot, src/interp/format.boot,
+	src/interp/g-cndata.boot, src/interp/g-timer.boot,
+	src/interp/ht-util.boot, src/interp/i-analy.boot,
+	src/interp/i-coerce.boot, src/interp/i-funsel.boot,
+	src/interp/i-intern.boot, src/interp/i-map.boot,
+	src/interp/i-output.boot, src/interp/i-spec2.boot,
+	src/interp/i-syscmd.boot, src/interp/i-toplev.boot,
+	src/interp/info.boot, src/interp/int-top.boot,
+	src/interp/interop.boot, src/interp/lisplib.boot,
+	src/interp/macros.lisp, src/interp/msgdb.boot,
+	src/interp/ncomp.boot, src/interp/nlib.lisp,
+	src/interp/nruncomp.boot, src/interp/postpar.boot,
+	src/interp/scan.boot, src/interp/setq.lisp,
+	src/interp/setvart.boot, src/interp/showimp.boot,
+	src/interp/trace.boot, src/interp/util.lisp,
+	src/lisp/Makefile.in, src/lisp/fricas-lisp.lisp,
+	src/lisp/fricas-package.lisp, src/scripts/build_helper:
+	Misc cleanups
+
 2024-04-29  Waldek Hebisch  <[email protected]>
 
 	* src/interp/c-util.boot: Downgrade two errors to warnings

src/interp/br-con.boot

@@ -69,29 +69,6 @@ conPageConEntry entry ==
 
 kxPage(htPage,name) == downlink name
 
-kdPageInfo(name,abbrev,nargs,conform,signature,file?) ==
-  htSay('"{\sf ",name,'"}")
-  if abbrev ~= name then bcHt ['" has abbreviation ",abbrev]
-  if file? then bcHt ['" is a source file."]
-  if nargs = 0 then (if abbrev ~= name then bcHt '".")
-    else
-      if abbrev ~= name then bcHt '" and"
-      bcHt
-        nargs = 1 => '" takes one argument:"
-        ['" takes ",STRINGIMAGE nargs,'" arguments:"]
-  htSayStandard '"\indentrel{2}"
-  if nargs > 0 then kPageArgs(conform,signature)
-  htSayStandard '"\indentrel{-2}"
-  if name.(#name-1) = char "&" then name := SUBSEQ(name, 0, #name-1)
-  sourceFileName := get_database(INTERN(name), 'SOURCEFILE)
-  filename := extractFileNameFromPath sourceFileName
-  if filename ~= '"" then
-    htSayStandard '"\newline{}"
-    htSay('"The source code for the constructor is found in ")
-  htMakePage [['text,'"\unixcommand{",filename,'"}{_\$FRICAS/lib/SPADEDIT ",
-              sourceFileName, '" ", name, '"}"]]
-  if nargs ~= 0 then htSay '"."
-
 kArgPage(htPage,arg) ==
   [op,:args] := conform := htpProperty(htPage,'conform)
   domname := htpProperty(htPage,'domname)
@@ -107,40 +84,8 @@ kArgPage(htPage,arg) ==
     ('(First Second Third Fourth Fifth)).n
   htpSetProperty(htPage,'rank,rank)
   htpSetProperty(htPage,'thing,'"argument")
---htpSetProperty(htPage,'specialMessage,['reportCategory,conform,typeForm,arg])
   dbShowCons(htPage,'names)
 
-reportCategory(conform,typeForm,arg) ==
-  htSay('"Argument {\em ",arg,'"}")
-  [conlist, :oplist] := categoryParts(conform,typeForm,true)
-  htSay '" must "
-  if conlist then
-    htSay '"belong to "
-    if conlist is [u] then
-       htSay('"category ")
-       bcConform first u
-       bcPred rest u
-    else
-       htSay('"categories:")
-       bcConPredTable(conlist,opOf conform)
-       htSay '"\newline "
-  if oplist then
-    if conlist then htSay '" and "
-    report_ops(oplist)
-
-report_ops(oplist) ==
-  htSayList(['"have ", '"operation", '":"])
-  for [op,sig,:pred] in oplist repeat
-      htSay('"\newline ")
-      if #oplist = 1 then htSay('"\centerline{")
-      ops  := escapeSpecialChars STRINGIMAGE op
-      sigs := form2HtString ['Mapping,:sig]
-      satDownLink(ops,['"(|opPage| '|",ops,'"| |",sigs,'"|)"])
-      htSay('": ")
-      bcConform ['Mapping,:sig]
-      if #oplist = 1 then htSay('"}")
-  htSay '"\newline "
-
 mkDomTypeForm(typeForm,conform,domname) == --called by kargPage
   domname => SUBLISLIS(rest domname,rest conform,typeForm)
   typeForm is ['Join,:r] => ['Join,:[mkDomTypeForm(t,conform,domname) for t in r]]
@@ -177,17 +122,6 @@ domainDescendantsOf(conform,domform) == main where --called by kargPage
 --                   Branches of Constructor Page
 --=======================================================================
 
-kiPage(htPage,junk) ==
-  [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
-  conform         := mkConform(kind,name,args)
-  domname         := kDomainName(htPage,kind,name,nargs)
-  domname is ['error,:.] => errorPage(htPage,domname)
-  heading := ['"Description of ", capitalize kind,'" {\sf ",name,args,'"}"]
-  page := htInitPage(heading,htCopyProplist htPage)
-  $conformsAreDomains := domname
-  dbShowConsDoc1(htPage,conform,nil)
-  htShowPage()
-
 kePage(htPage,junk) ==
   [kind,name,nargs,xflag,sig,args,abbrev,comments] := htpProperty(htPage,'parts)
   constring       := STRCONC(name,args)
@@ -757,12 +691,9 @@ dbShowCons1(htPage,cAlist,key) ==
   --key = 'catfilter => dbShowCatFilter(page,key)
     key = 'names => bcNameConTable conlist
     key = 'abbrs =>
-      bcAbbTable [getCDTEntry(con,true) for con in conlist]
-    key = 'files =>
-      flist :=
-        [y for con in conlist |
-          y := (fn := get_database(con, 'SOURCEFILE))]
-      bcUnixTable(listSort(function GLESSEQP,REMDUP flist))
+        bcAbbTable(page, [[con ,get_database(con, 'ABBREVIATION)]
+                          for con in conlist])
+    key = 'files => BREAK()
     key = 'documentation   => dbShowConsDoc(page,conlist)
     if $exposedOnlyIfTrue then
       cAlist := [x for x in cAlist | isExposedConstructor opOf first x]
@@ -877,19 +808,6 @@ dbShowConstructorLines lines ==
   cAlist := [[getConstructorForm intern dbName line,:true] for line in lines]
   dbShowCons1(nil,listSort(function GLESSEQP,cAlist),'names)
 
-bcUnixTable(u) ==
-  htSay '"\newline"
-  htBeginTable()
-  for x in u repeat
-    htSay '"{"
-    ft :=
-      isAsharpFileName? x => '("AS")
-      '("SPAD")
-    filename := NAMESTRING find_file(STRINGIMAGE x, ft)
-    htMakePage [['text, '"\unixcommand{",PATHNAME_-NAME x, '"}{$FRICAS/lib/SPADEDIT ", filename, '"} "]]
-    htSay '"}"
-  htEndTable()
-
 isAsharpFileName? con == false
 
 --=======================================================================

src/interp/br-data.boot

@@ -380,7 +380,7 @@ getDefaultPackageClients con ==  --called by mkUsersHashTable
   catname := INTERN SUBSTRING(s := PNAME con,0,MAXINDEX s)
   for [catAncestor,:.] in childrenOf([catname]) repeat
     pakname := INTERN STRCONC(PNAME catAncestor,'"&")
-    if getCDTEntry(pakname,true) then acc := [pakname,:acc]
+    if get_database(pakname, 'ABBREVIATION) then acc := [pakname,:acc]
     acc := union([CAAR x for x in domainsOf([catAncestor],nil)],acc)
   listSort(function GLESSEQP,acc)
 
@@ -712,7 +712,8 @@ $defaultPackageNamesHT := buildDefaultPackageNamesHT()
 --=======================================================================
 --            Code for Private Libdbs
 --=======================================================================
--- $createLocalLibDb := false
+$createLocalLibDb := false
+$newConstructorList := []
 
 extendLocalLibdb conlist ==   --  called by astran
   not $createLocalLibDb => nil

src/interp/br-saturn.boot

@@ -45,11 +45,6 @@ page() == $curPage
 htSay(x) ==
     bcHt(x)
 
-htSayCold x ==
-  htSay '"\lispLink{}{"
-  htSay x
-  htSay '"}"
-
 htSayStandard(x) ==  --do AT MOST for $standard
     bcHt(x)
 
@@ -145,7 +140,6 @@ htMakePage1 itemList ==
     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
@@ -877,7 +871,3 @@ screenLocalLine(line, conlist) ==
     dbName line
   MEMQ(con, conlist)
 
---------------> NEW DEFINITION (see br-data.boot)
-purgeLocalLibdb() ==   --called by the user through a clear command?
-  $newConstructorList := nil
-  deleteFile '"libdb.text"

src/interp/br-search.boot

@@ -84,24 +84,6 @@ 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, :[get_database(x, 'CONSTRUCTORFORM)
-    for x in allConstructors() | test]] where test ==
-         not $includeUnexposed? and not isExposedConstructor x => false
-         a := get_database(x, 'ABBREVIATION)
-         match?(pattern,PNAME a) and not HGET($defaultPackageNamesHT,x)
-
 applyGrep(x,filename) ==
   atom x => grepFile(x,filename,'i)
   $localLibdb =>
@@ -537,18 +519,6 @@ removeSurroundingStars filter ==
 showNamedDoc([kind,:lines],index) ==
   dbGather(kind,lines,index - 1,true)
 
-sayDocMessage message ==
-  htSay('"{\em ")
-  if message is [leftEnd,left,middle,right,rightEnd] then
-    htSayList([leftEnd, left, '"}"])
-    if left ~= '"" and left.(MAXINDEX left) = $blank then htBlank()
-    htSay middle
-    if right ~= '"" and right.0 = $blank then htBlank()
-    htSayList(['"{\em ", right, rightEnd])
-  else
-    htSay message
-  htSay ('"}")
-
 stripOffSegments(s,n) ==
   progress := true
   while n > 0 and progress = true repeat
@@ -759,7 +729,7 @@ detailedSearch(filter) ==
 --          doc)
                 )
     (text . "\vspace{1}\newline\centerline{ ")
-    (bcLinks ("\box{Search}" "" generalSearchDo NIL))
+    (bcLinks ("\fbox{Search}" "" generalSearchDo NIL))
     (text . "}"))
   htShowPage()
 

src/interp/br-util.boot

@@ -59,7 +59,6 @@ $docTable := nil             --cache for documentation table
 $conArgstrings := nil        --bound by conPage so that kPage
                              --will display arguments if given
 $conformsAreDomains  := false     --are all arguments of a constructor given?
-$returnNowhereFromGoGet := false  --special branch out for goget for browser
 $dbDataFunctionAlist := nil       --set by dbGatherData
 $domain   := nil             --bound in koOps
 $predvec  := nil             --bound in koOps
@@ -393,14 +392,6 @@ extractFileNameFromPath s == fn(s,0,#s) where
     k = m => SUBSTRING(s,i,nil)
     fn(s,k + 1,m)
 
-bcOpTable(u,fn) ==
-  htBeginTable()
-  for op in u for i in 0.. repeat
-    htSay '"{"
-    htMakePage [['bcLinks,[escapeSpecialChars STRINGIMAGE opOf op,'"",fn,i]]]
-    htSay '"}"
-  htEndTable()
-
 bcNameConTable u ==
   $bcMultipleNames: local := (#u ~= 1)
   bcConTable REMDUP u
@@ -465,16 +456,6 @@ splitConTable cons ==
     cond := [pair,:cond]
   [NREVERSE uncond,:NREVERSE cond]
 
-bcNameTable(u,fn,:option) ==   --option if * prefix
-  htSay '"\newline"
-  htBeginTable()
-  for x in u repeat
-    htSay '"{"
-    if IFCAR option then bcStar x
-    htMakePage [['bcLinks,[s := escapeSpecialChars STRINGIMAGE x,'"",fn,s]]]
-    htSay '"}"
-  htEndTable()
-
 bcNameCountTable(u, fn, gn) ==
   linkFunction := 'bcLispLinks
   htSay '"\newline"
@@ -485,11 +466,6 @@ bcNameCountTable(u, fn, gn) ==
     htSay '"}"
   htEndTable()
 
-dbSayItemsItalics(:u) ==
-  htSay '"{\em "
-  APPLY(function dbSayItems,u)
-  htSay '"}"
-
 dbSayItems(countOrPrefix,singular,plural,:options) ==
   bcHt '"\newline "
   count :=
@@ -556,12 +532,6 @@ errorPage(htPage,[heading,kind,:info]) ==
 htErrorStar() ==
   errorPage(nil,['"{\em *} not a valid search string",nil,'"\vspace{3}\centerline{{\em *} is not a valid search string for a general search}\centerline{\em {it would match everything!}}"])
 
-htQueryPage(htPage,heading,message,query,fn) ==
-  htInitPage(heading,nil)
-  htSay message
-  htQuery(query, fn, false)
-  htShowPage()
-
 htQuery(question, fn, upLink?) ==
   if question then
     htSay('"\vspace{1}\centerline{")
@@ -651,8 +621,6 @@ bcOptional s ==
   s = '"" => '"2"
   s
 
-bcvspace() == bcHt '"\vspace{1}\newline "
-
 bcString2WordList s == fn(s,0,MAXINDEX s) where
   fn(s,i,n) ==
     i > n => nil

src/interp/c-doc.boot

@@ -155,28 +155,6 @@ transDoc(conname,doclist) ==
       checkDocError1 ['"Not documented!!!!"]
     u := checkTrim($x,(STRINGP lines => [lines]; $x = 'constructor => first lines; lines))
     $argl : local := nil    --set by checkGetArgs
--- tpd: related domain information doesn't exist
---    if v := checkExtract('"Related Domains:",u) then
---      $lisplibRelatedDomains:=[w for x in gn(v) | w := fn(x)] where
---        gn(v) ==  --note: unabbrev checks for correct number of arguments
---          s := checkExtractItemList v
---          parse := ncParseFromString s  --is a single conform or a tuple
---          null parse => nil
---          parse is ['Tuple,:r] => r
---          [parse]
---        fn(x) ==
---          expectedNumOfArgs := checkNumOfArgs x
---          null expectedNumOfArgs =>
---            checkDocError ['"Unknown constructor name?: ",opOf x]
---            x
---          expectedNumOfArgs ~= (n := #(IFCDR x)) =>
---            n = 0 => checkDocError1
---              ['"You must give arguments to the _"Related Domain_": ",x]
---            checkDocError
---              ['"_"Related Domain_" has wrong number of arguments: ",x]
---            nil
---          n=0 and atom x => [x]
---          x
     longline :=
       $x = 'constructor =>
         v :=checkExtract('"Description:",u) or u and
@@ -478,8 +456,7 @@ checkComments(nameSig,lines) == main where
   main ==
     $checkErrorFlag: local := false
     margin := checkGetMargin lines
-    if (null BOUNDP '$attribute? or null $attribute?)
-      and nameSig ~= 'constructor then lines :=
+    if not($attribute?) and nameSig ~= 'constructor then lines :=
         [checkTransformFirsts(first nameSig,first lines,margin),:rest lines]
     u := checkIndentedLines(lines, margin)
     $argl := checkGetArgs first u      --set $argl