aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xconfigure18
-rw-r--r--configure.ac2
-rw-r--r--configure.ac.pamphlet2
-rw-r--r--src/ChangeLog43
-rw-r--r--src/boot/translator.boot9
-rw-r--r--src/interp/Makefile.in2
-rw-r--r--src/interp/Makefile.pamphlet2
-rw-r--r--src/interp/br-con.boot72
-rw-r--r--src/interp/br-data.boot11
-rw-r--r--src/interp/br-op1.boot135
-rw-r--r--src/interp/br-op2.boot144
-rw-r--r--src/interp/br-saturn.boot63
-rw-r--r--src/interp/br-search.boot10
-rw-r--r--src/interp/br-util.boot69
-rw-r--r--src/interp/cformat.boot19
-rw-r--r--src/interp/format.boot2
-rw-r--r--src/interp/ht-util.boot135
-rw-r--r--src/interp/hypertex.boot3
-rw-r--r--src/interp/i-syscmd.boot4
-rw-r--r--src/interp/i-util.boot3
-rw-r--r--src/interp/macros.lisp2
-rw-r--r--src/interp/nhyper.boot3
-rw-r--r--src/interp/pathname.boot2
-rw-r--r--src/lisp/core.lisp.in10
24 files changed, 98 insertions, 667 deletions
diff --git a/configure b/configure
index 685e5ae2..8e1e3e7c 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.60 for OpenAxiom 1.2.0-2008-04-23.
+# Generated by GNU Autoconf 2.60 for OpenAxiom 1.2.0-2008-04-24.
#
# Report bugs to <open-axiom-bugs@lists.sf.net>.
#
@@ -713,8 +713,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='OpenAxiom'
PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.2.0-2008-04-23'
-PACKAGE_STRING='OpenAxiom 1.2.0-2008-04-23'
+PACKAGE_VERSION='1.2.0-2008-04-24'
+PACKAGE_STRING='OpenAxiom 1.2.0-2008-04-24'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1402,7 +1402,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OpenAxiom 1.2.0-2008-04-23 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.2.0-2008-04-24 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1472,7 +1472,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.2.0-2008-04-23:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.2.0-2008-04-24:";;
esac
cat <<\_ACEOF
@@ -1576,7 +1576,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.2.0-2008-04-23
+OpenAxiom configure 1.2.0-2008-04-24
generated by GNU Autoconf 2.60
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1590,7 +1590,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OpenAxiom $as_me 1.2.0-2008-04-23, which was
+It was created by OpenAxiom $as_me 1.2.0-2008-04-24, which was
generated by GNU Autoconf 2.60. Invocation command line was
$ $0 $@
@@ -25810,7 +25810,7 @@ exec 6>&1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OpenAxiom $as_me 1.2.0-2008-04-23, which was
+This file was extended by OpenAxiom $as_me 1.2.0-2008-04-24, which was
generated by GNU Autoconf 2.60. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -25859,7 +25859,7 @@ Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
-OpenAxiom config.status 1.2.0-2008-04-23
+OpenAxiom config.status 1.2.0-2008-04-24
configured by $0, generated by GNU Autoconf 2.60,
with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
diff --git a/configure.ac b/configure.ac
index 1f54963a..948100c0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.2.0-2008-04-23],
+AC_INIT([OpenAxiom], [1.2.0-2008-04-24],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index 63b4c9bb..cd261735 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1101,7 +1101,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.2.0-2008-04-23],
+AC_INIT([OpenAxiom], [1.2.0-2008-04-24],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index 6c17ef7b..06ddc202 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,46 @@
+2008-04-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * lisp/core.lisp.in (|pathBasename|): New.
+ * interp/br-con.boot (kPageArgs): Remove.
+ (dbPresentCons): Likewise.
+ * interp/br-data.boot (purgeLocalLibdb): Likewise.
+ * interp/br-op1.boot (dbPresentOps): Likewise.
+ (dbConform): Likewise.
+ (dbGatherThenShow): Likewise.
+ (displayDomainOp): Likewise.
+ (htSayIndentRel): Likewise.
+ * interp/br-saturn.boot (htpAddInputAreaString): Likewise.
+ (htpSetLabelInputStringArea): Likewise.
+ (htTab): Likewise
+ * interp/br-search.boot (htShowPageStar): Likewise.
+ (htSay): Likewise.
+ (bcConform1): Likewise.
+ * interp/cformat.boot (pkey): Likewise.
+ * interp/ht-util.boot (htpAddToPageDescrption):
+ Likewise.
+ (bcHt): Likewise.
+ (htInitPage): Likewise.
+ (htAddHeading): Likewise.
+ (htShowPage): Likewise.
+ (htShowPageNoScroll): Likewise.
+ (htMakePage): Likewise.
+ (htMakePage1): Likewise.
+ (htMakeErrorPage): Likewise.
+ (htProcessBcStrings): Likewise.
+ (btBcLinks): Likewise.
+ (btBcLispLinks): Likewise.
+ (setUpDefault): Likewise.
+ (htMakeButton): Likewise.
+ (htDoneButton): Likewise.
+ * interp/hypertex.boot (endHTPage): Likewise.
+ * interp/i-syscmd.boot (makeInitialModemapFrame): Likewise.
+ * interp/macro.lisp (sayNewLine): Likewise.
+ * interp/nhyper.boot (endHTPage): Likewise.
+ * interp/pathname.boot (deleteFile): Likewise.
+ * interp/Makefile.pamphlet (YEARWEEK): Make TIMESTAMPT constant.
+ * boot/translator.boot (getIntermediateLispFile): New.
+ (compileBootHandler): Use it.
+
2008-04-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
* boot/ast.boot: Tidy.
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index a4c868f2..e4957c02 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -693,14 +693,19 @@ PSTOUT string==
defaultBootToLispFile file ==
- CONCAT(shoeRemovebootIfNec file,'".clisp")
+ strconc(pathBasename file, '".clisp")
+
+getIntermediateLispFile(file,options) ==
+ out := NAMESTRING getOutputPathname(options)
+ out ^= nil => strconc(shoeRemoveStringIfNec($faslType,out),'".clisp")
+ defaultBootToLispFile file
translateBootFile(progname, options, file) ==
outFile := getOutputPathname options or defaultBootToLispFile file
BOOTTOCL(file, ENOUGH_-NAMESTRING outFile)
compileBootHandler(progname, options, file) ==
- intFile := BOOTTOCL(file, defaultBootToLispFile file)
+ intFile := BOOTTOCL(file, getIntermediateLispFile(file,options))
intFile =>
objFile := compileLispHandler(progname, options, intFile)
DELETE_-FILE intFile
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 04a3f8e4..51785beb 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -132,7 +132,7 @@ ASAUTO= ${AUTO}/ax.$(FASLEXT)
autoload_objects += $(ASAUTO)
TIMESTAMP=$(axiom_targetdir)/timestamp
-YEARWEEK=(progn (setq boot::timestamp "${TIMESTAMP}") \
+YEARWEEK=(progn (defconstant boot::timestamp "${TIMESTAMP}") \
(setq boot::*build-version* "$(PACKAGE_STRING)") \
(boot::yearweek))
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 92247bd2..e58f3b1a 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -296,7 +296,7 @@ A new variable [[boot::*build-version*]] is set here and used by the
This information is set by hand in the top level Makefile.
<<environment>>=
TIMESTAMP=$(axiom_targetdir)/timestamp
-YEARWEEK=(progn (setq boot::timestamp "${TIMESTAMP}") \
+YEARWEEK=(progn (defconstant boot::timestamp "${TIMESTAMP}") \
(setq boot::*build-version* "$(PACKAGE_STRING)") \
(boot::yearweek))
diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index c61bc00e..1bc0482e 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -187,23 +187,6 @@ kdPageInfo(name,abbrev,nargs,conform,signature,file?) ==
if nargs ^= 0 then htSay '"."
htSaturnBreak()
-kPageArgs([op,:args],[.,.,:source]) ==
-------------------> OBSELETE
- firstTime := true
- coSig := rest getDualSignatureFromDB op
- for x in args for t in source for pred in coSig repeat
- if not firstTime then htSay '", and"
- htSay('"\newline ")
- typeForm := (t is [":",.,t1] => t1; t)
- if pred = true
- then htMakePage [['bcLinks,[x,'"",'kArgPage,x]]]
- else htSay('"{\em ",x,'"}")
- htSay( '"\tab{",STRINGIMAGE( # PNAME x),'"}, ")
- htSay
- pred => '"a domain of category "
- '"an element of the domain "
- bcConform(typeForm,true)
-
kArgPage(htPage,arg) ==
[op,:args] := conform := htpProperty(htPage,'conform)
domname := htpProperty(htPage,'domname)
@@ -946,55 +929,6 @@ dbAddChain conform ==
--=======================================================================
-- Constructor Page Menu
--=======================================================================
----------> !OBSELETE! <-------------
-dbPresentCons(htPage,kind,:exclusions) == -- calist is ((catform . pred)...)
- $saturn => dbPresentConsSaturn(htPage,kind,exclusions)
- htSay('"{\em Views:}")
- htpSetProperty(htPage,'exclusion,first exclusions)
- cAlist := htpProperty(htPage,'cAlist)
- empty? := null cAlist
- exposedUnexposedFlag := $includeUnexposed? --used to be star? 4/92
- star? := true --always include information on exposed/unexposed 4/92
- htSayStandard(if star? then '"\tab{13}" else '"\tab{9}")
- if empty? or member('names,exclusions)
- then htSay '"{\em names}"
- else htMakePage [['bcLispLinks,['"names",'"",'dbShowCons,'names]]]
- htSayStandard(if star? then '"\tab{21}" else '"\tab{17}")
- if empty? or member('kinds,exclusions) or kind ^= 'constructor
- then htSay '"{\em kinds}"
- else htMakePage [['bcLispLinks,['"kinds",'"",'dbShowCons,'kinds]]]
- htSayStandard(if star? then '"\tab{29}" else '"\tab{25}")
- if empty? or member('parameters,exclusions) or not "or"/[CDAR x for x in cAlist]
- then htSay '"{\em parameters}"
- else htMakePage [['bcLispLinks,['"parameters",'"",'dbShowCons,'parameters]]]
- if star? then htSayStandard('"\tab{42}") else htSayStandard('"\tab{38}")
- if empty? or null CDR cAlist
- then htSay '"{\em filter}"
- else htMakePage [['bcLinks,['"filter",'"",'dbShowCons,'filter]]]
- htMakePage [['bcStrings, [11,'"",'filter,'EM]]]
- htSay('"\newline")
- if exposedUnexposedFlag then
- if $exposedOnlyIfTrue then
- htMakePage [['bcLinks,['"exposed",'" {\em only}",'dbShowCons,'exposureOff]]]
- else
- htSay('"*{\em =}")
- htMakePage [['bcLinks,['"unexposed",'"",'dbShowCons,'exposureOn]]]
- htSayStandard(if star? then '"\tab{13}" else '"\tab{9}")
- if empty? or member('abbrs,exclusions)
- then htSay '"{\em abbrs}"
- else htMakePage [['bcLispLinks,['"abbrs",'"",'dbShowCons,'abbrs]]]
- htSayStandard(if star? then '"\tab{21}" else '"\tab{17}")
- if empty? or member('files,exclusions)
- then htSay '"{\em files}"
- else htMakePage [['bcLispLinks,['"files",'"",'dbShowCons,'files]]]
- htSayStandard(if star? then '"\tab{29}" else '"\tab{25}")
- if empty? or member('conditions,exclusions) or "and"/[CDR x = true for x in cAlist]
- then htSay '"{\em conditions}"
- else htMakePage [['bcLispLinks,['"conditions",'"",'dbShowCons,'conditions]]]
- if star? then htSayStandard('"\tab{42}") else htSayStandard('"\tab{38}")
- if empty? or member('documentation,exclusions)
- then htSay '"{\em descriptions}"
- else htMakePage [['bcLispLinks,['"descriptions",'"",'dbShowCons,'documentation]]]
dbShowCons(htPage,key,:options) ==
cAlist := htpProperty(htPage,'cAlist)
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 57812809..77d9d1c1 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -58,7 +58,7 @@ buildLibdb(:options) == --called by buildDatabase (database.boot)
$CatLst : local := nil
$PakLst : local := nil
$DefLst : local := nil
- deleteFile '"temp.text"
+ removeFile '"temp.text"
$outStream: local := MAKE_-OUTSTREAM '"temp.text"
if null domainList then
comments :=
@@ -95,7 +95,7 @@ buildLibdb(:options) == --called by buildDatabase (database.boot)
$machineType = 'SPARC => '"sort -f _"temp.text_" > _"libdb.text_""
'"sort _"temp.text_" > _"libdb.text_""
renameFile('"libdb.text", '"olibdb.text")
- deleteFile '"temp.text"
+ removeFile '"temp.text"
buildLibdbConEntry conname ==
null getConstructorModemapFromDB conname => nil
@@ -778,10 +778,5 @@ extendLocalLibdb conlist == -- called by astran
oldlines := purgeNewConstructorLines(dbReadLines localLibdb, conlist)
newlines := dbReadLines '"temp.text"
dbWriteLines(MSORT union(oldlines,newlines), '"libdb.text")
- deleteFile '"temp.text"
-
-purgeLocalLibdb() == --used for debugging purposes only
- $newConstructorList := nil
- removeFile '"libdb.text"
-
+ removeFile '"temp.text"
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index e359dd93..05be1d7f 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -45,99 +45,6 @@ import bc_-util
dbFromConstructor?(htPage) == htpProperty(htPage,'conform)
-dbPresentOps(htPage,which,:exclusions) ==
- true => dbPresentOpsSaturn(htPage,which,exclusions)
---Flags:
--- fromConPage?: came (originally) from a constructor page
--- usage?: display usage?
--- star?: display exposed/*=unexposed
--- implementation?: display implementation?
- htSay('"{\em Views:}")
- asharp? := htpProperty(htPage,'isAsharpConstructor)
- fromConPage? := (conname := opOf htpProperty(htPage,'conform))
- usage? := $UserLevel = 'development and fromConPage? and which = '"operation"
- and getConstructorKindFromDB conname ^= "category"
- and not asharp?
- star? := not fromConPage? or which = '"package operation"
- implementation? := not asharp? and
- $UserLevel = 'development and $conformsAreDomains --and not $includeUnexposed?
- rightmost? := star? or (implementation? and not $includeUnexposed?)
- tabs :=
- which = '"attribute" => '("12" "12" "25" "40" 13)
- star? => '("12" "19" "31" "43" 10)
- implementation? => '("9" "16" "28" "44" 9)
- '("9" "16" "28" "41" 12)
- if INTEGERP first exclusions then exclusions := ['documentation]
- htpSetProperty(htPage,'exclusion,first exclusions)
- opAlist :=
- which = '"operation" => htpProperty(htPage,'opAlist)
- htpProperty(htPage,'attrAlist)
- empty? := null opAlist
- htTab
- which = '"attribute" => tabs.1
- tabs.0
- if empty? or member('names,exclusions) or null KDR opAlist
- then htSay '"{\em names}"
- else htMakePage [['bcLispLinks,['"names",'"",'dbShowOps,which,'names]]]
- if which ^= '"attribute" then
- htTab tabs.1
- if empty? or member('signatures,exclusions)
- then htSay '"{\em signatures}"
- else htMakePage [['bcLispLinks,['"signatures",'"",'dbShowOps,which,'signatures]]]
- htTab tabs.2
- if empty? or member('parameters,exclusions) --also test for some parameter
- or not dbDoesOneOpHaveParameters? opAlist
- then htSay '"{\em parameters}"
- else htMakePage [['bcLispLinks,['"parameters",'"",'dbShowOps,which,'parameters]]]
- htTab tabs.3
- if not empty? and null IFCDR opAlist and not htpProperty(htPage,'noUsage)
- then
- if htpProperty(htPage,'conform)
- then htMakePage
- [['bcLinks,['"generalise",'"",'dbShowOps,which,'generalise]]]
- else htMakePage
- [['bcLinks,['"all domains",'"",'dbShowOps,which,'allDomains]]]
- else
- if empty? or MEMQ('usage,exclusions) or htpProperty(htPage,'noUsage) then htSay '"{\em filter}" else
- htMakePage [['bcLinks,['"filter",'"",'dbShowOps,which,'filter]]]
- htMakePage [['bcStrings, [tabs.4,'"",'filter,'EM]]]
- htSay('"\newline ")
- if star?
- then
- if $exposedOnlyIfTrue
- then htMakePage
- [['bcLinks,['"exposed",'" {\em only}",'dbShowOps,which,'exposureOff]]]
- else
- htSay('"*{\em =}")
- htMakePage [['bcLinks,['"unexposed",'"",'dbShowOps,which,'exposureOn]]]
--- else if (updown := dbCompositeWithMap htPage)
--- then htMakePage [['bcLispLinks,[updown,'"",'dbShowUpDown,updown]]]
- htTab tabs.0
- if usage? then
- if empty? or member('usage,exclusions) or getConstructorKindFromDB conname = "category" or HGET($defaultPackageNamesHT,conname) or htpProperty(htPage,'noUsage)
- then htSay '"{\em usage}"
- else htMakePage [['bcLispLinks,['"usage",'"",'whoUsesOperation,which,nil]]]
- htTab tabs.1
- if empty? or member('origins,exclusions)
- then htSay '"{\em origins}"
- else htMakePage [['bcLispLinks,['"origins",'"",'dbShowOps,which,'origins]]]
- htTab tabs.2
- if implementation? then
- if member('implementation,exclusions) or which = '"attribute" or
- ((conname := opOf htpProperty(htPage,'conform)) and getConstructorKindFromDB conname = "category")
- then htSay '"{\em implementation}"
- else htMakePage [['bcLispLinks,['"implementation",'"",'dbShowOps,which,'implementation]]]
- else if empty? or member('conditions,exclusions) or (htpProperty(htPage,'condition?) = 'no)
- then htSay '"{\em conditions}"
- else htMakePage [['bcLispLinks,['"conditions",'"",'dbShowOps,which,'conditions]]]
- htTab tabs.3
- if empty? or member('documentation,exclusions)
- then htSay '"{\em description}"
- else htMakePage [['bcLispLinks,['"description",'"",'dbShowOps,which,'documentation]]]
- htShowPageNoScroll()
-
-htTab s == htSay('"\tab{",s,'"}")
-
dbDoesOneOpHaveParameters? opAlist ==
or/[(or/[fn for x in items]) for [op,:items] in opAlist] where fn() ==
STRINGP x => dbPart(x,2,1) ^= '"0"
@@ -380,17 +287,6 @@ dbOpsForm form ==
--2nd arg: like (|Matrix| (|Integer|)) and (|U..P..| (QUOTE |x|) (|Integer|))
["\ops{",:conform2StringList(form,FUNCTION conname2StringList,FUNCTION conformString,nil),'"}{",:$pn,:form2Fence form,'"}"]
-dbConform form ==
---------------------> OBSELETE <--------------------------
---one button for the main constructor page of a type
---NOTE: Next line should be as follows---but form2Fence form will
--- put, e.g. '((2 1 . 0) (0 1 . 0)) instead of x**2 + 1
- $saturn => ["\conf{",:form2StringList opOf form,
- '"}{\lispLink{\verb!{(|conForm| '",:form2Fence dbOuttran form,'")!}}}"]
- ["\conf{",:form2StringList opOf form,'"}{",:form2Fence dbOuttran form,'"}"]
---["\conf{",:form2StringList opOf form,'"}{",:form2Fence opOf form,'"}"]
-
-
dbConformGen form == dbConformGen1(form,true)
--many buttons: one for the type and one for each inner type
--NOTE: must only be called on types KNOWN to be correct
@@ -665,37 +561,6 @@ dbShowOpImplementations(htPage,opAlist,which,data) ==
dbShowOpConditions(htPage,opAlist,which,data) ==
dbGatherThenShow(htPage,opAlist,which,data,nil,nil,function bcPred)
-dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) ==
------------------> OBSELETE
- single? := null rest data
- htSay('"\beginmenu ")
- bincount := 0
- for [thing,exposeFlag,:items] in data repeat
- htSay('"\item ")
- if single? then htSay(menuButton())
- else htMakePage [['bcLinks,[menuButton(),'"",'dbShowOps,which,bincount]]]
- htSay '"{\em "
- htSay
- thing = 'nowhere => '"implemented nowhere"
- thing = 'constant => '"constant"
- thing = '_$ => '"by the domain"
- INTEGERP thing => '"unexported"
- constructorIfTrue =>
- htSay word
- atom thing => '" an unknown constructor"
- '""
- atom thing => '"unconditional"
- '""
- htSay '"}"
- if null atom thing then
- if constructorIfTrue then htSay('" {\em ",dbShowKind thing,'"}")
- htSay '" "
- FUNCALL(fn,thing)
- htSay('":\newline ")
- dbShowOpSigList(which,items,(1 + bincount) * 8192)
- bincount := bincount + 1
- htSay '"\endmenu "
-
dbShowKind conform ==
conname := CAR conform
kind := getConstructorKindFromDB conname
diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot
index dbac1262..bff5beac 100644
--- a/src/interp/br-op2.boot
+++ b/src/interp/br-op2.boot
@@ -41,150 +41,6 @@ import br_-op1
-- Operation Description
--=======================================================================
-displayDomainOp(htPage,which,origin,op,sig,predicate,
- doc,index,chooseFn,unexposed?,$generalSearch?) ==
------------------------> OBSELETE
- $saturn =>
- displayDomainOp1(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)
- htSay('"\newline")
- if exactlyOneOpSig then htSay('"\menuitemstyle{}")
- else htMakePage [['bcLinks,['"\menuitemstyle{}",'"",chooseFn,which,index]]]
- htSay('"\tab{2}")
- op := IFCAR opform
- args := IFCDR opform
- ops := escapeSpecialChars STRINGIMAGE op
- n := #sig
- do
- n = 2 and LASSOC('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}")
- n = 3 and LASSOC('Led,PROPLIST op) => htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}")
- if unexposed? and $includeUnexposed? then
- htSayUnexposed()
- htSaySaturn '"\unexposed{{\em "
- htSaySaturn ops
- htSaySaturn '"}"
- htSayStandard(ops)
- predicate='ASCONST or niladicConstructorFromDB op or member(op,'(0 1)) => 'skip
- which = '"attribute" and null args => 'skip
- htSay('"(")
- if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}")
- for x in IFCDR args repeat
- htSay('",{\em ",quickForm2HtString x,'"}")
- htSay('")")
- 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 :=
- MEMQ(conname,$Primitives) => nil
- CDAR getConstructorModemapFromDB conname
- --RDJ: this next line is necessary until compiler bug is fixed
- --that forgets to substitute #variables for t#variables;
- --check the signature for SegmentExpansionCategory, e.g.
- tvarlist := TAKE(# $conargs,$TriangleVariableList)
- $signature := SUBLISLIS($FormalMapVariableList,tvarlist,$signature)
- $sig :=
- which = '"attribute" or which = '"constructor" => sig
- $conkind ^= '"package" => sig
- symbolsUsed := [x for x in rest conform | IDENTP x]
- $DomainList := SETDIFFERENCE($DomainList,symbolsUsed)
- getSubstSigIfPossible sig
- if member(which,'("operation" "constructor")) then
- $displayReturnValue: local := nil
- if args then
- htSay('"\newline")
- htSayStandard '"\tab{2}"
- htSay '"{\em Arguments:}"
- for a in args for t in rest $sig repeat
- htSayIndentRel(15,true)
- htSay('"{\em ",form2HtString(a),'"}, ")
- htSayValue t
- htSayIndentRel(-15,true)
- htSay('"\newline ")
- if first $sig then
- $displayReturnValue := true
- htSay('"\newline\tab{2}{\em Returns:}")
- htSayIndentRel(15)
- htSayValue first $sig
- htSayIndentRel(-15)
- htSay('"\newline ")
- if origin and ($generalSearch? or origin ^= conform) and opOf(origin)^=op then
- htSay('"\newline\tab{2}{\em Origin:}")
- htSayIndentRel(15)
- if not isExposedConstructor opOf origin and $includeUnexposed? then htSayUnexposed()
- bcConform(origin,true)
- htSayIndentRel(-15)
- if not MEMQ(predicate,'(T ASCONST)) then
- pred := sublisFormal(KDR conform,predicate)
- count := #pred
- htSay('"\newline\tab{2}{\em Conditions:}")
- for p in displayBreakIntoAnds SUBST($conform,"$",pred) repeat
- htSayIndentRel(15,count > 1)
- bcPred(p,$conform,true)
- htSayIndentRel(-15,count > 1)
- htSay('"\newline ")
- if $whereList then
- count := #$whereList
- htSay('"\newline\tab{2}{\em Where:}")
- if ASSOC("$",$whereList) then
- htSayIndentRel(15,true)
- htSayStandard '"{\em \$} is "
- htSaySaturn '"{\em \%} is "
- htSay
- $conkind = '"category" => '"of category "
- '"the domain "
- bcConform(conform,true,true)
- htSayIndentRel(-15,true)
- for [d,key,:t] in $whereList | d ^= "$" repeat
- htSayIndentRel(15,count > 1)
- htSay("{\em ",d,"} is ")
- htSayConstructor(key,sublisFormal(KDR conform,t))
- htSayIndentRel(-15,count > 1)
- if doc and (doc ^= '"" and (doc isnt [d] or d ^= '"")) then
- htSay('"\newline\tab{2}{\em Description:}")
- htSayIndentRel(15)
- if doc = $charFauxNewline then htSay $charNewline
- else
- ndoc:=
- -- we are confused whether doc is a string or a list of strings
- CONSP doc => [SUBSTITUTE($charNewline, $charFauxNewline, i) for i in doc]
- SUBSTITUTE($charNewline, $charFauxNewline,doc)
- htSay ndoc
- htSayIndentRel(-15)
- if exactlyOneOpSig and (infoAlist := htpProperty(htPage,'infoAlist)) then
- displayInfoOp(htPage,infoAlist,op,sig)
-
-
-htSayIndentRel(n,:options) ==
------------------> OBSELETE
- flag := IFCAR options
- m := ABSVAL n
- if flag then m := m + 2
- htSay
- n > 0 =>
- flag => ['"\indent{",STRINGIMAGE m,'"}\tab{-2}"]
- ['"\indent{",STRINGIMAGE m,'"}\tab{0}"]
- n < 0 => ['"\indent{0}\newline "]
htSayConstructor(key,u) ==
u is ['CATEGORY,kind,:r] =>
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index 9dc8e5e3..b4960abb 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -125,7 +125,6 @@ page() ==
-- Functions that affect $saturnPage
--=======================================================================
---------------------> OLD DEFINITION (override in br-util.boot.pamphlet)
htSay(x,:options) == --say for possibly both $saturn and standard code
htSayBind(x, options)
@@ -149,7 +148,6 @@ htSayBind(x, options) ==
bcHt x
for y in options repeat bcHt y
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
bcHt line ==
$newPage => --this path affects both saturn and old lines
text :=
@@ -166,13 +164,11 @@ bcHt line ==
-- New issueHT
--=======================================================================
---------------------> NEW DEFINITION (see ht-util.boot.pamphlet)
htShowPage() ==
-- show the page which has been computed
htSayStandard '"\endscroll"
htShowPageNoScroll()
-------------------> NEW DEFINITION (see ht-util.boot.pamphlet)
htShowPageNoScroll() ==
-- show the page which has been computed
htSayStandard '"\autobuttons"
@@ -185,13 +181,13 @@ htShowPageNoScroll() ==
if $standard then
$htLineList := nil
htMakePage htpPageDescription $curPage
- if $htLineList then line := APPLY(function CONCAT, nreverse $htLineList)
+ if $htLineList then line := apply(function CONCAT, nreverse $htLineList)
issueHTStandard line
----------------------
if $saturn then
$htLineList := nil
htMakePage htpPageDescription $saturnPage
- if $htLineList then line := APPLY(function CONCAT, nreverse $htLineList)
+ if $htLineList then line := apply(function CONCAT, nreverse $htLineList)
issueHTSaturn line
----------------------
endHTPage()
@@ -228,14 +224,13 @@ issueHTStandard line == --called by htMakePageNoScroll and htMakeErrorPage
sockSendInt($MenuServer, $SendLine)
sockSendString($MenuServer, line)
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
htMakeErrorPage htPage ==
$newPage := false
$htLineList := nil
if $standard then $curPage := htPage
if $saturn then $saturnPage := htPage
htMakePage htpPageDescription htPage
- line := APPLY(function CONCAT, nreverse $htLineList)
+ line := apply(function CONCAT, nreverse $htLineList)
issueHT line
endHTPage()
@@ -377,21 +372,19 @@ htMakePageSaturn itemList ==
$standard => nil
htMakePage itemList
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
htMakePage itemList ==
if $newPage then
if $saturn then htpAddToPageDescription($saturnPage, saturnTran itemList)
if $standard then htpAddToPageDescription($curPage, itemList)
htMakePage1 itemList
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
htMakePage1 itemList ==
-- make a page given the description in itemList
for u in itemList repeat
itemType := 'text
items :=
STRINGP u => u
- ATOM u => STRINGIMAGE u
+ atom u => STRINGIMAGE u
STRINGP first u => u
u is ['text, :s] => s
itemType := first u
@@ -472,7 +465,7 @@ getCallBack callTail ==
--=======================================================================
-- Redefinitions from hypertex.boot
--=======================================================================
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
+
endHTPage() ==
$standard => sockSendInt($MenuServer, $EndOfPage)
nil
@@ -484,31 +477,16 @@ htSayHrule() == bcHt
$saturn => '"\hrule{}\newline{}"
'"\horizontalline{}\newline{}"
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
-htpAddInputAreaProp(htPage, label, prop) ==
-------------> Add STRINGIMAGE
- SETELT(htPage, 5, [[label, nil, nil, nil, :prop], :ELT(htPage, 5)])
-
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
-htpSetLabelInputString(htPage, label, val) ==
-------------> Add STRINGIMAGE
--- value user typed as input string on page
- props := LASSOC(label, htpInputAreaAlist htPage)
- props => SETELT(props, 0, STRINGIMAGE val)
- nil
-
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
htDoneButton(func, htPage, :optionalArgs) ==
------> Handle argument values passed from page if present
- if optionalArgs then
+ if optionalArgs ^= nil then
htpSetInputAreaAlist(htPage,CAR optionalArgs)
typeCheckInputAreas htPage =>
htMakeErrorPage htPage
- NULL FBOUNDP func =>
+ not FBOUNDP func =>
systemError ['"unknown function", func]
FUNCALL(SYMBOL_-FUNCTION func, htPage)
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
htBcLinks(links,:options) ==
skipStateInfo? := IFCAR options
[links,options] := beforeAfter('options,links)
@@ -520,7 +498,6 @@ htBcLinks(links,:options) ==
mkCurryFun(func, value),skipStateInfo?)
bcIssueHt info
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
htBcLispLinks links ==
[links,options] := beforeAfter('options,links)
for [message, info, func, :value] in links repeat
@@ -576,7 +553,6 @@ htpAddToPageDescription(htPage, pageDescrip) ==
SETELT(htPage, 7, newDescript)
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
htProcessBcStrings strings ==
for [numChars, default, stringName, spadType, :filter] in strings repeat
mess2 := '""
@@ -589,11 +565,9 @@ htProcessBcStrings strings ==
iht ['"\inputstring{", stringName, '"}{",
numChars, '"}{", htpLabelDefault(page(),stringName), '"} ", mess2]
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
setUpDefault(name, props) ==
htpAddInputAreaProp(page(), name, props)
---------------------> NEW DEFINITION (override in ht-util.boot.pamphlet)
htInitPage(title, propList) ==
-- start defining a hyperTeX page
htInitPageNoScroll(propList, title)
@@ -784,7 +758,6 @@ getSaturnExampleList() ==
SHUT fp
lst
---------------------> NEW DEFINITION (see br-con.boot.pamphlet)
dbPresentCons(htPage,kind,:exclusions) ==
$saturn => dbPresentConsSaturn(htPage,kind,exclusions)
htpSetProperty(htPage,'exclusion,first exclusions)
@@ -975,7 +948,6 @@ addParameterTemplates(page, conform) ==
htSaySaturn '"}}"
htEndTabular()
---------------------> NEW DEFINITION (see br-con.boot.pamphlet)
kPageArgs([op,:args],[.,.,:source]) ==
htSaySaturn '"\begin{tabular}{p{.25in}lp{0in}}"
firstTime := true
@@ -1002,17 +974,17 @@ kPageArgs([op,:args],[.,.,:source]) ==
--=======================================================================
-- Redefinitions from br-op1.boot
--=======================================================================
---------------------> NEW DEFINITION (see br-op1.boot.pamphlet)
+
dbConform form ==
--one button for the main constructor page of a type
$saturn => ["\lispLink[d]{\verb!(|conPage| '",:form2Fence dbOuttran form,'")!}{",
:form2StringList opOf form,"}"]
["\conf{",:form2StringList opOf form,'"}{",:form2Fence dbOuttran form,'"}"]
---------------------> NEW DEFINITION (see br-op1.boot.pamphlet)
-htTab s == if $standard then htSayStandard ('"\tab{",s,'"}")
+htTab s ==
+ $standard => htSayStandard ('"\tab{",s,'"}")
+ nil
---------------------> NEW DEFINITION (see br-op1.boot.pamphlet)
dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) ==
single? := null rest data
htBeginMenu 'description
@@ -1049,7 +1021,6 @@ dbGatherThenShow(htPage,opAlist,which,data,constructorIfTrue,word,fn) ==
bincount := bincount + 1
htEndMenu 'description
---------------------> NEW DEFINITION (see br-op1.boot.pamphlet)
dbPresentOps(htPage,which,:exclusions) ==
$saturn => dbPresentOpsSaturn(htPage,which,exclusions)
asharp? := htpProperty(htPage,'isAsharpConstructor)
@@ -1181,7 +1152,7 @@ dbPresentOpsSaturn(htPage,which,exclusions) ==
--=======================================================================
-- Redefinitions from br-search.boot
--=======================================================================
----------------------> OLD DEFINITION (override in br-search.boot.pamphlet)
+
htShowPageStar() ==
$saturn => htShowPageStarSaturn()
htSayStandard '"\endscroll "
@@ -1419,7 +1390,6 @@ htSaySourceFile conname ==
htMakePage [['text,'"\unixcommand{",filename,'"}{_\$AXIOM/lib/SPADEDIT ",
sourceFileName, '" ", conname, '"}"]]
---------------------> NEW DEFINITION (see br-op2.boot.pamphlet)
htSayIndentRel(n,:options) ==
flag := IFCAR options
m := ABSVAL n
@@ -1479,7 +1449,6 @@ htSayConstructorName(nameShown, name) ==
if $standard then
htSayStandard ["\lispdownlink{",nameShown,'"}{(|conPage| '|",name,'"|)}"]
---------------------> NEW DEFINITION (see ht-util.boot.pamphlet)
htAddHeading(title) ==
htNewPage title
page()
@@ -1638,7 +1607,6 @@ dbSort(x,y) ==
removeFile STRCONC(sin, '".text")
--- override in br-util.boot.pamphlet
bcConform1 form == main where
main() ==
form is ['ifp,form1,:pred] =>
@@ -1716,7 +1684,7 @@ bcConform1 form == main where
-- oldlines := purgeNewConstructorLines(dbReadLines localLibdb, conlist)
-- newlines := dbReadLines '"temp.text"
-- dbWriteLines(MSORT union(oldlines,newlines), '"libdb.text")
--- deleteFile '"temp.text"
+-- removeFile '"temp.text"
purgeNewConstructorLines(lines, conlist) ==
[x for x in lines | not screenLocalLine(x, conlist)]
@@ -1739,10 +1707,9 @@ screenLocalLine(line, conlist) ==
dbName line
MEMQ(con, conlist)
---------------> NEW DEFINITION (see br-data.boot.pamphlet)
purgeLocalLibdb() == --called by the user through a clear command?
$newConstructorList := nil
- deleteFile '"libdb.text"
+ removeFile '"libdb.text"
--moveFile(before,after) ==
-- $saturn => MOVE_-FILE(before, after)
@@ -1750,7 +1717,7 @@ purgeLocalLibdb() == --called by the user through a clear command?
-- --obey STRCONC('"mv ", before, '" ", after)
-- deleted JHD/MCD, since already one in pathname.boot
---deleteFile fn ==
+--removeFile fn ==
-- $saturn => DELETE_-FILE fn
-- obey STRCONC('"rm ",fn)
diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot
index 782be275..70f38187 100644
--- a/src/interp/br-search.boot
+++ b/src/interp/br-search.boot
@@ -444,16 +444,6 @@ searchDropUnexposedLines alist ==
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)
diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot
index b5515501..14b28659 100644
--- a/src/interp/br-util.boot
+++ b/src/interp/br-util.boot
@@ -280,12 +280,6 @@ getConstructorForm name ==
getConstructorArgs conname == CDR getConstructorForm conname
-htSay(x,:options) ==
---if x = $charEscape then x := $charNewline else
---if x = $stringEscape then x := $stringNewline
- bcHt x
- for y in options repeat bcHt y
-
bcComments(comments,:options) ==
italics? := not IFCAR options
STRINGP comments =>
@@ -306,69 +300,6 @@ bcConform(form,:options) ==
$italicHead? : local := IFCAR IFCDR options
bcConform1 form
-bcConform1 form == main where
------------------> OBSELETE
- main() ==
- form is ['ifp,form1,:pred] =>
- hd form1
- bcPred pred
- hd form
- hd form ==
- atom form =>
- not MEMQ(form,'(Mapping Union Record)) and null constructor? form =>
- s := STRINGIMAGE form
- (s.0 = char '_#) and (n := POSN1(form, $FormalFunctionParameterList)) =>
- htSay form2HtString ($FormalMapVariableList . n)
- htSay form
- s := STRINGIMAGE form
- $italicHead? => htSayItalics s
- $bcMultipleNames =>
- satTypeDownLink(s, ['"(|conPageChoose| '|",s,'"|)"])
- satTypeDownLink(s, ["(|conPage| '|",s,'"|)"])
- (head := QCAR form) = 'QUOTE =>
- htSay('"'")
- hd CADR form
- head = 'SIGNATURE =>
- htSay(CADR form,'": ")
- mapping CADDR form
- head = 'Mapping and rest form => rest form => mapping rest form
- head = ":" =>
- hd CADR form
- htSay '": "
- hd CADDR form
- QCDR form and dbEvalableConstructor? form
- => bcConstructor(form,head)
- hd head
- null (r := QCDR form) => nil
- tl QCDR form
- mapping [target,:source] ==
- tuple source
- bcHt
- $saturn => '" {\ttrarrow} "
- '" -> "
- hd target
- tuple u ==
- null u => bcHt '"()"
- null rest u => hd u
- bcHt '"("
- hd first u
- for x in rest u repeat
- bcHt '","
- hd x
- bcHt '")"
- tl u ==
- bcHt '"("
- firstTime := true
- for x in u repeat
- if not firstTime then bcHt '","
- firstTime := false
- hd x
- bcHt '")"
- say x ==
- if $italics? then bcHt '"{\em "
- if x = 'etc then x := '"..."
- bcHt escapeSpecialIds STRINGIMAGE x
- if $italics? then bcHt '"}"
bcConstructor(form is [op,:arglist],cname) == --called only when $conformsAreDomains
htSayList dbConformGen form
diff --git a/src/interp/cformat.boot b/src/interp/cformat.boot
index 4f48e679..5155a277 100644
--- a/src/interp/cformat.boot
+++ b/src/interp/cformat.boot
@@ -70,22 +70,3 @@ ppos p ==
--keySeq ::= keynumber optargList optdbn
--optARgL ::= [ 0 or more arguments ] | nothing at all
--optDbn ::= ['dbN , databaseName ] | nothing at all
------------ (override in format.boot.pamphlet)
-pkey keyStuff ==
- if not PAIRP keyStuff then keyStuff := [keyStuff]
- allMsgs := []
- while not null keyStuff repeat
- dbN := NIL
- argL := NIL
- key := first keyStuff
- keyStuff := IFCDR keyStuff
- next := IFCAR keyStuff
- while PAIRP next repeat
- if CAR next = 'dbN then dbN := CADR next
- else argL := next
- keyStuff := IFCDR keyStuff
- next := IFCAR keyStuff
- oneMsg := returnStLFromKey(key,argL,dbN)
- allMsgs := NCONC (oneMsg,allMsgs)
- allMsgs
-
diff --git a/src/interp/format.boot b/src/interp/format.boot
index fdbd9934..5256c87b 100644
--- a/src/interp/format.boot
+++ b/src/interp/format.boot
@@ -730,7 +730,7 @@ object2Identifier x ==
INTERN WRITE_-TO_-STRING x
blankList x == "append"/[[BLANK,y] for y in x]
---------------------> NEW DEFINITION (see cformat.boot.pamphlet)
+
pkey keyStuff ==
if not PAIRP keyStuff then keyStuff := [keyStuff]
allMsgs := ['" "]
diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot
index 7a6a44b1..ded0a051 100644
--- a/src/interp/ht-util.boot
+++ b/src/interp/ht-util.boot
@@ -139,7 +139,6 @@ replacePercentByDollar s == fn(s,0,MAXINDEX s) where
STRCONC(SUBSTRING(s,i,m - i),'"$",fn(s,m + 1,n))
htpSetLabelInputString(htPage, label, val) ==
-------------------> OBSELETE
-- value user typed as input string on page
props := LASSOC(label, htpInputAreaAlist htPage)
props => SETELT(props, 0, STRINGIMAGE val)
@@ -206,10 +205,6 @@ htpPageDescription htPage ==
htpSetPageDescription(htPage, pageDescription) ==
SETELT(htPage, 7, pageDescription)
-htpAddToPageDescription(htPage, pageDescrip) ==
--------------> OBSELETE <-----------
- SETELT(htPage, 7, nconc(nreverse COPY_-LIST pageDescrip, ELT(htPage, 7)))
-
iht line ==
-- issue a single hyperteTeX line, or a group of lines
$newPage => nil
@@ -217,13 +212,6 @@ iht line ==
$htLineList := NCONC(nreverse mapStringize COPY_-LIST line, $htLineList)
$htLineList := [basicStringize line, :$htLineList]
-bcHt line ==
---line = '"\##1" => harharhar()
- iht line
- PAIRP line =>
- if $newPage then htpAddToPageDescription($curPage, [['text, :line]])
- if $newPage then htpAddToPageDescription($curPage, [['text, line]])
-
bcIssueHt line ==
PAIRP line => htMakePage1 line
iht line
@@ -246,14 +234,6 @@ stringize s ==
STRINGP s => s
PRINC_-TO_-STRING s
-htInitPage(title, propList) ==
-----------------------------> OBSELETE---cannot return $curPage
--- start defining a hyperTeX page
- htInitPageNoScroll(propList, title)
- htSayStandard '"\beginscroll "
- $curPage
-
-
--htInitPageNoHeading(propList) ==
-----------------------> replaced by htInitPageNoScroll
-- start defining a hyperTeX page
@@ -263,64 +243,6 @@ htInitPage(title, propList) ==
-- $htLineList := nil
-- $curPage
-htAddHeading(title) ==
-------------------------> OBSELETE
- htNewPage title
- $curPage
-
-htShowPage() ==
--- show the page which has been computed
- htSayStandard '"\endscroll"
- htShowPageNoScroll()
-
-htShowPageNoScroll() ==
-------------------------> OBSELETE
--- show the page which has been computed
- htSayStandard '"\autobuttons"
- htpSetPageDescription($curPage, nreverse htpPageDescription $curPage)
- $newPage := false
- $htLineList := nil
- htMakePage htpPageDescription $curPage
- line := APPLY(function CONCAT, nreverse $htLineList)
- issueHT line
- endHTPage()
-
-htMakePage itemList ==
-------------------------> OBSELETE
--- make a page given the description in itemList
- if $newPage then htpAddToPageDescription($curPage, itemList)
- htMakePage1 itemList
-
-htMakePage1 itemList ==
--- make a page given the description in itemList
- for [itemType, :items] in itemList repeat
- itemType = 'text => 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 ['"unknown itemType", itemType]
-
-htMakeErrorPage htPage ==
-------------------> OBSELETE
- $newPage := false
- $htLineList := nil
- $curPage := htPage
- htMakePage htpPageDescription htPage
- line := APPLY(function CONCAT, nreverse $htLineList)
- issueHT line
- endHTPage()
-
htQuote s ==
-- wrap quotes around a piece of hyperTeX
iht '"_""
@@ -349,19 +271,6 @@ htProcessBcButtons buttons ==
iht ['"\inputbox[", htpLabelDefault($curPage, buttonName), '"]{",
buttonName, '"}{\htbmfile{pick}}{\htbmfile{unpick}}"]
-htProcessBcStrings strings ==
----------------------> OBSELETE <------------------------
- for [numChars, default, stringName, spadType, :filter] in strings repeat
- mess2 := '""
- if NULL LASSOC(stringName, htpInputAreaAlist $curPage) then
- setUpDefault(stringName, ['string, default, spadType, filter])
- if htpLabelErrorMsg($curPage, stringName) then
- iht ['"\centerline{{\em ", htpLabelErrorMsg($curPage, stringName), '"}}"]
- mess2 := CONCAT(mess2, bcSadFaces())
- htpSetLabelErrorMsg($curPage, stringName, nil)
- iht ['"\inputstring{", stringName, '"}{",
- numChars, '"}{", htpLabelDefault($curPage,stringName), '"} ", mess2]
-
bcSadFaces() ==
'"\space{1}{\em\htbitmap{error}\htbitmap{error}\htbitmap{error}}"
@@ -381,22 +290,6 @@ htLispLinks(links,:option) ==
htLispMemoLinks(links) == htLispLinks(links,true)
-htBcLinks(links,:options) ==
--------------------------> OBSELETE
- skipStateInfo? := IFCAR options
- [links,options] := beforeAfter('options,links)
- for [message, info, func, :value] in links repeat
- htMakeButton('"\lispdownlink",message,
- mkCurryFun(func, value),skipStateInfo?)
- bcIssueHt info
-
-htBcLispLinks links ==
--------------------------> OBSELETE
- [links,options] := beforeAfter('options,links)
- for [message, info, func, :value] in links repeat
- htMakeButton('"\lisplink",message, mkCurryFun(func, value))
- bcIssueHt info
-
beforeAfter(x,u) == [[y for [y,:r] in tails u while x ^= y],r]
mkCurryFun(fun, val) ==
@@ -441,10 +334,6 @@ htBcRadioButtons [groupName, :buttons] ==
iht '"\space{}}"
bcIssueHt info
-setUpDefault(name, props) ==
----------------> OBSELETE <----------------
- htpAddInputAreaProp($curPage, name, props)
-
buttonNames buttons ==
[buttonName for [.,., buttonName] in buttons]
@@ -543,23 +432,6 @@ htProcessDoneButton [label , func] ==
iht '"} "
-htMakeButton(htCommand, message, func,:options) ==
-----------> OBSELETE <----------------------------------
- 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, '"))}"]
-
bchtMakeButton(htCommand, message, func) ==
bcHt [htCommand, '"{", message,
'"}{(|htDoneButton| '|", func, '"| (PROGN "]
@@ -605,13 +477,6 @@ executeInterpreterCommand command ==
PRINC MKPROMPT()
FINISH_-OUTPUT()
-htDoneButton(func, htPage) ==
- typeCheckInputAreas htPage =>
- htMakeErrorPage htPage
- NULL FBOUNDP func =>
- systemError ['"unknown function", func]
- FUNCALL(SYMBOL_-FUNCTION func, htPage)
-
typeCheckInputAreas htPage ==
-- This needs to be severly beefed up
inputAlist := nil
diff --git a/src/interp/hypertex.boot b/src/interp/hypertex.boot
index ac83bc33..ff683357 100644
--- a/src/interp/hypertex.boot
+++ b/src/interp/hypertex.boot
@@ -58,9 +58,6 @@ issueHT line ==
sockSendInt($MenuServer, $SendLine)
sockSendString($MenuServer, line)
-endHTPage() ==
- sockSendInt($MenuServer, $EndOfPage)
-
testPage() ==
startHTPage(50)
issueHT '"\page{TestPage}{Test Page generated from Lisp} "
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index b3f2433f..00ef8fe6 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -315,7 +315,7 @@ clearCmdAll() ==
resetInCoreHist()
if $useInternalHistoryTable
then $internalHistoryTable := NIL
- else deleteFile histFileName()
+ else removeFile histFileName()
$IOindex := 1
updateCurrentInterpreterFrame()
$currentLine := '")clear all" --restored 3/94; needed for undo (RDJ)
@@ -1340,8 +1340,6 @@ changeToNamedInterpreterFrame(name) ==
$interpreterFrameRing := [frame,:NREMOVE($interpreterFrameRing, frame)]
updateFromCurrentInterpreterFrame()
-makeInitialModemapFrame() == COPY $InitialModemapFrame
-
findFrameInRing(name) ==
val := NIL
for frame in $interpreterFrameRing repeat
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index e301536d..8c10a164 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -163,7 +163,8 @@ HasSignature(domain,[op,sig]) ==
-- MEMQ(opOf(catform),'(Object Type)) or --temporary hack
-- or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist]
-makeInitialModemapFrame() == COPY $InitialModemapFrame
+makeInitialModemapFrame() ==
+ COPY $InitialModemapFrame
isCapitalWord x ==
(y := PNAME x) and and/[UPPER_-CASE_-P y.i for i in 0..MAXINDEX y]
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index b0396ed0..a55884b6 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -388,8 +388,6 @@
(defun |sayTeX| (x) (if (null x) nil (sayBrightly1 x |$texOutputStream|)))
-(defun |sayNewLine| () (TERPRI))
-
(defvar |$sayBrightlyStream| nil "if not nil, gives stream for sayBrightly output")
(defun |sayBrightly| (x &optional (out-stream |$OutputStream|))
diff --git a/src/interp/nhyper.boot b/src/interp/nhyper.boot
index 57e4771b..2772ca37 100644
--- a/src/interp/nhyper.boot
+++ b/src/interp/nhyper.boot
@@ -52,9 +52,6 @@ issueHT line ==
sockSendInt($MenuServer, $SendLine)
sockSendString($MenuServer, line)
-endHTPage() ==
- sockSendInt($MenuServer, $EndOfPage)
-
testPage() ==
startHTPage(50)
issueHT '"\page{TestPage}{Test Page generated from Lisp} "
diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot
index 421c0388..b6e17f50 100644
--- a/src/interp/pathname.boot
+++ b/src/interp/pathname.boot
@@ -74,8 +74,6 @@ pathnameDirectory p ==
null p => nil
NAMESTRING MAKE_-PATHNAME(KEYWORD::DIRECTORY,PATHNAME_-DIRECTORY pathname p)
-deleteFile f == _$ERASE pathname f
-
isExistingFile f ==
-- p := pathname f
--member(p,$existingFiles) => true
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index aecca91e..eaba3a3d 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -89,6 +89,8 @@
"compileLispHandler"
"Option"
+ "pathBasename"
+
"IMPORT-MODULE"
"CONCAT"
))
@@ -716,6 +718,10 @@
(concatenate 'string dir "/"))))
+;; Return the basename (without extension) of a file.
+(defun |pathBasename| (file)
+ (pathname-name file))
+
;;
;; -*- Modules in OpenAxiom -*-
;;
@@ -804,6 +810,10 @@
(eval-when (:load-toplevel :execute)
(pushnew #'shoe-provide-module sb-ext:*module-provider-functions*))
+;;
+;; -*- Native Datatype correspondance -*-
+;;
+
;; native data type translation table
(defconstant |$NativeTypeTable|
'((|void| . @void_type@)
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-01 21:15:47 +0000