Import Debian changes 3a1-4.2debian/3a1-4.2

slib (3a1-4.2) unstable; urgency=low * Non-maintainer upload. * Add guile.init.local for use within the build dir, since otherwise we have an (earlier unnoticed) circular build-dep due to a difference between scm and guile. slib (3a1-4.1) unstable; urgency=low * Non-maintainer upload. * Build-depend on guile-1.6 instead of scm, since the new version of scm is wedged in unstable (closes: #281809). slib (3a1-4) unstable; urgency=low * Also check for expected creation on slibcat. (Closes: #240096) slib (3a1-3) unstable; urgency=low * Also check for /usr/share/guile/1.6/slib before installing for guile 1.6. (Closes: #239267) slib (3a1-2) unstable; urgency=low * Add format.scm back into slib until gnucash stops using it. * Call guile-1.6 new-catalog (Closes: #238231) slib (3a1-1) unstable; urgency=low * New upstream release * Remove Info section from doc-base file (Closes: #186950) * Remove period from end of description (linda, lintian) * html gen fixed upstream (Closes: #111778) slib (2d4-2) unstable; urgency=low * Fix url for upstream source (Closes: #144981) * Fix typo in slib.texi (enquque->enqueue) (Closes: #147475) * Add build depends. slib (2d4-1) unstable; urgency=low * New upstream. slib (2d3-1) unstable; urgency=low * New upstream. * Remove texi2html call in debian/rules. Now done upstream. Add make html instead. * Changes to rules and doc-base to conform to upstream html gen * Clean up upstream makefile to make sure it cleans up after itself.
author: Steve Langasek <vorlon@debian.org> 2005-01-10 08:53:33 +0000
committer: Bryan Newbold <bnewbold@robocracy.org> 2017-02-20 00:05:30 -0800
commit: e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch)
tree: abbf06041619e445f9d0b772b0d58132009d8234
parent: f559c149c83da84d0b1c285f0298c84aec564af9 (diff)
parent: 8466d8cfa486fb30d1755c4261b781135083787b (diff)
download: slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip
slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz
267 files changed, 67975 insertions, 11544 deletions
diff --git a/.slibcat b/.slibcat
new file mode 100644
index 0000000..54d82ee
--- /dev/null
+++ b/.slibcat
@@ -0,0 +1,164 @@
+;"slibcat" SLIB catalog for guile1.6.7.        -*-scheme-*-
+;
+; DO NOT EDIT THIS FILE -- it is automagically generated
+
+(
+ (schelog . "./schelog/schelog")
+ (portable-scheme-debugger . "./psd/psd-slib")
+ (jfilter . "./jfilter/jfilter")
+ (null . "./null")
+ (aggregate . "./null")
+ (r2rs aggregate rev3-procedures rev2-procedures)
+ (r3rs aggregate rev3-procedures)
+ (r4rs aggregate rev4-optional-procedures)
+ (r5rs aggregate values macro eval)
+ (rev4-optional-procedures . "./sc4opt")
+ (rev3-procedures . "./null")
+ (rev2-procedures . "./sc2")
+ (multiarg/and- . "./mularg")
+ (multiarg-apply . "./mulapply")
+ (rationalize . "./ratize")
+ (transcript . "./trnscrpt")
+ (with-file . "./withfile")
+ (dynamic-wind . "./dynwind")
+ (dynamic . "./dynamic")
+ (fluid-let defmacro "./fluidlet")
+ (alist . "./alist")
+ (hash . "./hash")
+ (sierpinski . "./sierpinski")
+ (hilbert-fill . "./phil-spc")
+ (soundex . "./soundex")
+ (hash-table . "./hashtab")
+ (logical . "./logical")
+ (random . "./random")
+ (random-inexact . "./randinex")
+ (modular . "./modular")
+ (factor . "./factor")
+ (primes . factor)
+ (eps-graph . "./grapheps")
+ (charplot . "./charplot")
+ (sort . "./sort")
+ (tsort . topological-sort)
+ (topological-sort . "./tsort")
+ (common-list-functions . "./comlist")
+ (tree . "./tree")
+ (coerce . "./coerce")
+ (format . "./format")
+ (generic-write . "./genwrite")
+ (pretty-print . "./pp")
+ (pprint-file . "./ppfile")
+ (object->string . "./obj2str")
+ (string-case . "./strcase")
+ (line-i/o . "./lineio")
+ (string-port . "./strport")
+ (getopt . "./getopt")
+ (qp . "./qp")
+ (eval . "./eval")
+ (record . "./record")
+ (synchk . "./synchk")
+ (defmacroexpand . "./defmacex")
+ (printf . "./printf")
+ (scanf defmacro "./scanf")
+ (stdio-ports . "./stdio")
+ (stdio aggregate scanf printf stdio-ports)
+ (break defmacro "./break")
+ (trace defmacro "./trace")
+ (debugf . "./debug")
+ (debug aggregate trace break debugf)
+ (delay . promise)
+ (promise macro "./promise")
+ (macro-by-example defmacro "./mbe")
+ (syntax-case . "./scainit")
+ (syntactic-closures . "./scmacro")
+ (macros-that-work . "./macwork")
+ (macro . macro-by-example)
+ (object . "./object")
+ (yasos macro "./yasyn")
+ (oop . yasos)
+ (collect . "./collectx")
+ (structure syntax-case "./structure")
+ (values . "./values")
+ (queue . "./queue")
+ (priority-queue . "./priorque")
+ (array . "./array")
+ (subarray . "./subarray")
+ (array-for-each . "./arraymap")
+ (repl . "./repl")
+ (process . "./process")
+ (chapter-order . "./chap")
+ (posix-time . "./psxtime")
+ (common-lisp-time . "./cltime")
+ (time-zone defmacro "./timezone")
+ (relational-database . "./rdms")
+ (databases . "./dbutil")
+ (database-utilities . databases)
+ (database-commands . "./dbcom")
+ (database-browse . "./dbrowse")
+ (database-interpolate . "./dbinterp")
+ (within-database macro "./dbsyn")
+ (html-form . "./htmlform")
+ (alist-table . "./alistab")
+ (parameters . "./paramlst")
+ (getopt-parameters . "./getparam")
+ (read-command . "./comparse")
+ (batch . "./batch")
+ (glob . "./glob")
+ (filename . glob)
+ (crc . "./crc")
+ (fft . "./fft")
+ (wt-tree . "./wttree")
+ (string-search . "./strsrch")
+ (root . "./root")
+ (minimize . "./minimize")
+ (precedence-parse defmacro "./prec")
+ (parse . precedence-parse)
+ (commutative-ring . "./cring")
+ (self-set . "./selfset")
+ (determinant . "./determ")
+ (byte . "./byte")
+ (byte-number . "./bytenumb")
+ (tzfile . "./tzfile")
+ (schmooz . "./schmooz")
+ (transact defmacro "./transact")
+ (net-clients . transact)
+ (db->html . "./db2html")
+ (http defmacro "./http-cgi")
+ (cgi . http)
+ (uri defmacro "./uri")
+ (uniform-resource-identifier . uri)
+ (pnm . "./pnm")
+ (metric-units . "./simetrix")
+ (diff . "./differ")
+ (solid . "./solid")
+ (vrml97 . solid)
+ (vrml . vrml97)
+ (color defmacro "./color")
+ (color-space . "./colorspc")
+ (cie . color-space)
+ (color-names . "./colornam")
+ (color-database defmacro "./mkclrnam")
+ (resene color-names "./clrnamdb.scm")
+ (saturate color-names "./clrnamdb.scm")
+ (daylight . "./daylight")
+ (matfile . "./matfile")
+ (mat-file . matfile)
+ (spectral-tristimulus-values . color-space)
+ (cie1964 spectral-tristimulus-values "./cie1964.xyz")
+ (cie1931 spectral-tristimulus-values "./cie1931.xyz")
+ (ciexyz . cie1931)
+ (cvs defmacro "./cvs")
+ (html-for-each defmacro "./html4each")
+ (directory . "./dirs")
+ (ncbi-dna defmacro "./ncbi-dna")
+ (manifest . "./manifest")
+ (top-refs . "./top-refs")
+ (vet . "./vet")
+ (srfi-0 . srfi)
+ (srfi defmacro "./srfi")
+ (srfi-1 . "./srfi-1")
+ (srfi-2 defmacro "./srfi-2")
+ (srfi-8 macro "./srfi-8")
+ (srfi-9 macro "./srfi-9")
+ (new-catalog . "./mklibcat")
+ (*slib-version* . "3a1")
+)
diff --git a/ANNOUNCE b/ANNOUNCE
index 6070290..a4201ba 100644
--- a/ANNOUNCE
+++ b/ANNOUNCE
@@ -1,72 +1,56 @@
-This message announces the availability of Scheme Library release slib2d2.
-
-New in slib2d2:
-
-	* s48-0_57.init: Added.
-	* array.scm (make-shared-array): Fixed offset.
-	* record.scm: Changed identifiers containing VECTOR to VECT or VCT
-	(but no help for scheme48-0.57).
-	* slib.texi (Collections, Lists as sets, Multi-argument / and -,
-	Multi-argument Apply): Improved procedure templates.
-	* comlist.scm: Replaced single-letter identifier names to improve
-	readability.
-	* slib.texi (Lists as sequences): Updated examples per change to
-	comlist.scm.
-	* comlist.scm (comlist:union, comlist:intersection,
-	comlist:set-difference, comlist:remove-if, comlist:remove-if-not,
-	comlist:remove-duplicates): Earlier tail-recursion enhancements
-	changed the element order; which broke things.  Order restored.
-	* array.scm: Rewritten to sidestep license issues.
-	(array=?): Added.
-	* slib.texi (Arrays): Documentation integrated with array.scm.
-	* tree.scm (tree:subst): Rewritten; takes optional equality
-	predicate argument.
-	* Makefile (docfiles): Added "COPYING".
-	* mitcomp.pat: Unmaintained; removed.
-	* RScheme.init: Put in the public domain.
-	* Makefile (slib48): Simplified: scheme48 < scheme48.init
-	* scheme48.init (slib-primitives): Pipe into scheme48, not load.
-	Scheme48-0.45 the only version which runs jacal successfully.
-	* scmactst.scm: Removed for lack of license.
-	* struct.scm, structst.scm: Removed.  struct.scm lacks license.
-	* scheme48.init (atan): Added workaround.
-	* Makefile (slib48-0.55): Makes slib48, but fluid-let broken.
-	* format.scm (mutliarg/and-): Requires.
-	* mularg.scm (two-arg:/, two-arg:-): Added.
-	* scheme48.init (*features*): Doesn't support multiarg/and-.
-	* Makefile (slib48-0.45): Added ",load-package floatnums".
-	* slib.texi (Installation): Added specific instructions for
-	DrScheme, MIT-Scheme, and Guile.
-	* guile.init: Added.
-	* require.scm (program-vicinity): Improved error message.
-	* slib.texi (Installation): Explicit instructions for MzScheme.
-	* Makefile (pdf): Added target for creating $(htmldir)slib.pdf.
-	* slib.texi (Installation): Expanded instructions.
-	* bigloo.init, RScheme.init, STk.init (*features*): Provide srfi.
-	* Template.scm, *.init (*features*): Put into consistent form.
-	* require.scm (srfi): Detect presence of srfi-0 through srfi-30.
-	* srfi-1.scm: Added.
-	* comlist.scm (comlist:remove): Returns don't disturb order.
-	* array.scm: Generalized so strings and vectors are arrays.
-	* slib.texi (Standard Formatted Output): %b was missing.
-	* slib.texi (Sorting and Searching): Section split from
-	"Procedures".
-	* differ.scm (diff:longest-common-subsequence): Added.
-	(diff:longest-common-subsequence, diff:edits, diff:edit-length):
-	Optional third argument is equality predicate.
-	* differ.scm: An O(NP) Sequence Comparison Algorithm.
-	* srfi.scm (cond-expand): Added.
-	* wttree.scm (error:error): Replaces error.
-	* dbutil.scm (make-defaulter): number defaults to 0.
-	* Makefile (rpm): Fixed dependencies.
-
-From  Jacques Mequin  <jmequin@tif.ti.com>
-	* gambit.init: (set-case-conversion! #t)
-	* scheme48.init (defmacro): Defmacro in terms of define-syntax
-	using defmacro:expand*.
-
-From  Wade Humeniuk  <humeniuw@cadvision.com>
-	* yasyn.scm, object.scm, recobj.scm: Placed in public domain.
+This message announces the availability of Scheme Library release slib3a1.
+
+New in slib3a1:
+
+  SLIB 3 has undergone major development from SLIB2d6.
+
+  Most noticeable is that SLIB now has a module system with documented
+  semantics and a suite of reflexive tools for deriving reference and
+  module dependencies from library code.  The reflexive tools are
+  designed to support compiler-writer's needs as expressed in
+  discussions arising from comp.lang.scheme in July 2003.
+
+  The module semantics are intended to be compatible both with
+  implementations having module systems and those lacking.  Ivan
+  Shmakov has been striving to integrate SLIB's and Scheme48's module
+  systems.  His efforts and SLIB's reflexive tools have found a great
+  many bugs, some of them present since SLIB's beginnings.
+
+  "make install" now creates a "slib" shell script for running various
+  Schemes with SLIB initialization.  Currently supported
+  implementations are gsi (Gambit), Guile, MzScheme, Scheme48, and
+  SCM.
+
+  The byte-number module converts between byte-vectors,
+  twos-complement integers, and IEEE floating-point formats -- all in
+  R4RS-compliant Scheme code.  It also converts byte-vectors to a form
+  whose lexicographic ordering matches the encoded number's ordering.
+
+  The correctly ordered byte representations of numbers tie in with
+  SLIB's relational database being extended to include indexed
+  sequential access methods (ISAM).  The Database-interpolation module
+  uses sequential methods to synthesize continuous functions from
+  discrete data tables.
+
+    These "continuous databases" are vital to my soon-to-be-released
+    optics program which calculates spectral responses of layered thin
+    films.
+
+  The character plotting utility has been improved, and is now
+  complemented by eps-graph, a very flexible graphing library for
+  producing encapsulated-PostScript files.
+
+  SRFI-2, SRFI-8, and SRFI-9 are added.
+
+  Although I have endeavored to support legacy usage, some programs
+  will need modification to work with SLIB 3.  Some issues that I know
+  of are:
+
+  * REQUIRE no longer accepts a string as its argument.
+  * The RANDOM module is split into RANDOM and RANDOM-INEXACT.
+  * Some refactoring among TRANSACT, GLOB, and LINE-I/O.
+
+				-=-=-
 
 SLIB is a portable Scheme library providing compatibiliy and utility
 functions for all standard Scheme implementations.
@@ -79,17 +63,17 @@ Documentation includes a manifest, installation instructions, and
 coding guidelines for the library.  Documentation of each library
 package is supplied.  SLIB Documentation is online at:
 
-	     http://swissnet.ai.mit.edu/~jaffer/SLIB.html
+             http://swissnet.ai.mit.edu/~jaffer/SLIB.html
 
 SLIB is available from:
- http://swissnet.ai.mit.edu/ftpdir/scm/slib2d2.zip
- http://swissnet.ai.mit.edu/ftpdir/scm/slib-2d2-1.noarch.rpm
- swissnet.ai.mit.edu:/pub/scm/slib2d2.zip
- swissnet.ai.mit.edu:/pub/scm/slib-2d2-1.noarch.rpm
+ http://swissnet.ai.mit.edu/ftpdir/scm/slib3a1.zip
+ http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a1-1.noarch.rpm
+ swissnet.ai.mit.edu:/pub/scm/slib3a1.zip
+ swissnet.ai.mit.edu:/pub/scm/slib-3a1-1.noarch.rpm
 
 SLIB-PSD is a portable debugger for Scheme (requires emacs editor):
- http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.zip
- swissnet.ai.mit.edu:/pub/scm/slib-psd1-3.zip
+ http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz
+ swissnet.ai.mit.edu:/pub/scm/slib-psd1-3.tar.gz
 
 SCHELOG is an embedding of Prolog in Scheme+SLIB:
  http://www.cs.rice.edu/CS/PLT/packages/schelog/
diff --git a/Bev2slib.scm b/Bev2slib.scm
index 8461c5c..30562f5 100644
--- a/Bev2slib.scm
+++ b/Bev2slib.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
diff --git a/COPYING b/COPYING
index c16d8bd..a2eb7dd 100644
--- a/COPYING
+++ b/COPYING
@@ -27,7 +27,7 @@ the beginning of "require.scm" states:
   ;1.  Any copy made of this software must include this copyright notice
   ;in full.
   ;
-  ;2.  I have made no warrantee or representation that the operation of
+  ;2.  I have made no warranty or representation that the operation of
   ;this software will be error-free, and I am under no obligation to
   ;provide any services, by way of maintenance, update, or otherwise.
   ;
diff --git a/ChangeLog b/ChangeLog
index e5f19fa..857cc78 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,2066 @@
+2003-11-30  Aubrey Jaffer  <jaffer@scm.jaffer>
+
+	* require.scm (*SLIB-VERSION*): Bumped from 2d6 to 3a1.
+
+2003-11-30  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* mklibcat.scm (precedence-parse): defmacro because uses
+	fluid-let.
+
+2003-11-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* grapheps.scm: Added introduction.
+
+	* charplot.scm (charplot:array->list): Added missing SCM function.
+
+	* grapheps.scm (set-color): Use setgray instead of slib GREY.
+
+	* array.scm (make-array): Removed.
+
+	* dbutil.scm (mdbm:try-opens): Try alist-table when all types in
+	*base-table-implementations* failed.
+
+2003-11-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* grapheps.scm: Reorganized for better documentation flow.
+
+	* Makefile (txiscms, txifiles): grapheps now schmoozed.
+
+	* slib.texi (Graphing): Node hosts "Character Plotting" and
+	subtree "PostScript Graphing".
+
+	* grapheps.scm: Documented and fixed minor bugs.
+
+	* grapheps.ps (y-axis, x-axis): Check for axis within bounds.
+
+2003-11-27  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* grapheps.scm (create-postscript-graph): Take document %%title
+	from title-top and title-bottom.
+	(grid-verticals, grid-horizontals): Split gridding.
+	(plot): Ported charplot function.
+
+	* grapheps.ps: PostScript runtime support for creating graphs.
+
+	* grapheps.scm: Procedures for creating PostScript graphs.
+
+2003-11-23  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* array.scm (make-prototype-checker): Added prototype checks.
+
+2003-11-18  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* charplot.scm: Code cleanup and comments.
+
+2003-11-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* gambit.init (define-macro): Set *defmacros*; macroexpand works!
+
+2003-11-15  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* charplot.scm (charplot:plot-function): Changed dats array to
+	Ar64.  Changed scaling by one so last x is tried.
+	(charplot:make-array): Reduced width by one so newline is in
+	column 79.
+	(charplot:plot): Output extra newline if x scale overruns it.
+
+2003-11-10  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Feature): *features* no longer advertised.
+
+	* vet.scm (provided+?): Added.  Converted to predicate argument.
+
+	* fluidlet.scm (fluid-let): Recoded trivial use of make-list.
+
+	* gambit.init (implementation-vicinity): Use Gambc-3.0 default.
+	(home-vicinity): Added.
+	(print-call-stack): Added stub to satisfy 'TRACE.
+	(defmacro): slib:eval workaround of macro restrictions.
+
+	* mitscheme.init (*features*): Has FLUID-LET.
+
+	* manifest.scm: Updated examples.
+	(feature->requires, file->requires): Take predicate argument
+	PROVIDED? instead of features-list.
+
+2003-11-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (The Library System): Reorganized.
+	(Catalog Vicinities): Separated from "Library Catalogs".
+
+2003-11-08  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* random.scm (seed->random-state): Seed is string, not bytes.
+
+2003-11-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* arraymap.scm (array-map): Added.
+
+2003-11-02  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* mkclrnam.scm, dbrowse.scm, dbcom.scm, db2html.scm:
+	Replaced type uint with ordinal.
+
+	* rdms.scm, alistab.scm: Replaced types uint, base-id by ordinal.
+
+2003-11-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* rdms.scm (domains:init-data): Simplified.
+	(slib:error): Replaces alias rdms:error.
+
+2003-10-31  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Base Table): Reorganized subsection into 9 node tree.
+
+	* rdms.scm (isam-next, isam-prev): Take optional column argument.
+
+	* scheme48.init, s48-0_57.init (inexact->exact, exact->inexact):
+	Workaround exactness bug.
+
+2003-10-30  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Base Table): Description of wb-table and rwb-isam.
+
+	* rdms.scm (isam-prev isam-next): Added.
+
+2003-10-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Indexed Sequential Access Methods): Added.
+	(Table Operations): Reorganized subsection into into 6 node tree.
+
+2003-10-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Base Table): Added new MAKE-GETTER-1 method
+	retrieving single non-key field.
+
+	* rdms.scm (get, get*): Use optional make-getter-1 method.
+
+2003-10-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* dbutil.scm (define-tables): Replaced for-each row:insert with
+	row:insert*.
+
+	* slib.texi (Require): Updated examples.
+	(Feature): Clarified about *features* per session.
+	(Base Table): Added rwb-isam.
+
+	* rdms.scm (catalog:init-cols): TABLE-NAME now symbol.
+	(domains:init-data): ATOM is just symbol or #f.
+
+	* comlist.scm (butnthcdr): Fixed short-list bug.
+
+2003-10-24  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* rdms.scm (coltab-name domain-name): Changed to symbol from atom.
+
+	* comlist.scm (butnthcdr): SIMSYNCH FIFO8 uses negative k.
+
+	* dbutil.scm (define-domains): Added.
+
+2003-10-18  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* comlist.scm (remove-duplicates): moved LETREC outside.
+	(butlast): Defined in terms of BUTNTHCDR.
+	(butnthcdr): SET-CDR! to avoid using REVERSE.
+
+	* rdms.scm (combine-primary-keys): Removed primary-limit
+	restriction.
+
+2003-10-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* byte.scm (substring-write, substring-read!): Added.
+
+	* random.scm (random:chunk): Changed from using arrays to bytes.
+
+2003-10-16  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* byte.scm (read-bytes!): Return number of bytes read.
+	(read-bytes): Shorten returned bytes to number of bytes read.
+
+2003-10-13    <agj@alum.mit.edu>
+
+	* Makefile (efiles): bytenumb.scm was called out twice.
+
+2003-10-12    <agj@alum.mit.edu>
+
+	* byte.scm (write-bytes, write-byte, make-bytes): Fixed @args.
+
+2003-10-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* bytenumb.scm (IEEE-byte-decollate!, IEEE-byte-collate!)
+	(integer-byte-collate!): Return byte-vector.
+
+2003-10-08  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* bytenumb.scm (ieee-double->bytes, ieee-float->bytes): Added.
+	(integer-byte-collate!, integer-byte-collate, IEEE-byte-collate!)
+	(IEEE-byte-decollate!, IEEE-byte-collate, IEEE-byte-decollate):
+	Added.
+
+2003-10-04  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (fp:compare): Use negative p-lim for no-limit.
+
+	* sort.scm (sorted?, sort!, sort): Generalized to arrays.
+
+	* differ.scm: Always require SORT.
+	(diff:longest-common-subsequence, diff:edits)
+	(diff:edit-length): Moved all but argument handling out.
+	(diff2lcs, diff2edits, diff2editlen): Schlepable top-levels.
+	(diff:order-edits): Coded sign reversal in DO loop.
+	(diff:divide-and-conquer): Allocate and fp:init! fp array.
+	(check-cost): Pulled out of diff:divide-and-conquer.
+	(fp:init!): Added.
+	(fp:compare): fp passed in.
+	(diff2edits): MAXDX was off-by-one.
+	(diff:divide-and-conquer, diff2et, diff2ez): Reuse passed fp.
+	Initialize only used segment of fp.
+	(diff2edits): Allocate just one CCRR and pass to procedures.
+	(diff:order-edits): Converted vector usage to arrays.
+	(diff2ez, diff2et, diff:divide-and-conquer): Reuse passed CCRR.
+	(fp:init!): Take fill argument.
+
+2003-09-30  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* collectx.scm: Expand automatically from collect.scm.
+
+	* Makefile (collectx.scm): Build target using created collect.sc.
+
+	* collect.scm (object): Added (require 'object) for collectx.scm.
+
+	* macwork.scm (mw:suffix-character): Replaced non-R5RS-compliant
+	#\| with #\!.
+
+	* slib.texi (Exact Random Numbers, Inexact Random Numbers): Made
+	independent packages.
+
+	* randinex.scm: Separated package random-inexact from random.
+	(random:normal-vector!): Made *2pi internal.
+
+	* random.scm (random): Now does only exact integers.
+
+	* htmlform.scm (get-foreign-choices): Moved from db2html.scm in
+	order to eliminate circular require.
+
+2003-09-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* matfile.scm (matfile:read-matrix): Version 4 MAT-file endianness
+	cannot be detected from just the first word; ambiguous when 0.
+	Converted to use 'byte-number functions.
+	(matfile:read, matfile:load): Improved error handling.
+
+	* slib.texi (Byte): Schmoozed.
+	(Byte/Number Conversions): Added.
+
+	* Makefile (efiles, txiscms, txifiles): Added bytenumb.
+
+	* byte.scm (bytes-copy, bytes-reverse, bytes-reverse!)
+	(read-bytes, write-bytes): Added.
+
+	* bytenumb.scm: Added: Byte/integer and IEEE floating-point
+	conversions.
+
+2003-09-21  Ivan Shmakov  <ivan@theory.dcn-asu.ru>
+
+	* pnm.scm (pnm:array-write, pnm:type-dimensions): Fixed 'typo'.
+
+	* schmooz.scm (schmooz-tops): Replaced #\tab with slib:tab.
+
+	* yasyn.scm (print, size): ! replaces | in identifiers.
+
+2003-09-21  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* dirs.scm (transact): Eliminated require circularity.
+
+	* glob.scm (call-with-tmpnam): Moved from transact.scm.  String
+	arguments taken as suffixes for tmpnams.
+
+	* lineio.scm (system->line): Moved from transact.scm.
+	(display-file): Removed.
+
+	* scanf.scm (sscanf): No longer calls string-port export.
+	(stdio:scan-and-set): Moved call-with-input-string from sscanf.
+
+2003-09-14  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* ncbi-dna.scm (ncbi:read-DNA-sequence): Discard to end of ORIGIN
+	line (which can have chromosome location).
+
+2003-09-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* matfile.scm (ieee-float->bytes): Added.
+
+	* sort.scm (sort, sort!, sorted?): Generalized to strings.
+
+2003-08-31  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* top-refs.scm: Footnote closing brace on @end line chokes
+	texi2html.
+
+	* Makefile: Moved documentation targets after txifiles definition
+	so dependencies work correctly.
+
+2003-08-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Relational Infrastructure): Collected internal
+	details of database operations.
+
+2003-08-26  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* dbutil.scm (open-table, open-table!): Added.
+	(create-database): Expanded documentation.
+	require-if 'compiling 'alist-table.
+
+	* slib.texi (Relational Database Objects, Database Operations):
+	Deprecated in favor of section "Using Databases".
+
+2003-08-26  dai inukai  <inukai.d@jeans.ocn.ne.jp>
+
+	* transact.scm (emacs-lock:certificate): "ls -ld" is more portable
+	[GNU, FreeBSD, Vine Linux, Debian Linux] than "ls -o".
+
+2003-08-22  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* dbrowse.scm (browse:display-dir): Keys can be other than strings
+	or symbols.
+
+2003-08-18  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* dbutil.scm (create-database): Gracefully return #f when
+	(not (assq type *base-table-implementations*)).
+
+2003-08-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* pnm.scm (pnm:read+integer): Replaced by READ.
+
+2003-08-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Basic Operations on Weight-Balanced Trees): wt-tree?
+	removed because it isn't exported.
+
+2003-07-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* scanf.scm (stdio:scan-and-set): Fixed scope of (return).
+
+	* manifest.scm (feature->exports): Added; returns simple list.
+	(feature->export-alist): Renamed from feature->exports.
+	(feature->requires): Don't cons feature onto list.
+
+	* slib.texi (Configuration): Use /usr/local/lib/scm/ in examples.
+
+	* vet.scm (vet-slib): Use feature->exports.
+
+2003-07-24  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* mklibcat.scm (http, color, ncbi-dna): Are defmacro features.
+
+	* schmooz.scm (schmooz:read-word): Replaced single use of scanf.
+
+	* pnm.scm (pnm:array-write): Removed use of printf.
+	(pnm:read+integer): Removed use of scanf.
+
+	* scanf.scm (stdio:scan-and-set): Minor cleanup.
+
+	* slib.texi (Module Conventions): Added macro rules.
+
+2003-07-23  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Template.scm (defmacro:expand*): Don't export.
+
+	* defmacex.scm (defmacro:expand*): Exported.
+
+	* mklibcat.scm: Added DEFMACRO for many 'scanf users.
+
+	* slib.texi (Syntax-Case Macros): Added @findex define-structure.
+	(Spectra): Added @findex load-ciexyz.
+	(Color Conversions): Added color:linear-transform.
+	(Collections): Added @findex for gen-keys, gen-elts.
+
+	* Makefile (bfiles): Added collectx.scm.
+
+	* yasyn.scm (size, print): Replaced with macro expansions.
+	(pormat): Coded out printf.
+	Moved all define-syntax forms to end.
+
+	* top-refs.scm (top-refs:expression): Handle WITH-SYNTAX; Don't
+	give up on ... in let* bindings.
+
+	* schmooz.scm (schmooz-top): Fixed typo in error call.
+
+	* manifest.scm (feature->exports): Handle aliases.  Warn, not err.
+
+	* transact.scm, uri.scm: Always require 'scanf since it needs
+	defmacro.
+
+	* vet.scm (slib:catalog): Static SLIB part of *catalog*.
+	(vet-slib): Fixed handling of aggregate entries' exports.
+
+	* collectx.scm: Copy of collect.scm where DEFINE-OPERATIONs are
+	replaced with macros-that-work expansions.
+
+	* collect.scm: Cleaned up error messages and aliases.
+
+2003-07-22  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Promises): Added delay macro.
+
+2003-07-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* manifest.scm: Shuffled functions; added examples.
+
+	* slib.texi (Module Conventions): Clarified.  Added example of ;@.
+	(Require): SLIB:IN-CATALOG? renamed from SLIB:FEATURE->PATH.
+
+	* require.scm (slib:in-catalog?): Renamed from slib:feature->path.
+	Internal aliases defined from advertised functions.
+	SRFIs number over 40; test using SLIB:EVAL.
+
+	* vet.scm (vet-slib): Improved output formatting.
+	Shuffled functions.
+
+	* synclo.scm: Added ";@" export notations.
+
+2003-07-16  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* collect.scm: Added ";@" export notations for define-operation.
+
+	* slib.texi (Coding Guidelines): Circular requires now handled.
+	(Feature): Added mention of catalog:read.
+
+	* getopt.scm (getopt:opt): Export for getparam.scm.
+
+	* vet.scm (top-refs<-files, requires<-file, requires<-files)
+	(definitions<-files, exports<-files): Added multi-file functions.
+
+	* manifest.scm (load->path): Moved from top-refs.scm; exported.
+	(file->loads): Added; finds all loads.
+	(file->definitions): Handle define-operation.
+
+	* Makefile (release): make pdf.
+
+	* top-refs.scm (top-refs:expression): Handle define-syntax.
+	(arglist:flatten): Pulled up to top-level.
+	(top-refs:expression): Handle syntax-rules and syntax-case.
+	(top-refs:top-level): Handle define-operation.
+
+	* solid.scm (solid-color->sRGB): Inlined logical calls.
+	(pi/180): Defined in terms of atan.
+
+	* require.scm (slib:require): Provide _before_ load.
+
+	* random.scm (random:chunk): Export for randinex.scm.
+
+	* randinex.scm (random:uniform1): Export for random.scm.
+
+2003-07-15  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* top-refs.scm (top-refs:binding): Scan for all internal defines
+	before doing top-refs:expression.
+
+	* uri.scm (uri:make-path): Document and export.
+
+	* slib.texi (Coding Guidelines): Expanded and updated.
+	(Porting): Improved formating.
+	(Installation): Added @cindex.
+	(Module Semantics): Discuss compiling "provided?" calls.
+	Removed @refills.
+
+	* README (USING SLIB): Section replaces CODING GUIDELINES.
+
+	* alist.scm, lineio.scm: Removed @refill texinfo commands.
+
+	* Template.scm, vscm.init, umbscheme.init, scsh.init,
+	pscheme.init, guile.init, STk.init, RScheme.init, t3.init,
+	scheme48.init, scheme2c.init, s48-0_57.init, mitscheme.init,
+	macscheme.init, gambit.init, elk.init, chez.init, bigloo.init,
+	Template.scm (rNrs): Renamed from revN-report feature.
+
+2003-07-15  From: Sven Hartrumpf
+
+	* srfi-1.scm (%cars+cdrs, %cars+cdrs/no-test, %cdrs)
+	(any, filter, filter!, list-copy, list-index, map!)
+	(pair-for-each, partition, remove, remove!, span):
+	Adapted from the reference implementation by
+	+ removing all check-arg calls
+	+ expanding all uses of 'receive'
+	+ extending 'remove' by a test to stay compatible with comlist:remove
+
+2003-07-14  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* glob.scm, getparam.scm: Schmoozed documentation into.
+
+	* daylight.scm (pi pi/180): Define.
+
+	* html4each.scm (prefix-ci?): Added. (require 'string-port).
+
+	* http-cgi.scm (coerce->list): Fixed.  Added missing requires.
+
+	* logical.scm (logical:ones): Export.
+
+	* mkclrnam.scm (load-rgb-txt): Removed lone printf.
+
+	* repl.scm: Always require 'values.
+
+	* slib.texi (Bit-Twiddling): Documented logical:ones
+	(Vicinity): Documented vicinity:suffix?
+
+	* tzfile.scm: Replaced ASH with quotient.
+
+	* uri.scm (path->uri): Needed (require 'directory).
+
+	* top-refs.scm (vet-slib): Move to "vet.scm".
+	(exports<-info-index): Can do several sections per call.
+	(top-refs:expression): Fixed let* with internal defines.
+
+	* vet.scm (vet-slib): Given own file.
+
+	* color.scm (convert-color, color->string): Fixed handling of
+	optional whitepoint argument.
+
+	* slib.texi (Trace): Added trackf, stackf, untrackf, unstackf.
+	(Getopt): Used @code{getopt--} to get correct symbol indexed.
+
+	* top-refs.scm (vet-slib): Vets definitions and documentation
+	against each other -- way cool!
+
+	* slib.texi (Spectra): Added temperature->chromaticity
+
+	* manifest.scm (file->definitions): Added.
+
+	* differ.scm (fp:step-check, smooth-costs): Commented out orphans.
+
+	* dirs.scm (make-directory): Replaced sprintf with string-append.
+
+	* slib.texi (Command Intrinsics, Table Operations)
+	(Database Operations): Changed to @defop.
+	Always bracket type-arguments to @def*s.
+
+2003-07-12  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* require.scm (slib:report-locations): Replace 'implementation
+	with type and version symbols.
+
+2003-07-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* manifest.scm (file->exports): Added BEGIN support.
+
+	* top-refs.scm: Added; list top-level variable references.
+
+	* Makefile (txiscms): Added hashtab.scm, chap.scm.
+
+	* slib.texi (Hash Tables, Chapter Ordering): Moved documentation
+	to schmooz comments in source.
+
+	* object.texi: Renamed from objdoc.txi; so isn't confused with
+	schmooz-generated file.
+
+	* hashtab.scm: Schmoozed documentation into.
+	(hash-rehasher): Documented.
+
+	* withfile.scm, trnscrpt.scm: Added ";@" export notations.
+
+2003-07-10  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* alist.scm, comparse.scm, chap.scm: Schmoozed documentation into.
+
+	* slib.texi (Color Difference Metrics): Reorganized.
+
+	* glob.scm: Added ";@" export notations.
+	Removed "glob:" aliases for exports.
+
+	* rdms.scm (catalog:view-proc-pos, domains:type-param-pos)
+	(rdms:warn): Commented out unused definitions.
+
+	* db2html.scm (make-defaulter): Moved near its only use.
+	(get-foreign-choices): Moved here and documented.
+
+	* Makefile (txiscms): Added ratize.scm, modular.scm, comparse.scm,
+	alist.scm.
+
+	* slib.texi (Array Mapping, Cyclic Checksum, Directories, Fast
+	Fourier Transform, Portable Image Files, Priority Queues, Queues,
+	Rationalize, Modular Arithmetic, Command Line, Association Lists):
+	Moved documentation to schmooz comments in source.
+
+	* schmooz.scm (schmooz-fun): Use "deffn Procedure" if procedure
+	name ends in "!".
+
+	* color.scm: Added ";@" export notations; removed collision-prone
+	aliases.
+
+	* qp.scm (qp): Removed aliases; added ";@" export notations.
+
+	* arraymap.scm, queue.scm, priorque.scm, pnm.scm, dirs.scm,
+	ratize.scm, modular.scm: Schmoozed documentation into.
+
+	* slib.texi (Token definition): Added tok:bump-column.
+
+	* hash.scm (hashv): Cleaned; Added ";@" export notations.
+
+	* logical.scm, guile.init: "logical:" prefixes for internal use
+	only (except logical:rotate).
+
+	* slib.texi (Time Zone): Documented tz:std-offset; used in
+	"psxtime.scm".
+
+	* uri.scm (uri:path->keys): Documented; used by
+	command:modify-table in "db2html.scm".
+
+	* random.scm: Commented-out unused random:random.
+
+	* htmlform.scm (html:delimited-list): Documented; used in
+	command->p-specs example.
+
+2003-07-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* strsrch.scm, strport.scm, strcase.scm, scanf.scm, sc4opt.scm,
+	rdms.scm, printf.scm, mbe.scm, fluidlet.scm, dynwind.scm,
+	byte.scm: Added ";@" export notations.
+
+	* comlist.scm: "comlist:" prefixes for internal use only.
+
+	* srfi-1.scm (cons*, take, drop, take-right, drop-right, last,
+	reverse!, find, find-tail): Dropped comlist: prefixes.
+
+	* scmacro.scm (base:load): Unused; removed.
+
+	* scainit.scm: Put SLIB:LOADs at top-level so codewalk finds them.
+
+	* macwork.scm (mw:every, mw:union, mw:remove-if-not): Local copies
+	of common-list-functions.
+
+	* dbutil.scm (add-domain): Documented.
+
+2003-07-08  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* mklibcat.scm: Converted associations to proper lists.
+
+	* require.scm (slib:require): Corrected subtle logic problems.
+	(catalog:resolve): Accept and convert proper lists associations.
+
+	* recobj.scm (field:position): Private name for CL function.
+
+	* object.scm: Added export notations: ";@".
+
+	* factor.scm (primes-gcd?): Inlined single use of NOTEVERY.
+	(primes<): Renamed from prime:primes<.
+
+2003-07-07  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Module Semantics): Added.
+
+2003-07-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Catalog Creation): Added catalog:read.
+
+	* mklibcat.scm: Use catalog:resolve.
+
+	* require.scm (catalog:resolve, catalog:read): Added.
+
+2003-07-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* factor.scm (prime:factor, prime:primes>, prime:primes<):
+	eliminated orphans.
+
+	* tree.scm: Moved documentation from slib.texi.
+
+	* srfi-2.scm (and-let*): Guarded LET* special form.
+
+	* Makefile (txiscms, txifiles): Added srfi-2.
+
+2003-07-03  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Makefile (*files): Reorganized to eliminate duplications.
+
+	* srfi-9.scm (define-record-type): Syntax wrapper for 'record.
+
+	* srfi-8.scm (receive): Added.
+
+	* schmooz.scm (def->args): Fixed for syntax-rules.
+
+2003-07-02  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Feature): Added feature-eval.
+	(Require): Added require-if.
+	(Database Reports): Removed.
+
+	* manifest.scm: Examples added.
+
+	* array.scm (make-array): Alias of create-array.
+
+	* manifest.scm: List SLIB module requires and exports; useful for
+	compiling.
+
+	* Makefile (txifiles, txiscms): Added tsort.
+
+	* slib.texi (Topological Sort): Moved docs to "tsort.scm".
+
+	* tsort.scm: Moved documentation from slib.texi into.
+
+	* require.scm (feature-eval): Abstracted from slib:provided?
+
+	* cring.scm: Added export notations: ";@".
+
+2003-07-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* require.scm (slib:require-if): Added.
+	(slib:provided?): Accepts expressions with AND, OR, and NOT.
+
+2003-06-30  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Makefile (txiscms): sed script seems not to work.
+
+	* slib.texi (Top): Universal SLIB Procedures (was Built-in
+	Support) moved to Top.
+	(Feature Require): Fixed bad craziness.
+	(About this manual): Moved to "About SLIB".
+
+	* require.scm: All "require:" prefixes changed to "slib:".
+	(*modules*): Removed.
+
+2003-06-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* formatst.scm, fmtdoc.txi, format.scm: Removed because not
+	reentrant.
+
+	* FAQ: Added "What happened to FORMAT?"
+
+	* Makefile (txiscms): Generated from txifiles.
+
+	* yasyn.scm: Changed from FORMAT to PRINTF-based (pormat).
+
+	* prec.scm (prec:trace): Removed.
+
+	* solid.scm, solid.scm, timezone.scm, uri.scm, admin.scm,
+	alistab.scm, batch.scm, colorspc.scm, db2html.scm, dbutil.scm,
+	differ.scm, getparam.scm, html4each.scm, obj2str.scm, printf.scm,
+	psxtime.scm, repl.scm, transact.scm, format.scm, matfile.scm,
+	ncbi-dna.scm:
+	Added conditional top-level REQUIRE for each dynamic REQUIRE.
+
+2003-06-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Makefile (MKNMDB): mkclrnam.scm split from colornam.scm.
+
+	* colornam.scm (load-rgb-txt): Database creation moved to
+	mkclrnam.scm.
+
+	* mkclrnam.scm (load-rgb-txt): Database creation moved from
+	colornam.scm.
+
+	* priorque.scm (heap:test): Removed.
+
+	* crc.scm (cksum-string): Moved to example in "slib.texi" (Cyclic
+	Checksum).
+
+2003-06-27  Felix Winkelmann
+
+	* minimize.scm (golden-section-search): eqv? --> =.
+
+	* mklibcat.scm (scanf): Is defmacro package.
+
+2003-06-20  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* require.scm (*SLIB-VERSION*): Bumped from 2d5 to 2d6.
+	* array.scm (make-array): Removed legacy procedures.
+
+2003-06-18  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:order-edits): Interleave inserts and deletes
+	when adjacent.
+
+2003-06-16  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff2ebc diff2ebr): Removed; 3% not worth it.
+
+	* logical.scm (gray-code->integer):
+	* pnm.scm (pnm:array-write):
+	* slib.texi (Yasos examples, Commutative Rings):
+	* subarray.scm (array-trim): error -> slib:error.
+
+	* charplot.scm (histobins): Gracefully return when no data.
+
+2003-06-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:mid-split): Replaces diff:best-split.
+	(diff2ebr): Fixed RR polarity; now works with diff:mid-split.
+
+2003-06-07  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:longest-common-subsequence): Call
+	DIFF:ORDER-EDITS only when there are edits.
+	(diff:divide-and-conquer): Inlined diff->costs; allocate CC and RR
+	out of the same array.
+
+2003-06-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff2ebc, diff2el): Inlined insert and delete.
+	(diff:order-edits): take sign argument.
+	(diff:edits, diff:longest-common-subsequence): Handle argument
+	order.
+	(diff2ebc, diff2ebr): Handle insertions and deletes; not matches.
+
+2003-06-04  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff2el): Simplified by half.
+	(diff:order-edits): Returns; edits were almost right order.
+	(diff->costs): smooth-costs not needed.
+	(diff2ebc, diff2ebr): Moved conditional swap to diff2et.
+	(diff:order-edits): Figure LEN-A and LEN-B from EDITS.
+	(diff:best-split): Simplified using passed expected COST.
+
+2003-06-02  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff2el): Removed never-used LEN-B = 0 case.
+	(diff:divide-and-conquer): Pass cost to diff2ebr, diff2ebc.
+	(diff2ebc): Fixed insert order; P-LIM when B gets shorter than A.
+	(diff:order-edits): Removed -- edits are now generated in order.
+	(diff2edits): Check returned cost.
+	(diff2el): Handle LEN-A = P-LIM case.
+
+2003-06-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm Reordered procedures and changed some argument names
+	to match paper.
+	(diff2e*): INSERT and DELETE replaced with EDITS, EDX, and EPO.
+
+2003-05-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (edits2lcs): Pass in editlen in pursuit of
+	schlepability.
+
+2003-05-26  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* soundex.scm (SOUNDEX): Character lookups use ASSV and MEMV.
+
+	* strsrch.scm (substring?, substring-ci?): Bum simple cases.
+	(subskip): Split out common code from substring?, substring-ci?.
+	(subloop): Old non-table-driven code for short substring?s.
+	(substring?, substring-ci?): Compared measurements of subskip vs
+	subloop; set breakpoint at STRLEN < CHAR-CODE-LIMIT/2 + 2*PATLEN.
+	(substring-ci?, substring?): Refined; subloop for PATLEN <= 4.
+
+2003-05-25  Steve VanDevender
+
+	* strsrch.scm (substring?, substring-ci?): Rewrote, improving
+	performance and fixing (substring-ci? "a" "An apple") ==> 3 bug.
+
+2003-05-24  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:order-edits): Added; returns correct order.
+
+2003-05-23  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (edits2lcs): Removed editlen argument.
+
+	* ncbi-dna.scm: Read and manipulate NCBI-format nucleotide
+	sequences.
+
+2003-05-12  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff2el): Handle all (zero? p-lim) cases.
+
+2003-05-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm: Reorganized diff2* functions.  Leading and trailing
+	runs of matches now trimmed from all edits-producing comparisons.
+	(smooth-costs): Correct cost jumps left by fp:compare
+	[which visits only a few (x,y)].
+	(diff->costs): Check that each adjacent CC pair differs by +/-1.
+	(diff:divide-and-conquer): Disable SHAVE pending bug resolution.
+	(diff2ebr, diff2ebc): Split diff2eb; end-run optimization only
+	works for half inheriting middle insertions.
+	(diff:divide-and-conquer): Moved fp:check-cost into.
+
+2003-05-03  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:shave): Removed cdx+1; now cdx.  Keep track of
+	endb in insert loop.
+
+2003-05-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:shave): Also trim matches with decreasing CC
+	from ends; nets 27% speed.
+
+2003-04-27  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* guile.init (port?): Had argument name mismatch.
+
+2003-04-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* db2html.scm (command:make-editable-table, command:modify-table):
+	Improved null-keys treatment to work with multiple primaries.
+
+2003-04-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* qp.scm (qp:qp): Distinguish #f and 0 values for *qp-width*.
+
+2003-03-30  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:divide-and-conquer): Trim based on CC alone.
+	(diff:best-split): Extracted from diff:divide-and-conquer.
+	(diff:shave): Abstracted from diff:divide-and-conquer.
+
+2003-03-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (fp:compare): Use smaller fp if p-lim supplied.
+
+2003-03-27  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:divide-and-conquer): Find longest optimal run.
+	(diff2edits): Initialize edits array to prevent type error.
+	(diff:divide-and-conquer): Split nearest to midpoint within
+	longest run.
+	(diff:divide-and-conquer): Split into 3 parts if consecutive
+	inserts are discovered in bestrun.
+	(diff:divide-and-conquer): No need to check both CC and RR for
+	linearity; tcst being constant guarantees it.
+
+2003-03-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (scene:viewpoint): Simplified; fixed pitch.
+	(solid:extract-colors): Fixed color/elevations alignment.
+	(solid:extract-colors, solid:extract-elevations): Fixed row-major.
+
+2003-03-24  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (solid:basrelief): Added VRML ElevationGrid.
+	(solid:bry): Added "solid FALSE" and missing alternative clause.
+
+2003-03-23  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* html4each.scm (html-for-each): Rewrote for full quote hair.
+	Removed require string-search; uses own multi-char version.
+
+2003-03-16  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* html4each.scm (html-for-each): "unterminated HTML entity"
+	warning infinitely looped; changed to error.
+	(htm-fields): Recover from HTML errors.
+
+2003-03-15  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* uri.scm (uri->tree, make-uri): Fixed confusion of #f and "".
+
+	* db2html.scm (command:make-editable-table): foreign-choice-lists
+	now opens the table.
+
+2003-03-07  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi: Fixed database examples.
+
+	* dbutil.scm (solidify-database): Fixed lock handling.
+
+2003-03-02  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* fft.scm (fft:shuffle&scale): Use bit-reverse from 'logical.
+
+	* arraymap.scm (array-for-each): Use set-car! instead of reverse.
+
+2003-02-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Getopt): Fixed double dashes.
+
+	* transact.scm (transact-file-replacement): Accept (string) path
+	to backup file in place of backup-style symbol.
+
+2003-01-27  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* phil-spc.scm (hilbert-coordinates->integer): Converted to
+	tail-recursive internal define.
+
+	* slib.texi (Peano-Hilbert Space-Filling Curve): Renamed from
+	"Hilbert Space-Filling Curve".
+
+	* phil-spc.scm: Renamed from "fhilbert.scm".
+
+2003-01-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* fhilbert.scm (integer->hilbert-coordinates): Made index
+	processing symmetrical with hilbert-coordinates->integer.
+
+2003-01-13  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* bigloo.init (scheme-implementation-version): *bigloo-version*
+	(implementation-vicinity): *default-lib-dir*/.
+	(library-vicinity): Check couple of places using DIRECTORY?.
+
+2003-01-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Plotting): Updated examples.
+
+2003-01-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* fhilbert.scm (hilbert-coordinates->integer)
+	(integer->hilbert-coordinates): Reference rank now 0 (was 2).
+
+2003-01-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* fhilbert.scm (hilbert-coordinates->integer): Fixed nBits.
+	(integer->hilbert-coordinates): Simplified.
+
+	* DrScheme.init (defmacro): Restore for mzscheme-202.
+
+2003-01-05  Ivan Shmakov  <ivan@theory.dcn-asu.ru>
+
+	* queue.scm (dequeue-all!): Added.
+
+2003-01-05  L.J. Buitinck  <L.J.Buitinck@student.rug.nl>
+
+	* comlist.scm (comlist:subset?): Added.
+
+2003-01-04  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* fhilbert.scm: Added Hilbert Space-Filling Functions.
+
+	* logical.scm (logical:logcount, logical:integer-length): Made
+	tail-recursive.
+	(logical:logxor, logical:logior, logical:logand): Made
+	tail-recursive.
+
+2002-12-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* logical.scm (logical:ones): Return 0 for 0 argument.
+	(gray-code->integer): Improved running time from O(b^2) to
+	O(b*log(b)).
+
+2002-12-26  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* batch.scm (*operating-system*): gnu-win32 renamed from cygwin32.
+
+	* slib.texi (String Search): State search order for string-subst.
+
+2002-12-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* html4each.scm (htm-fields): Parses markup string.
+	(html-for-each): Handle comments as markups.
+
+	* strsrch.scm (count-newlines): Added.
+
+	* comlist.scm (comlist:list*): Make letrec top-level.
+
+2002-12-25  "L.J. Buitinck" <L.J.Buitinck@let.rug.nl>
+
+	* comlist.scm (comlist:union): Make letrec top-level.
+
+2002-12-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (scene:viewpoints): Restored Up and Down views.
+
+	* slib.texi (Rule Types): Split from Precedence Parsing Overview.
+	(Precedence Parsing Overview): Describe binding power concept.
+
+2002-12-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* batch.scm (*operating-system*): Detect MINGW32 (gcc on MS-DOS)
+	as CYGWIN.
+
+2002-12-09  W. Garrett Mitchener  <wmitchen@math.princeton.edu>
+
+	* Makefile (catalogs): Make mzscheme new-catalog -g
+	(case-sensitive) so *SLIB-VERSION* symbol upper-cased.
+
+2002-12-08  L.J. Buitinck  <L.J.Buitinck@let.rug.nl>
+
+	* slib.texi (Destructive list operations): Fixed SOME example.
+	MAP instead of MAPCAR in nconc example.
+
+2002-12-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* random.scm (random): Streamlined.
+	(seed->random-state, random:chunk): Replaced BYTE with ARRAY.
+
+2002-12-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* random.scm (random): Don't get extra chunk when modu is integer
+	multiple of 256.
+
+2002-12-02  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* html4each.scm (html:read-title): Added optional LIMIT
+	(word-count) argument.
+
+	* slib.texi (Getopt, Getopt Parameter lists):
+	* getparam.scm (getopt->arglist, getopt->parameter-list):
+	* getopt.scm (getopt, getopt--): Global variable *argv* replaces
+	argc, argv arguments.  Not the best solution -- but at least its
+	consistent.
+
+	* slib.texi (Lists as sets): Updated UNION examples.
+
+	* comlist.scm (comlist:union): Optimized for list lengths.
+
+2002-12-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* html4each.scm (html:read-title): Added.
+	(html-for-each): Accept input-port for FILE argument.
+	(html:read-title): Added check for first char being '<'.
+
+	* uri.scm (absolute-uri?): Added.
+
+2002-11-30  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* uri.scm (uri->tree): Corrected documentation.
+
+	* dbutil.scm (mdbm:report): Show lock certificates.
+	(create-database, write-database, syncify-database,
+	close-database): Lock database file for writing.
+	(create-database): Allow initial #f filename.
+
+	* slib.texi (Copyrights): Fixed TeX formatting.
+
+2002-11-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* DrScheme.init: Added (provide 'fluid-let).
+	(call-with-input-string): Corrects bug in
+	/usr/local/lib/plt/collects/slibinit/init.ss.
+
+2002-11-26  Aubrey Jaffer  <jaffer@aubrey.jaffer>
+
+	* require.scm (*SLIB-VERSION*): Bumped from 2d4 to 2d5.
+
+2002-11-26  dai inukai  <inukai.d@jeans.ocn.ne.jp>
+
+	* srfi-1.scm (drop-right, take-right): Were swapped.
+
+2002-11-26  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* DrScheme.init: Ported for VERSIONs >= "200".
+
+	* Template.scm, vscm.init, umbscheme.init, t3.init, STk.init,
+	scsh.init, scheme2c.init, s48-0_57.init, RScheme.init,
+	macscheme.init, gambit.init, elk.init, chez.init, bigloo.init
+	(slib:warn): Put spaces between arguments.
+
+	* slib.texi (Database Macros): Section added.
+
+	* dbcom.scm (define-*commands*): Added; supports define-command.
+
+2002-11-26  Ivan Shmakov  <ivan@theory.dcn-asu.ru>
+
+	* scheme48.init (slib:warn): Match S48-ERROR format.
+
+	* dbsyn.scm (within-database, define-table, define-command):
+	Added new file.
+
+2002-11-22  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Portable Image Files): Added cindexes.
+
+	* pnm.scm (pnm:read-bit-vector!): Fixed for odd width pbms.
+	(pnm:image-file->array): Takes optional comment string arguments.
+
+2002-11-21  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Makefile (docfiles, efiles): nclients.* renamed transact.*.
+
+	* transact.scm: Renamed from nclients.scm.
+
+	* nclients.scm (emacs:backup-name): Added.
+	(transact-file-replacement): Now does backup files.
+
+2002-11-20  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* guile.init (define-module, eval): Condition on version.
+
+	* slib.texi (Transactions): Replaces net-clients section.
+
+	* vscm.init, umbscheme.init, Template.scm, t3.init, STk.init,
+	scsh.init, scheme48.init, scheme2c.init, s48-0_57.init,
+	RScheme.init, pscheme.init, macscheme.init, gambit.init, elk.init,
+	DrScheme.init, chez.init, bigloo.init (browse-url): Added.
+
+	* nclients.scm (user-email-address): Split into pieces.
+	(transact-file-replacement): Replaces call-with-replacement-file.
+
+2002-11-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* uri.scm (path->uri, absolute-path?, null-directory?)
+	(glob-pattern?, parse-ftp-address): Moved from nclients.scm.
+
+	* dirs.scm (current-directory, make-directory): Moved from
+	nclients.scm.
+
+2002-11-15  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* dirs.scm: Added.
+
+2002-11-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Space-Filling Curves): Section added.
+	(Bit-Twiddling): Added logical:rotate.
+
+	* logical.scm (logical:rotate): Added.
+	(logical:ones): Added so correct with limited-precision integers.
+
+2002-11-03  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* nclients.scm (file-lock-owner): Also check emacs-lock.
+	(word-lock:certificate): Name3 missing also triggered length
+	error.
+
+	* db2html.scm (crc:hash-obj): Added.
+
+	* slib.texi (Cyclic Checksum): Rewritten.
+
+	* Makefile (slib$(VERSION).info): Ignore makeinfo-4.1 bailing on
+	colons in names.
+
+	* crc.scm: Replaces makcrc.scm.
+
+2002-10-27  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (scene:viewpoint): Corrected translation/rotation
+	order.
+
+2002-10-14  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* DrScheme.init: Corrected mis-attribution
+
+2002-10-09  Aubrey Jaffer  <ajaffer@r3logic.com>
+
+	* pnm.scm (pnm:read-bit-vector!): Read pbm-raw correctly.
+
+2002-09-24  Aubrey Jaffer  <ajaffer@r3logic.com>
+
+	* pnm.scm (pnm:image-file->array): Correctly handle array type
+	when max-pixval > 256.
+
+2002-08-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* dbcom.scm (make-command-server): Handle lacking domain-checkers.
+
+2002-08-14  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* makcrc.scm (make-port-crc): Default based on number-size of
+	implementation.
+
+2002-07-22  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:divide-and-conquer): Limit p-lim of sub-diffs
+	to those computed at mid-a, mid-b.
+
+2002-07-19  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:divide-and-conquer): Rewrote edit-sequence and
+	longest common subsequence generation.
+
+2002-06-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* array.scm (create-array): Fixed scales calculation.
+
+2002-06-23  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* modular.scm (modular:normalize): Test (provided? 'bignum) once.
+
+2002-06-18  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (fp->lcs): Use argument array type for returned
+	array.
+
+2002-06-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Parsing HTML): Added.
+
+2002-06-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* html4each.scm: HTML scan calls procedures for word, tag,
+	whitespac, and newline.
+
+2002-05-31  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* nclients.scm (file=?): Added.
+
+2002-05-30  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* chez.init (*features*): random is not.
+
+2002-05-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (net-clients): Updated.
+
+	* nclients.scm (file-lock-owner, file-lock!, file-unlock!,
+	system->line): Added.
+
+2002-05-27  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* nclients.scm (call-with-replacement-file): Added emacs-aware
+	procedure to read-modify-write file.
+
+	* slib.texi (Vicinity): Clarified make-vicinity.
+
+2002-05-18  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Command Example): Corrected.
+
+	* cvs.scm (cvs-repository): Added.
+	(cvs-set-root!, cvs-vet): Rewritten to handle absolute paths in
+	CVS/Repository files.
+
+2002-05-16  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* cvs.scm (cvs:vet): Added CVS structure checker.
+
+2002-05-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:edits): Return array of signed integers.
+	Broke functions into schlepable chunks;	reorganized functions.
+
+2002-05-08  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (diff:make-differ): Abstracted operations.
+
+2002-05-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* differ.scm (fp->edits): Was forgetting some first deletes.
+
+	* differ.scm (fp->edits): Fixed off-by-one; last delete was lost.
+	(diff:edit-length): Array fp was uninitialized.
+
+2002-05-02  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* cvs.scm (cvs-directories, cvs-root, cvs-set-root!): Added.
+
+	* require.scm (pathname->vicinity): Removed "Go up one level if
+	PATHNAME ends in a vicinity suffix" behavior.
+
+2002-04-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* htmlform.scm (html:head): Use second argument (backlink)
+	verbatim if it contains <H1>.
+
+2002-04-26  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* require.scm (pathname->vicinity): Added.
+
+	* slib.texi (Vicinity): Added pathname->vicinity.
+
+2002-04-24  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* db2html.scm (db->html-files): Fixed for #f argument DIR.
+
+2002-04-21  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* mitscheme.init (sort!): Accepts only vectors; set it to SORT.
+
+2002-04-18  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* http-cgi.scm (make-query-alist-command-server): Don't assume
+	query-alist is non-false.
+
+2002-04-18  Chris Hanson <cph@zurich.ai.mit.edu>
+
+	* mitscheme.init (char-code-limit, defmacro, *features*):
+	Corrected.
+
+2002-04-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* require.scm (software-type): Removed vestigal conversion from
+	msdos -> ms-dos.
+
+2002-04-17  Chris Hanson <cph@zurich.ai.mit.edu>
+
+	* mitscheme.init: Updated for versions 7.5 .. 7.7.
+
+2002-04-14  Aubrey Jaffer  <jaffer@aubrey.jaffer>
+
+	* require.scm (*SLIB-VERSION*): Bumped from 2d3 to 2d4.
+
+	* slib.texi (CVS): Added.
+
+	* batch.scm (*operating-system*): Renamed from *current-platform*.
+
+2002-04-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* batch.scm (batch:operating-system): Added.
+	(batch:write-header-comment): Take parms argument.
+	(batch:call-with-output-script): Corrected platform.
+
+2002-04-07  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Makefile (efiles): Added cvs.scm.
+
+	* mklibcat.scm (cvs): Added for cvs.scm.
+
+	* htmlform.scm (html:select, form:delimited): Added newlines.
+
+	* batch.scm (batch:platform): Handles cygwin unames.
+	(batch:call-with-output-script): /bin/rc is PLAN9 shell.
+
+	* cvs.scm: Functions to enumerate files under CVS control.
+
+2002-04-03  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* batch.scm (operating-system): Added plan9.
+
+2002-03-31  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colorspc.scm (spectrum->chromaticity,
+	temperature->chromaticity): Added.
+
+2002-03-30  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* require.scm (sub-vicinity): Support for PLAN9.
+
+	* nclients.scm (user-email-address, current-directory): PLAN9.
+
+2002-03-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Color Names, The Short List): Saturate replaces
+	hollasch.
+
+	* mklibcat.scm: Saturate color dictionary replaces hollasch.
+
+	* colornam.scm (load-rgb-txt): parses saturate dictionary.
+	(make-slib-color-name-db): Saturate dictionary replaces hollasch.
+
+	* saturate.txt: Saturated colors from "Approximate Colors on CIE
+	Chromaticity Diagram"
+
+	* resenecolours.txt: "dictionary", not "software".
+
+2002-03-20  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* comlist.scm (comlist:list-of??): Replaced calls to EVERY with
+	calls to COMLIST:EVERY.
+
+	* slib.texi (Spectra): Added new functions and constants.
+
+	* colorspc.scm (CIEXYZ:A, CIEXYZ:B, CIEXYZ:C, CIEXYZ:E): Added.
+	(CIEXYZ:D65): Derive from e-sRGB so (color->e-srgb 16 d65) works.
+	(chromaticity->whitepoint): Added.
+	(chromaticity->CIEXYZ): Normalize to 1=x+y+z.
+	(wavelength->chromaticity, wavelength->CIEXYZ): Added.
+
+2002-03-16  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Makefile (docfiles): Added recent schmooz-generated files.
+
+2002-03-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Color Names): Added resenecolours.txt license.
+
+	* Makefile (catalogs): Added scripts for 5 implementations.
+	(clrnamdb.scm): Tries up to 5 implementations.
+
+	* mklibcat.scm (catpath): Delete slibcat if exists.
+
+	* slib.spec (%post): Improved catalog-building scripts.
+	Make clrnamdb.scm.
+
+	* Makefile (gfiles): Added resenecolours.txt.
+	(clrnamdb.scm): Depends on colornam.scm.
+
+	* colornam.scm (load-rgb-txt): Added m4c to read resenecolours.txt
+	without "Resene " prefix.
+
+	* resenecolours.txt: Removed "Resene " prefix.
+
+2002-03-11  Karen Warman <Karen.Warman@rpl.co.nz>
+
+	* resenecolours.txt: (Citrine White): Supplied missing value.
+	(Copyright): Accepted license change to allow modifications.
+
+2002-03-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* db2html.scm (command:make-editable-table): require
+	database-commands.
+
+	* colornam.scm (load-rgb-txt): Made method names be symbols.
+
+2002-02-26  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Lists as sets): Corrected description of MEMBER-IF.
+	Improved example.
+
+2002-02-23  Bill Wood  <wtw@mathstar.com>
+
+	* format.scm (Iteration Directive): Modified iteration directive
+	code to respect configuration variables format:iteration-bounded
+	and format:max-iterations.
+	(Configuration Variables): Added format:iteration-bounded,
+	default #t, and format:max-iterations, default 100.
+
+	* fmtdoc.txi: Added documentation of changes and additions.
+
+2002-02-20  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Color): Added tags for Color nodes.
+
+	* guile.init (expt): Fixed (expt 2 -1).
+	(port?, call-with-open-ports): Added.
+
+2002-02-18  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Motivations): Removed to DBManifesto.html.
+
+	* bigloo.init, chez.init, elk.init, mitscheme.init, RScheme.init,
+	scheme2c.init, scheme48.init, scsh.init, STk.init, Template.scm,
+	vscm.init (home-vicinity): ELSE clause was missing.
+
+	* guile.init (home-vicinity): Case-sensitive case was hosing.
+
+2002-02-14  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* scheme48.init: (asin) is totally busted in Scheme-48-0.45.
+
+	* colorspc.scm (pi): Added.
+	(multiarg/and-): Required.
+	Scheme-48-0.45 chokes on 1e1.
+
+	* daylight.scm: Scheme-48-0.45 chokes on 1e1.
+	Quoted vectors.
+
+	* solid.scm: Scheme-48-0.45 chokes on 1e1.
+
+	* slib.texi (multiarg/and-): Fixed typo.
+
+2002-02-11  Aubrey Jaffer  <jaffer@aubrey.jaffer>
+
+	* require.scm (*SLIB-VERSION*): Bumped from 2d2 to 2d3.
+
+	* batch.scm (batch:write-header-comment): Include batch:platform
+	in message.
+
+2002-01-31  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* guile.init (create-array, Ac64, Ac32, Ar64, Ar32, As64, As32,
+	As16, As8, Au64, Au32, Au16, Au8, At1): Added new SLIB arrays.
+
+	* charplot.scm, differ.scm, pnm.scm, fft.scm: Changed to use
+	create-array.
+
+	* arraymap.scm (array-indexes):
+	* matfile.scm (matfile:read-matrix): Changed to use create-array.
+
+	* array.scm: (Ac64, Ac32, Ar64, Ar32, As64, As32, As16, As8,
+	Au64, Au32, Au16, Au8, At1): Added prototype makers.
+
+	* pnm.scm (pnm:image-file->uniform-array): Removed.
+	(pnm:array-write): Changed away from using *-uniform-*.
+
+2002-01-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* array.scm (create-array): 1-element fill only.
+
+2002-01-26  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* subarray.scm (subarray0, array-align): Added.
+
+	* slib.texi (Input/Output): Added call-with-open-ports, port?
+	(Installation): How to make color-name database.
+	(Byte): Added note about opening binary files.
+
+	* matfile.scm (matfile:read):
+	* tzfile.scm (tzfile:read):
+	* pnm.scm (pnm:type-dimensions, pnm:image-file->array):
+	(pnm:array-write): Converted to use CALL-WITH-OPEN-PORTS and
+	OPEN-FILE for binary files.
+
+	* *.init, Template.scm (call-with-open-ports, port?): Added.
+
+	* slib.texi (Color Names): Added Resene and Hollasch dictionaries.
+
+	* Makefile (clrnamdb.scm): Make using most portable method; "<".
+
+	* mklibcat.scm (hollasch, resene): Added color-name-dictionary
+	features.
+
+	* require.scm (require:require): Use feature name for
+	color-dictionary define.
+
+	* colornam.scm (make-slib-color-name-db): Added.
+
+	* dbutil.scm (open-database!): OK if database is already open for
+	writing.
+
+2002-01-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Input/Output): Open-file MODES argument now symbol.
+
+	* Template.scm, *.init (open-file): Modes argument now symbol.
+
+2002-01-23  Radey Shouman  <Shouman@ne.mediaone.net>
+
+	* subarray.scm (subarray): Trailing indices can now be elided, as
+	in the rautil.scm version.
+
+2002-01-22  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Input/Output): Changed procedures returning values to
+	@defun.
+
+	* mklibcat.scm (display*): Added to reduce code size.
+
+	* dbutil.scm (make-exchanger): Removed; now in *.init files.
+
+	* slib.texi (Miscellany): Renamed from Legacy.
+	Added make-exchanger, open-file, and close-port.
+
+	* guile.init (make-exchanger): Added.
+
+	* STk.init, vscm.init, umbscheme.init, t3.init, scsh.init,
+	scheme48.init, scheme2c.init, s48-0_57.init, pscheme.init,
+	mitscheme.init, macscheme.init, gambit.init, elk.init, chez.init,
+	bigloo.init, Template.scm, RScheme.init, DrScheme.init
+	(make-exchanger, open-file, close-port): Added.
+
+2002-01-21  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (direction->vrml-field): Corrected angle errors due to
+	having only one buggy viewer.
+	(scene:sun): FreeWRL-0.30 sun disappears even closer than lookat.
+
+2002-01-19  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Relational Database): Reorganized.
+	Feature `database-utilities' renamed `databases'.
+
+	* dbutil.scm (close-database, write-database, open-database,
+	open-database!, create-database): Changed errors to warnings.
+	Added (schmooz) documentation.
+
+	* slib.texi (Base Table): Added introduction.  Listed alist-table
+	and wb-table features.
+	(Database Utilities): Moved documentation to "dbutil.scm".
+
+	* dbutil.scm (mdbm:report): Added.
+	(open-database!, open-database, write-database, sync-database,
+	solidify-database, close-database): will accept database or
+	filename.
+	Rewrote using dynamic-wind to protect mdbm:*databases*.
+
+	* rdms.scm (close-database): Fixed return value.
+	(write-database, sync-database): Made conditional on MUTABLE.
+	(solidify-database): Added method to change mutable to unmutable.
+
+2002-01-18  Radey Shouman  <shouman@ne.mediaone.net>
+
+	* pnm.scm: Fixed pbm read for the case when 0 and 1 characters are
+	not separated by whitespace (Ghostscript does this).
+
+2002-01-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Database Utilities): Updated dbutil changes.
+
+	* dbutil.scm (close-database, sync-database, write-database): Added.
+	(create-database, open-database!, open-database): Rewritten to
+	support database sharing.
+
+2002-01-13  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* rdms.scm (filename): Added database method for retrieving.
+
+	* scsh.init, chez.init, bigloo.init, scheme2c.init
+	(scheme-implementation-home-page): Updated.
+
+2002-01-10  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Makefile (clrnamdb.scm): Added target to build resene
+	color-dictionary.
+
+	* require.scm (require:require): Added color-names loader.
+
+	* colornam.scm (load-dictionary, make-slib-color-db): Added.
+
+2002-01-08  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* determ.scm (matrix:inverse, matrix:product, transpose,
+	matrix->array, matrix->lists): Added.
+
+	* slib.texi (Matrix Algebra): Renamed from Determinant.
+	Schmooz documentation from determ.scm.
+
+	* array.scm (create-array): Default to vector for non-array
+	prototypes.
+
+2002-01-07  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colornam.scm (load-rgb-txt): Allows multiple names per color.
+	Added support for multi-lingual "color_names.txt".
+
+2002-01-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colorspc.scm (e-sRGB-log, e-sRGB-exp): Abstracted and corrected.
+	(CIEXYZ:D65, CIEXYZ:D50): Compute from CIE chromaticities.
+	(e-sRGB:from-matrix):
+	http://www.pima.net/standards/it10/PIMA7667/PIMA7667-2001.PDF
+	gives matrix identical to sRGB:from-matrix, but colors drift under
+	repeated conversions to and from CIEXYZ.  Instead use computed
+	inverse of e-sRGB:into-matrix.
+
+2002-01-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colorspc.scm (CIE:Y/Yn->L*, CIE:L*->Y/Yn): Abstracted CIE
+	luminance <-> lightness conversions.
+	(ab-log, ab-exp): Abstracted a*, b* nonlinearities.
+	(L*u*v*->CIEXYZ): Simplified.
+
+	* slib.texi (Spectra): Features cie1964, cie1931, and ciexyz.
+
+	* colorspc.scm (spectrum->XYZ, wavelength->XYZ): Require 'ciexyz.
+
+	* mklibcat.scm (cie1964, cie1931, spectral-tristimulus-values):
+	Added.
+
+	* require.scm (require:require): Added spectral-tristimulus-values
+	loader.
+
+	* cie1964.xyz: Added.
+
+2002-01-03  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (MAT-File Format): Added node.
+
+	* matfile.scm (matfile:read-matrix): Dispatch per binary format;
+	only IEEE currently.
+	Added schmooz documentation.
+
+2002-01-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* subarray.scm (subarray, array-trim): Added easier ways to make
+	subarrays.
+
+	* array.scm (array=?): Fixed example.
+
+	* charplot.scm (charplot:data->lists): Fixed for 1-dimensional
+	array.
+
+	* matfile.scm (bytes->double): Corrected mantissa scale.
+
+2001-12-21  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* matfile.scm: Added; reads MAT-File Format version 4 (MATLAB).
+
+2001-12-13  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* scainit.scm (syncase:sanity-check): Had too many ".scm" suffi.
+
+2001-12-12  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (scene:sphere): Major rewrite.  Now works, I think.
+
+	* daylight.scm (sunlight-spectrum): Added and debugged calculation
+	from http://www.cs.utah.edu/vissim/papers/sunsky/sunsky.pdf.
+
+	* colorspc.scm (xyY:normalize-colors): Added optional argument to
+	control luminence scaling.
+
+2001-12-11  Ivan Shmakov  <ivan@theory.dcn-asu.ru>
+
+	* s48-0_57.init (system): Removed code that set! system to #f.
+
+2001-12-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (light:ambient, light:directional, light:dispersion,
+	light:point, light:spot): Added light sources.
+
+	* slib.texi (Plotting): Updated documentation.
+
+2001-12-08  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* charplot.scm: Major cleanup; raster conversion replaced by array
+	of chars; y coordinate lists rendered with distinct characters.
+	(coordinate-extrema): Added; computes extrema for lists of
+	coordinates of any rank.
+	(histograph): Added.
+
+2001-12-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* Makefile ($(dvidir)slib.dvi): Depend on Schmoozed files.
+
+2001-12-04  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* charplot.scm (charplot:plot!): Accept lists for second
+	coordinates; plot all against first coordinates.
+
+	* colornam.scm (file->color-dictionary): Added format for data
+	from Resene spreadsheetd.
+
+	* colorspc.scm (xyY:normalize-colors): Added.
+
+	* daylight.scm: Added mathematical model of sky colors.
+
+2001-12-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* logical.scm (logical:integer-expt): Merged
+	logical:ipow-by-squaring into.
+
+	* modular.scm (mod, rem): Added Common-Lisp functions.
+	(modular:r, modular:expt): Removed dependence on logical package.
+
+2001-11-29  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (solid:pyramid): Added.
+
+2001-11-28  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (scene:panorama, scene:sphere): Added backgrounds.
+	(solid:cylinder, solid:disk, solid:cone): Added.
+	(solid:arrow): Rewritten in terms of solid primitives.
+
+2001-11-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (solid:texture): Added.
+	(vrml-append): Added; puts newlines between strings.
+
+	* colorspc.scm (chromaticity->CIEXYZ, spectrum->CIEXYZ,
+	temperature->CIEXYZ): Added; useful for making whitepoints.
+
+2001-11-24  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Database Utilities): Added description of
+	*base-table-implementations*.
+
+	* colornam.scm (load-rgb-txt): Added many data formats.  Internal
+	function parse-rgb-line clobbers itself with method the first time
+	a method works.
+
+	* colorspc.scm (spectrum->xyz): Now accepts vector (or list) and
+	bounds.  Now compensates for number of samples.
+	(blackbody-spectrum): Made public.  Takes optional SPAN argument.
+	(XYZ->xyY, xyY->XYZ): Corrected; it really is just Y.
+	(CIE:L*): Y->L* conversion abstracted into function.
+
+2001-11-23  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* charplot.scm (charplot:iplot!): Fixed 9-year old fencepost bug.
+	(charplot:iplot!): Coordinates standardized to lists, rather than
+	pairs.  PLOT will accept either.
+	(plot): Dispatches to plot! or plot-function!.
+	(plot-function): Added alias for plot.
+
+2001-11-17  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colornam.scm (load-rgb-txt): Added "order" index field.
+
+	* scsh.init, scheme48.init, scheme2c.init, mitscheme.init,
+	guile.init, elk.init, chez.init, bigloo.init, Template.scm,
+	STk.init, s48-0_57.init (home-vicinity):
+	Now assures trailing "/".
+
+	* colornam.scm (grey): Added X11 numbered greys.
+
+2001-11-17  Ivan Shmakov  <ivan@theory.dcn-asu.ru>
+
+	* scsh.init, scheme48.init, scheme2c.init, mitscheme.init,
+	guile.init, elk.init, chez.init, bigloo.init, Template.scm,
+	STk.init, s48-0_57.init (home-vicinity):
+	(getenv "HOME") Was evaluated at compile time, thus returning the
+	installer's home directory!  Instead, call when HOME-VICINITY is
+	called.
+
+	* dbcom.scm (add-command-tables): The argument of set-car!
+	function must be mutable, but (quote xxx) isn't in Scheme48.
+
+2001-11-16  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colornam.scm: Rewritten.
+
+	* slib.texi (Color Names): Moved to end of color section.
+
+	* alistab.scm (open-base): Check that first line starts with ";;".
+
+2001-11-15  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colornam.scm: Added.
+
+	* slib.texi (Database Utilities): Reorganized.
+	(Color Names): Added.
+
+	* alistab.scm: Put *SLIB-VERSION* in header.  Set
+	*base-table-implementations*.
+
+	* dbcom.scm: Split rdb command extensions from dbutil.scm.
+	(wrap-command-interface, add-command-tables): Added
+
+	* require.scm (*base-table-implementations*): Added.
+
+	* dbutil.scm (open-database!, open-database): Use
+	*base-table-implementations* to dispatch on db-file type.
+
+2001-11-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Bit-Twiddling): Added "Bit order and Lamination".
+	(Bit-Twiddling): Added "Gray code".
+
+	* logical.scm (bit-reverse integer->list list->integer
+	booleans->integer bitwise:laminate bitwise:delaminate): Added bit
+	order and lamination functions.
+
+	(integer->gray-code gray-code->integer gray-code<?  gray-code<=?
+	gray-code>?  gray-code>=?): Added Gray code functions.
+
+2001-11-07  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colorspc.scm (xRGB): Renamed from sRGBi.
+
+	* color.scm (CIEXYZ->color, RGB709->color, L*a*b*->color,
+	L*u*v*->color, L*C*h->color, sRGB->color, xRGB->color,
+	e-sRGB->color): Added.
+
+	* slib.texi: Fixed comparison function documentation.
+
+2001-11-04  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* color.scm (color->string, string->color): Added.
+	(color:L*u*v*, color:L*a*b*, color:L*C*h): White-point must be
+	XYZ.
+
+	* colorspc.scm (L*C*h->L*a*b*): Fixed angle polarity.
+
+2001-11-03  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* color.scm (color:white-point): Return default if no parameter.
+
+	* colorspc.scm (temperature->xyz): Optimized.
+
+	* solid.scm (solid:color): Hooked to use SLIB color data-type.
+
+	* slib.texi (Spectra): Replaced "White Point".  Groups procedures
+	for spectrum conversions.
+
+	* colorspc.scm (temperature->xyz, XYZ:normalize-colors): Added.
+
+2001-11-02  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colorspc.scm (XYZ->xyY, xyY->XYZ): Added.
+
+2001-11-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colorspc.scm (XYZ->chromaticity): Added.
+	(wavelength->xyz): Added.
+
+2001-10-31  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* color.scm (color->L*C*h): Added.
+	(color->L*u*v*, color->L*a*b*): Fixed white-point arguments.
+	(color:RGB709, color:CIEXYZ): Relaxed bounds 0.001.
+	(color:white-point): Depends on color:encoding.
+
+	* colorspc.scm (L*a*b*->L*C*h): Normalize angle positive.
+
+2001-10-21  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* getparam.scm (getopt-barf): Replace calls to slib:warn with
+	lines written to current-error-port; to dovetail better with the
+	call to parameter-list->getopt-usage immediately after.
+
+2001-10-14  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* nclients.scm (ftp-upload): Removed (to docupage).
+
+	* prec.scm (tok:bump-column, prec:parse): Fluid-let prec:token
+	whenever *prec:port* is.
+
+2001-10-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* cie1931.xyz: Added.
+
+	* color.scm: Reorganized documentation.
+
+	* colorspc.scm (read-ciexyz!, spectrum->xyz): Added.
+
+2001-10-09  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
+
+	* guile.init (guile:wrap-case-insensitive): Simplified.
+
+2001-10-07  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* color.scm: Color data type supporting CIEXYZ, RGB709, sRGB,
+	e-sRGB, L*a*b*, L*u*v*, and L*C*h.
+	Added smooze documentation.
+	(color-white-point): Fixed wrapping.
+
+	* colorspc.scm (CMC:DE): CMC:DE is designed only for small
+	color-differences.  But try to do something reasonable for large
+	differences.  Use bisector (h*) of the hue angles if separated by
+	less than 90.o; otherwise, pick h of the color with larger C*.
+	(e-sRGB:into-matrix): Fixed missing '-'.
+	Moved error checking to "color.scm".
+
+2001-10-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colorspc.scm (CIE:DE, CIE:DE*94, CMC:DE): Added color difference
+	metrics.
+
+	* slib.texi (Color Spaces): Section added.
+
+	* colorspc.scm (e-sRGB->e-sRGB): Added.
+	(CIE:DE, CIE:DE*94): Color difference functions added.
+	Input range checking added to most functions.
+
+2001-09-25  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* strsrch.scm (string-index, string-index-ci,
+	string-reverse-index, string-reverse-index-ci): Optimized.
+
+2001-09-23  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* guile.init: Replaces guile/ice-9/slib.scm.
+	(array-indexes, array-copy!, copy-bit, bit-field, copy-bit-field):
+	Added missing procedures.
+	(slib:load, read): Wrapped with guile:wrap-case-insensitive;
+	fixes symbol-case problems.
+
+	* logical.scm (bitwise-if): Was missing.
+
+	* array.scm (create-array): Added function allowing transparent
+	support for uniform-arrays.
+	(make-array): Defined in terms of create-array.
+
+2001-09-22  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* array.scm (array-shape): Fixed confusion with array:shape.
+
+2001-09-12  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (Color Spaces): Documentation for colorspc.scm.
+
+	* tek41.scm, tek40.scm: Removed very old modules not in catalog.
+
+2001-09-11  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* strcase.scm (StudlyCapsExpand): Added.
+
+2001-09-09  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* colorspc.scm: Added -- CIE, sRGB, e-sRGB color-space transforms.
+
+	* solid.scm (solid:rotation): Added.
+
+2001-09-06  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (solid:sphere, solid:spheroid, solid:center-row-of,
+	solid:center-array-of, solid:center-pile-of): Added.
+
+2001-09-05  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm (solid:color, solid:scale, solid:box): Generalized and
+	documented.
+
+2001-09-04  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* solid.scm: Added VRML97 solid-modeling package.
+
+	* pnm.scm, nclients.scm, htmlform.scm: Use \\n (not \n) for
+	#\newline in printf strings.
+
+2001-09-01  Aubrey Jaffer  <agj@alum.mit.edu>
+
+	* slib.texi (RnRS): Added subsection.
+
+	* null.scm: Added.
+
+	* Makefile (revfiles): Added "null.scm"
+
+	* mklibcat.scm: Added support for AGGREGATE.
+	(r2rs, r3rs, r4rs, r5rs): Added aggregate features.
+
+	* require.scm (require:require): Added AGGREGATE *catalog* format.
+
+	* slib.texi (Library Catalogs): Added AGGREGATE *catalog* format.
+
 Fri Jul 27 19:54:00 EDT 2001  Aubrey Jaffer  <jaffer@aubrey.jaffer>
 
 	* require.scm (*SLIB-VERSION*): Bumped from 2d1 to 2d2.
@@ -692,7 +2755,7 @@ Sun Sep 12 22:45:01 EDT 1999  Aubrey Jaffer  <jaffer@ai.mit.edu>
 
 1999-06-05  Radey Shouman  <Radey_Shouman@splashtech.com>
 
-	* glob.scm (glob:substitute??): (glob:substitute-ci??): Now accept
+	* glob.scm (glob:substitute??, glob:substitute-ci??): Now accept
 	a procedure or string as template argument, for more general
 	transformations.
 
@@ -793,7 +2856,7 @@ Sun Sep 12 22:45:01 EDT 1999  Aubrey Jaffer  <jaffer@ai.mit.edu>
 1999-02-25  Radey Shouman  <Radey_Shouman@splashtech.com>
 
 	* printf.scm (stdio:iprintf): Fixed bug in %f format,
-	(printf	"%.1f" 0.001) printed "0", now prints "0.0"
+	(printf "%.1f" 0.001) printed "0", now prints "0.0"
 
 1999-02-12  Hakan L. Younes <d93-hyo@nada.kth.se>
 
@@ -913,7 +2976,7 @@ Sun Jan 17 12:33:31 EST 1999  Aubrey Jaffer  <jaffer@ai.mit.edu>
 	* glob.scm (glob:make-substituter): Made to handle cases where
 	PATTERN and TEMPLATE have different numbers of literal sections.
 
-	* glob.scm (glob:pattern->tokens): (glob:make-matcher):
+	* glob.scm (glob:pattern->tokens, glob:make-matcher):
 	(glob:make-substituter): Fixed to accept null strings as literals
 	to match, for REPLACE-SUFFIX.  There is no way to write a glob
 	pattern that produces such a token, should there be?
@@ -1672,7 +3735,7 @@ Wed Aug 21 20:38:26 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
 Fri Jul 19 11:24:45 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
 
 	* structure.scm scaoutp.scm scamacr.scm scainit.scm scaglob.scm
-        scaexpp.scm: Added missing copyright notice and terms.
+	scaexpp.scm: Added missing copyright notice and terms.
 
 Thu Jul 18 17:37:14 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
 
@@ -1929,7 +3992,7 @@ Mon Jan  2 10:26:45 1995  Aubrey Jaffer  (jaffer@jacal)
 
 	* comlist.scm (comlist:atom?): renamed from comlist:atom.
 
-	* scheme48.init	(char->integer integer->char): Now use integers in
+	* scheme48.init (char->integer integer->char): Now use integers in
 	the range 0 to 255.  Fixed several other problems.
 	(modulo): Worked around negative modulo bug.
 
@@ -1949,8 +4012,8 @@ Mon Jan  2 10:26:45 1995  Aubrey Jaffer  (jaffer@jacal)
 Thu Dec 22 13:28:16 1994  Aubrey Jaffer  (jaffer@jacal)
 
 	* dbutil.scm (open-database! open-database create-database): This
-        enhancement wraps a utility layer on `relational-database' which
-        provides:
+	enhancement wraps a utility layer on `relational-database' which
+	provides:
 	  * Automatic loading of the appropriate base-table package when
 	    opening a database.
 	  * Automatic execution of initialization commands stored in
@@ -2245,7 +4308,7 @@ Thu Feb 17 01:19:47 1994  Aubrey Jaffer  (jaffer@jacal)
 Wed Feb 16 12:44:34 1994  Aubrey Jaffer  (jaffer@jacal)
 
 	From: dorai@cs.rice.edu (Dorai Sitaram)
-	* mbe.scm: Macro by Example define-syntax using	defmacro.
+	* mbe.scm: Macro by Example define-syntax using defmacro.
 
 Tue Feb 15 17:18:56 1994  Aubrey Jaffer  (jaffer@jacal)
 
diff --git a/DrScheme.init b/DrScheme.init
index 0676250..9942897 100644
--- a/DrScheme.init
+++ b/DrScheme.init
@@ -1,6 +1,59 @@
 ;;;"DrScheme.init" Initialization for SLIB for DrScheme	-*-scheme-*-
-;;  Friedrich Dominicus <frido@q-software-solutions.com>
-;;  Newsgroups: comp.lang.scheme
-;;  Date: 02 Oct 2000 09:24:57 +0200
+;;; Author: Aubrey Jaffer
+;;;
+;;; This code is in the public domain.
 
-(require-library "init.ss" "slibinit")
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r rb) (open-input-file filename))
+    ((w wb) (open-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+;;(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+(define (close-port port)
+  (cond ((input-port? port)
+	 (close-input-port port)
+	 (if (output-port? port) (close-output-port port)))
+	((output-port? port) (close-output-port port))
+	(else (slib:error 'close-port 'port? port))))
+
+(define (browse-url url)
+  (define (try cmd end) (zero? (system (string-append cmd url end))))
+  (or (try "netscape-remote -remote 'openURL(" ")'")
+      (try "netscape -remote 'openURL(" ")'")
+      (try "netscape '" "'&")
+      (try "netscape '" "'")))
+
+(cond ((string<? (version) "200")
+       (require-library "init.ss" "slibinit"))
+      (else
+       (load (build-path (collection-path "slibinit") "init.ss"))
+       (eval '(require (lib "defmacro.ss")))
+       (slib:provide 'defmacro)))
+
+;;;The rest corrects mistakes in
+;;;/usr/local/lib/plt/collects/slibinit/init.ss:
+
+(provide 'fluid-let)
+
+(define slib:warn
+  (lambda args
+    (let ((cep (current-error-port)))
+      (if (provided? 'trace) (print-call-stack cep))
+      (display "Warn: " cep)
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
+
+(define call-with-input-string
+  (lambda (string thunk)
+    (parameterize ((current-input-port (open-input-string string)))
+      (thunk (current-input-port)))))
diff --git a/FAQ b/FAQ
index 93f94da..3a428a5 100644
--- a/FAQ
+++ b/FAQ
@@ -1,4 +1,4 @@
-FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib2d2).
+FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib3a1).
 Written by Aubrey Jaffer (http://swissnet.ai.mit.edu/~jaffer).
 
 		INTRODUCTION AND GENERAL INFORMATION
@@ -14,9 +14,9 @@ Scheme is a programming language in the Lisp family.
 
 []	Which implementations has SLIB been ported to?
 
-SLIB is supported by Bigloo, Chez, DrScheme, ELK, GAMBIT, MacScheme,
-MITScheme, PocketScheme, RScheme Scheme->C, Scheme48, SCM, SCSH, T3.1,
-UMB-Scheme, and VSCM.
+SLIB supports Bigloo, Chez, ELK, GAMBIT, Guile, MacScheme, MITScheme,
+PLT Scheme (DrScheme and MzScheme), Pocket Scheme, RScheme, scheme->C,
+Scheme48, SCM, SCM Mac, scsh, Stk, T3.1, umb-scheme, and VSCM.
 
 []	How can I obtain SLIB?
 
@@ -25,8 +25,6 @@ SLIB is available via http from:
 SLIB is available via ftp from:
  swissnet.ai.mit.edu:/pub/scm/
 
-SLIB is also included with SCM floppy disks.
-
 []	How do I install SLIB?
 
 Read the INSTALLATION INSTRUCTIONS in "slib/README".
@@ -48,7 +46,7 @@ Several times a year.
 
 []	What is the latest version?
 
-The version as of this writing is slib2d2.  The latest documentation
+The version as of this writing is slib3a1.  The latest documentation
 is available online at:
  http://swissnet.ai.mit.edu/~jaffer/SLIB.html
 
@@ -132,6 +130,17 @@ I find that I only type require statements at top level when
 debugging.  I put require statements in my Scheme files so that the
 appropriate modules are loaded automatically.
 
+[]      What happened to FORMAT?
+
+In order for FORMAT to call itself for FORMAT error messages, the
+original author made its code non-reentrant.  For that reason and the
+reasons below, FORMAT was removed; I saw little evidence of anyone
+using it.
+
+If someone fixes FORMAT, I will put it back into SLIB.  The last
+versions of FORMAT are in "format.scm", "formatst.scm", and
+"fmtdoc.txi" in http://swissnet.ai.mit.edu/ftpdir/scm/OLD/slib2d5.zip
+
 []	Why does SLIB have PRINTF when it already has the more
 	powerful (CommonLisp) FORMAT?
 
diff --git a/Makefile b/Makefile
index 3a1d5fc..2251d10 100644
--- a/Makefile
+++ b/Makefile
@@ -9,146 +9,214 @@ intro:
 	@echo "Welcome to SLIB.  Read \"README\" and \"slib.info\" (or"
 	@echo "\"slib.texi\") to learn how to install and use SLIB."
 	@echo
-	@echo
 	-make slib.info
 
 include srcdir.mk
 srcdir.mk: .. Makefile
 	echo -e "srcdir = `pwd`/\n" > srcdir.mk
 #srcdir=$(HOME)/slib/
-PREVDOCS = prevdocs/
-dvidir=../dvi/
-dvi:	$(dvidir)slib.dvi
-$(dvidir)slib.dvi:	version.txi slib.texi $(dvidir)slib.fn schmooz.texi
-#	cd $(dvidir);export TEXINPUTS=$(srcdir):;texi2dvi $(srcdir)slib.texi
-	-(cd $(dvidir);export TEXINPUTS=$(srcdir):;texindex slib.??)
-	cd $(dvidir);export TEXINPUTS=$(srcdir):;tex $(srcdir)slib.texi
-$(dvidir)slib.fn:
-	cd $(dvidir);export TEXINPUTS=$(srcdir):;tex $(srcdir)slib.texi \
-	$(srcdir)schmooz.texi
-xdvi:	$(dvidir)slib.dvi
-	xdvi -s 6 $(dvidir)slib.dvi
-htmldir=../public_html/
-slib_toc.html:	version.txi slib.texi htmlform.txi schmooz.texi
-	texi2html -split -verbose slib.texi
 
-pdf:	$(htmldir)slib.pdf
-$(htmldir)slib.pdf:	version.txi slib.texi $(dvidir)slib.fn schmooz.texi
-#	cd $(dvidir);dvipdf slib.dvi # doesn't have links!
-	cd $(dvidir);export TEXINPUTS=$(srcdir):;pdftex $(srcdir)slib.texi
-	mv $(dvidir)slib.pdf $(htmldir)
-xpdf:	$(htmldir)slib.pdf
-	xpdf -z 3 $(htmldir)slib.pdf
-
-html:	$(htmldir)slib_toc.html
-$(htmldir)slib_toc.html:	slib_toc.html Makefile
-	hitch $(PREVDOCS)slib_\*.html slib_\*.html $(htmldir)
+VERSION = 3a1
+RELEASE = 1
 
 rpm_prefix=/usr/src/redhat/
-
 prefix = debian/tmp/usr
 exec_prefix = $(prefix)
-bindir = $(exec_prefix)/bin
-libdir = $(exec_prefix)/lib
-infodir = $(exec_prefix)/info
+# directory where `make install' will put executable.
+bindir = $(exec_prefix)bin/
+libdir = $(exec_prefix)lib/
+infodir = $(prefix)info/
+
+PREVDOCS = prevdocs/
+
+htmldir=slib_html/
+dvidir=../dvi/
+
 RUNNABLE = scheme48
-LIB = $(libdir)/$(RUNNABLE)
+LIB = $(libdir)$(RUNNABLE)/
 VM = scheme48vm
 IMAGE = slib.image
 INSTALL_DATA = install -c
 
-$(LIB)/slibcat:
-	touch $(LIB)/slibcat
+$(LIB)slibcat:
+	touch $(LIB)slibcat
+
+catalogs:
+	-if type scm; then scm -c "(require 'new-catalog)"; fi
+	-if type guile; then guile -l guile.init -c\
+	  "(use-modules (ice-9 slib)) (require 'new-catalog)"; fi
+	-if type umb-scheme; then export SCHEME_INIT=umbscheme.init;\
+	  echo "(require 'new-catalog)" | umb-scheme; fi
+	-if type mzscheme; then export SCHEME_LIBRARY_PATH=`pwd`/;\
+	  mzscheme -g -f DrScheme.init -e "(require 'new-catalog)" </dev/null; fi
+	-if type scheme48; then make install48; fi
+
+MKNMDB = (require 'color-database) (make-slib-color-name-db) (slib:exit)
+clrnamdb: clrnamdb.scm
+clrnamdb.scm:  mkclrnam.scm Makefile
+	if type scm; then scm -e"$(MKNMDB)";\
+	elif type guile; then guile -l guile.init -c\
+	 "(use-modules (ice-9 slib)) $(MKNMDB)";\
+	elif type slib48; then echo -e "$(MKNMDB)\n,exit" | slib48 -h 3000000;\
+	elif type umb-scheme; then export SCHEME_INIT=`pwd`/umbscheme.init;\
+	 echo "$(MKNMDB)" | umb-scheme;\
+	elif type mzscheme; then export SCHEME_LIBRARY_PATH=`pwd`/;\
+	 echo "$(MKNMDB)" | mzscheme -f DrScheme.init;\
+	fi
 
 slib48:	$(IMAGE)
 $(IMAGE):	Makefile scheme48.init
 	export S48_VERSION="`echo ,exit | scheme48 | sed -n 's/Welcome to Scheme 48 //;s/ ([^)]*)[.]//;p;q'`";\
-	export S48_VICINITY="$(LIB)/";\
+	export S48_VICINITY="$(LIB)";\
 	export SCHEME_LIBRARY_PATH="`pwd`/";\
 	scheme48 < scheme48.init
 install48:	$(IMAGE)
 	$(INSTALL_DATA) $(IMAGE) $(LIB)
-	(echo '#!/bin/sh';\
-	 echo exec $(RUNNABLE) -i '$(LIB)/$(IMAGE)' \"\$$\@\") \
-	  > $(bindir)/slib48
-	chmod +x $(bindir)/slib48
+	(echo '#! /bin/sh';\
+	 echo exec $(RUNNABLE) -i '$(LIB)$(IMAGE)' \"\$$\@\") \
+	  > $(bindir)slib48
+	chmod +x $(bindir)slib48
+
+install:
+	test -d $(bindir) || mkdir $(bindir)
+	echo '#! /bin/sh'			 > $(bindir)slib
+	echo export SCHEME_LIBRARY_PATH=$(libdir)slib/	>> $(bindir)slib
+	echo VERSION=$(VERSION)			>> $(bindir)slib
+	cat slib.sh				>> $(bindir)slib
+	chmod +x $(bindir)slib
 
 #### Stuff for maintaining SLIB below ####
 
-VERSION = 2d2
 ver = $(VERSION)
 version.txi:	Makefile
-	echo @set SLIBVERSION $(VERSION) > version.txi
+	echo @set SLIBVERSION $(ver) > version.txi
 	echo @set SLIBDATE `date +"%B %Y"` >> version.txi
 
-scheme = scm
+scheme = guile-1.6
 
-htmlform.txi:	 *.scm
-	$(scheme) -rschmooz -e'(schmooz "slib.texi")'
-slib.info:	version.txi slib.texi htmlform.txi objdoc.txi schmooz.texi
-	makeinfo slib.texi --no-split -o slib.info
-	mv slib.info slib$(VERSION).info
-	if [ -f $(PREVDOCS)slib.info ];\
-		then infobar $(PREVDOCS)slib.info slib$(VERSION).info slib.info;\
-		else cp slib$(VERSION).info slib.info;fi
-info:	installinfo
-installinfo:	$(infodir)/slib.info
-$(infodir)/slib.info:	slib.info
-	cp -a slib.info $(infodir)/slib.info
-	-install-info $(infodir)/slib.info $(infodir)/dir
-	-rm $(infodir)/slib.info.gz
-infoz:	installinfoz
-installinfoz:	$(infodir)/slib.info.gz
-$(infodir)/slib.info.gz:	$(infodir)/slib.info
-	gzip -f $(infodir)/slib.info
-
-ffiles = printf.scm format.scm genwrite.scm obj2str.scm pp.scm \
-	ppfile.scm strcase.scm debug.scm trace.scm lineio.scm \
-	strport.scm scanf.scm chap.scm qp.scm break.scm stdio.scm \
-	strsrch.scm prec.scm schmooz.scm differ.scm
-lfiles = sort.scm comlist.scm tree.scm logical.scm random.scm tsort.scm \
-	coerce.scm
+collect.sc:
+	echo "(require 'macros-that-work)" > collect.sc
+	echo "(require 'pprint-file)" >> collect.sc
+	echo "(require 'yasos)" >> collect.sc
+	echo "(pprint-filter-file \"collect.scm\" macwork:expand \"collectx.scm\")" >> collect.sc
+	echo "(slib:exit #t)" >> collect.sc
+
+collectx.scm: collect.scm macwork.scm collect.sc
+	$(scheme) < collect.sc
+
+ffiles = printf.scm genwrite.scm pp.scm format.scm \
+	ppfile.scm strcase.scm debug.scm trace.scm \
+	strport.scm scanf.scm qp.scm break.scm stdio.scm \
+	strsrch.scm prec.scm schmooz.scm defmacex.scm mbe.scm
+lfiles = sort.scm comlist.scm logical.scm
 revfiles = sc4opt.scm sc4sc3.scm sc2.scm mularg.scm mulapply.scm \
-	trnscrpt.scm withfile.scm dynwind.scm promise.scm values.scm \
-	eval.scm
-afiles = ratize.scm randinex.scm modular.scm factor.scm \
-	 charplot.scm root.scm minimize.scm cring.scm determ.scm \
+	trnscrpt.scm withfile.scm dynwind.scm promise.scm \
+	values.scm eval.scm null.scm
+afiles = charplot.scm root.scm cring.scm \
 	 selfset.scm psxtime.scm cltime.scm timezone.scm tzfile.scm
-bfiles = collect.scm fluidlet.scm object.scm recobj.scm yasyn.scm
+bfiles = fluidlet.scm object.scm recobj.scm yasyn.scm collect.scm collectx.scm
 scfiles = r4rsyn.scm scmacro.scm synclo.scm synrul.scm synchk.scm \
 	repl.scm macwork.scm mwexpand.scm mwdenote.scm mwsynrul.scm
 scafiles = scainit.scm scaglob.scm scamacr.scm scaoutp.scm scaexpp.scm \
 	structure.scm
-dfiles = defmacex.scm mbe.scm srfi.scm
-srfiles = srfi-1.scm
-efiles = record.scm dynamic.scm queue.scm process.scm \
-	priorque.scm hash.scm hashtab.scm alist.scm \
-	wttree.scm wttest.scm array.scm arraymap.scm \
-	sierpinski.scm soundex.scm byte.scm nclients.scm pnm.scm \
-	simetrix.scm
-rfiles = rdms.scm alistab.scm dbutil.scm paramlst.scm report.scm \
-	batch.scm makcrc.scm dbrowse.scm comparse.scm getopt.scm \
-	htmlform.scm db2html.scm http-cgi.scm getparam.scm glob.scm \
-	fft.scm uri.scm
-gfiles = tek40.scm tek41.scm
-docfiles = ANNOUNCE README COPYING FAQ slib.info slib.texi schmooz.texi	\
-	 ChangeLog coerce.txi lineio.txi nclients.txi factor.txi minimize.txi \
-	 obj2str.txi randinex.txi random.txi uri.txi db2html.txi \
-	 htmlform.txi http-cgi.txi version.txi fmtdoc.txi objdoc.txi
-mfiles = Makefile require.scm Template.scm syncase.sh mklibcat.scm \
-	Bev2slib.scm slib.spec
+srfiles = srfi-9.scm
+efiles = record.scm dynamic.scm process.scm hash.scm \
+	wttree.scm wttest.scm sierpinski.scm soundex.scm simetrix.scm
+rfiles = rdms.scm alistab.scm paramlst.scm \
+	batch.scm crc.scm dbrowse.scm getopt.scm dbinterp.scm \
+	dbcom.scm dbsyn.scm
+gfiles = colorspc.scm cie1931.xyz cie1964.xyz resenecolours.txt saturate.txt
+
+txiscms =grapheps.scm glob.scm getparam.scm \
+	vet.scm top-refs.scm hashtab.scm chap.scm comparse.scm\
+	alist.scm ratize.scm modular.scm dirs.scm priorque.scm queue.scm\
+	srfi.scm srfi-1.scm srfi-2.scm srfi-8.scm\
+	pnm.scm http-cgi.scm htmlform.scm html4each.scm db2html.scm uri.scm\
+	fft.scm solid.scm random.scm randinex.scm obj2str.scm ncbi-dna.scm\
+	minimize.scm factor.scm determ.scm daylight.scm colornam.scm\
+	mkclrnam.scm color.scm subarray.scm dbutil.scm array.scm transact.scm\
+	arraymap.scm phil-spc.scm lineio.scm differ.scm cvs.scm tree.scm\
+	coerce.scm byte.scm bytenumb.scm matfile.scm tsort.scm manifest.scm
+txifiles =grapheps.txi glob.txi getparam.txi\
+	vet.txi top-refs.txi hashtab.txi chap.txi comparse.txi\
+	alist.txi ratize.txi modular.txi dirs.txi priorque.txi queue.txi\
+	srfi.txi srfi-1.txi srfi-2.txi srfi-8.txi\
+	pnm.txi http-cgi.txi htmlform.txi html4each.txi db2html.txi uri.txi\
+	fft.txi solid.txi random.txi randinex.txi obj2str.txi ncbi-dna.txi\
+	minimize.txi factor.txi determ.txi daylight.txi colornam.txi\
+	mkclrnam.txi color.txi subarray.txi dbutil.txi array.txi transact.txi\
+	arraymap.txi phil-spc.txi lineio.txi differ.txi cvs.txi tree.txi\
+	coerce.txi byte.txi bytenumb.txi matfile.txi tsort.txi manifest.txi
+% = `echo $(txiscms) | sed 's%.scm%.txi%g'`
+
+docfiles = ANNOUNCE README COPYING FAQ slib.info slib.texi schmooz.texi\
+	 ChangeLog version.txi object.texi $(txifiles)
+mkfiles = Makefile require.scm Template.scm syncase.sh mklibcat.scm \
+	Bev2slib.scm slib.spec slib.sh grapheps.ps
 ifiles = bigloo.init chez.init elk.init macscheme.init mitscheme.init \
 	scheme2c.init scheme48.init s48-0_57.init gambit.init t3.init \
 	vscm.init scm.init scsh.init pscheme.init STk.init \
 	RScheme.init DrScheme.init umbscheme.init guile.init
-tfiles = plottest.scm formatst.scm macrotst.scm	dwindtst.scm
+tfiles = plottest.scm macrotst.scm dwindtst.scm formatst.scm
 sfiles = $(ffiles) $(lfiles) $(revfiles) $(afiles) $(scfiles) $(efiles) \
-	$(rfiles) $(gfiles) $(scafiles) $(dfiles) $(srfiles)
-allfiles = $(docfiles) $(mfiles) $(ifiles) $(sfiles) $(tfiles) $(bfiles)
+	$(rfiles) $(gfiles) $(scafiles) $(txiscms) $(srfiles)
+allfiles = $(docfiles) $(mkfiles) $(ifiles) $(sfiles) $(tfiles) $(bfiles)
+
+$(txifiles):	$(txiscms) schmooz.scm
+	$(scheme) -l guile.init.local -c '(require '\''schmooz) (schmooz "slib.texi")'
+
+dvi:	$(dvidir)slib.dvi
+$(dvidir)slib.dvi:	version.txi slib.texi $(dvidir)slib.fn \
+		$(txifiles) object.texi schmooz.texi
+#	cd $(dvidir);export TEXINPUTS=$(srcdir):;texi2dvi $(srcdir)slib.texi
+	-(cd $(dvidir);export TEXINPUTS=$(srcdir):;texindex slib.??)
+	cd $(dvidir);export TEXINPUTS=$(srcdir):;tex $(srcdir)slib.texi
+$(dvidir)slib.fn:
+	cd $(dvidir);export TEXINPUTS=$(srcdir):;tex $(srcdir)slib.texi \
+	$(srcdir)schmooz.texi
+xdvi:	$(dvidir)slib.dvi
+	xdvi -s 3 $(dvidir)slib.dvi
+
+pdf:	$(htmldir)slib.pdf
+$(htmldir)slib.pdf:	version.txi slib.texi $(dvidir)slib.fn schmooz.texi
+#	cd $(dvidir);dvipdf slib.dvi # doesn't have links!
+	cd $(dvidir);export TEXINPUTS=$(srcdir):;pdftex $(srcdir)slib.texi
+	mv $(dvidir)slib.pdf $(htmldir)
+xpdf:	$(htmldir)slib.pdf
+	xpdf -z 3 $(htmldir)slib.pdf
+
+TEXI2HTML = texi2html -split chapter -verbose
+slib_toc.html:	$(txifiles) version.txi slib.texi schmooz.texi
+	${TEXI2HTML} slib.texi
+html:	$(htmldir)slib_toc.html
+$(htmldir)slib_toc.html:	slib_toc.html Makefile
+	-rm -f slib_stoc.html
+	if [ -f $(PREVDOCS)slib_toc.html ]; \
+		then hitch $(PREVDOCS)slib_\*.html slib_\*.html $(htmldir); \
+		else mkdir -p $(htmldir) ; cp slib_*.html $(htmldir);fi
+
+slib$(VERSION).info:	$(txifiles) version.txi slib.texi schmooz.texi
+	makeinfo slib.texi --no-warn --no-split -o slib.info
+	mv slib.info slib$(VERSION).info
+slib.info:	slib$(VERSION).info
+	if [ -f $(PREVDOCS)slib.info ];\
+		then infobar $(PREVDOCS)slib.info slib$(VERSION).info slib.info;\
+		else cp slib$(VERSION).info slib.info;fi
+info:	installinfo
+installinfo:	$(infodir)slib.info
+$(infodir)slib.info:	slib.info
+	cp -a slib.info $(infodir)slib.info
+	-install-info $(infodir)slib.info $(infodir)dir
+	-rm $(infodir)slib.info.gz
+infoz:	installinfoz
+installinfoz:	$(infodir)slib.info.gz
+$(infodir)slib.info.gz:	$(infodir)slib.info
+	gzip -f $(infodir)slib.info
 
 makedev = make -f $(HOME)/makefile.dev
 CHPAT=$(HOME)/bin/chpat
 RSYNC=rsync -avessh
+UPLOADEE=swissnet_upload
 dest = $(HOME)/dist/
 temp/slib:	$(allfiles)
 	-rm -rf temp
@@ -162,27 +230,29 @@ infotemp/slib:	slib.info
 	mkdir infotemp/slib
 	ln slib.info slib.info-* infotemp/slib
 #For change-barred HTML.
-prevdocs:	srcdir.mk Makefile
-	cd prevdocs; unzip -a $(dest)slib*.zip
-	rm prevdocs/slib/slib.info
-	cd prevdocs/slib; make slib.info; make slib_toc.html
-	cd prevdocs; mv -f slib/slib.info slib/*.html ./
-	rm -rf prevdocs/slib
+$(PREVDOCS)slib_toc.html:
+$(PREVDOCS)slib.info:	srcdir.mk Makefile
+	cd $(PREVDOCS); unzip -ao $(dest)slib*.zip
+	rm $(PREVDOCS)slib/slib.info
+	cd $(PREVDOCS)slib; make slib.info; make slib_toc.html
+	cd $(PREVDOCS); mv -f slib/slib.info slib/*.html ./
+	rm -rf $(PREVDOCS)slib
 
 distinfo:	$(dest)slib.info.zip
 $(dest)slib.info.zip:	infotemp/slib
 	$(makedev) TEMP=infotemp/ DEST=$(dest) PROD=slib ver=.info zip
 	rm -rf infotemp
 
-release:	dist rpm
+release:	dist pdf tar.gz	# rpm
 	cvs tag -F slib$(VERSION)
 	cp ANNOUNCE $(htmldir)SLIB_ANNOUNCE.txt
 	cp COPYING  $(htmldir)SLIB_COPYING.txt
 	$(RSYNC) $(htmldir)SLIB.html $(htmldir)SLIB_ANNOUNCE.txt \
-	 $(htmldir)SLIB_COPYING.txt nestle.ai.mit.edu:public_html/
+	 $(htmldir)SLIB_COPYING.txt $(UPLOADEE):public_html/
 	$(RSYNC) $(dest)README $(dest)slib$(VERSION).zip \
-	 $(dest)slib-$(VERSION)-1.noarch.rpm\
-	$(dest)slib-$(VERSION)-1.src.rpm nestle.ai.mit.edu:dist/
+	 $(dest)slib$(VERSION).tar.gz $(htmldir)slib.pdf \
+	 $(dest)slib-$(VERSION)-$(RELEASE).noarch.rpm \
+	 $(dest)slib-$(VERSION)-$(RELEASE).src.rpm $(UPLOADEE):dist/
 #	upload $(dest)README $(dest)slib$(VERSION).zip ftp.gnu.org:gnu/jacal/
 #	$(MAKE) indiana
 indiana:
@@ -195,23 +265,27 @@ indiana:
 postnews:
 	echo -e "Newsgroups: comp.lang.scheme\n" | cat - ANNOUNCE | \
 	inews -h -O -S \
-	-f "announce@docupress.com (Aubrey Jaffer & Radey Shouman)" \
+	-f "announce@voluntocracy.org (Aubrey Jaffer & Radey Shouman)" \
 	 -t "SLIB$(VERSION) Released" -d world
 
 upzip:	$(HOME)/pub/slib.zip
-	$(RSYNC) $(HOME)/pub/slib.zip nestle.ai.mit.edu:pub/
+	$(RSYNC) $(HOME)/pub/slib.zip $(UPLOADEE):pub/
 
 dist:	$(dest)slib$(VERSION).zip
 $(dest)slib$(VERSION).zip:	temp/slib
 	$(makedev) DEST=$(dest) PROD=slib ver=$(VERSION) zip
 
+tar.gz:	$(dest)slib$(VERSION).tar.gz
+$(dest)slib$(VERSION).tar.gz:	temp/slib
+	$(makedev) DEST=$(dest) PROD=slib ver=$(VERSION) tar.gz
+
 rpm:	pubzip
-#$(dest)slib-$(VERSION)-1.noarch.rpm:	$(dest)slib$(VERSION).zip
+#$(dest)slib-$(VERSION)-$(RELEASE).noarch.rpm:	$(dest)slib$(VERSION).zip
 	cp $(HOME)/pub/slib.zip $(rpm_prefix)SOURCES/slib$(VERSION).zip
 	rpm -ba slib.spec	# --clean
 	rm $(rpm_prefix)SOURCES/slib$(VERSION).zip
-	mv $(rpm_prefix)RPMS/noarch/slib-$(VERSION)-1.noarch.rpm \
-	   $(rpm_prefix)SRPMS/slib-$(VERSION)-1.src.rpm $(dest)
+	mv $(rpm_prefix)RPMS/noarch/slib-$(VERSION)-$(RELEASE).noarch.rpm \
+	   $(rpm_prefix)SRPMS/slib-$(VERSION)-$(RELEASE).src.rpm $(dest)
 
 shar:	slib.shar
 slib.shar:	temp/slib
@@ -222,7 +296,7 @@ slib.com:	temp/slib
 	$(makedev) PROD=slib com
 zip:	slib.zip
 slib.zip:	temp/slib
-	$(makedev) PROD=slib zip
+	$(makedev) DEST=../ PROD=slib zip
 doszip:	/c/scm/dist/slib$(VERSION).zip
 /c/scm/dist/slib$(VERSION).zip:	temp/slib
 	$(makedev) DEST=/c/scm/dist/ PROD=slib ver=$(VERSION) zip
@@ -256,7 +330,7 @@ $(dest)slib-psd.tar.gz:	psdtemp/slib
 	$(makedev) DEST=$(dest) PROD=slib ver=-psd tar.gz TEMP=psdtemp/
 
 new:
-	echo `date` \ Aubrey Jaffer \ \<`whoami`@`hostname`\>> change
+	echo `date -I` \ Aubrey Jaffer \ \<`whoami`@`hostname`\>> change
 	echo>> change
 	echo \	\* require.scm \(*SLIB-VERSION*\): Bumped from $(VERSION) to $(ver).>>change
 	echo>> change
@@ -267,7 +341,7 @@ new:
 		../synch/ANNOUNCE \
 		$(htmldir)README.html ../dist/README \
 		$(htmldir)JACAL.html \
-		$(htmldir)SCM.html $(htmldir)Hobbit.html \
+		$(htmldir)SCM.html \
 		$(htmldir)SIMSYNCH.html ../scm/scm.texi \
 		/c/scm/dist/install.bat /c/scm/dist/makefile \
 		/c/scm/dist/mkdisk.bat
@@ -276,7 +350,7 @@ new:
 		../synch/ANNOUNCE \
 		$(htmldir)README.html ../dist/README \
 		$(htmldir)JACAL.html \
-		$(htmldir)SCM.html $(htmldir)Hobbit.html \
+		$(htmldir)SCM.html \
 		$(htmldir)SIMSYNCH.html ../scm/scm.texi \
 		/c/scm/dist/install.bat /c/scm/dist/makefile \
 		/c/scm/dist/mkdisk.bat
@@ -285,23 +359,25 @@ new:
 	cvs commit -lm '(*SLIB-VERSION*): Bumped from $(VERSION) to $(ver).'
 	cvs tag -lF slib$(ver)
 
-tagfiles = version.txi slib.texi $(mfiles) $(sfiles) $(bfiles) $(tfiles) \
-	$(ifiles)
+tagfiles = README version.txi slib.texi \
+	$(mkfiles) $(sfiles) $(bfiles) $(tfiles) $(ifiles)
 # README and $(ifiles) cause semgentation faults in ETAGS for Emacs version 19.
 tags:	$(tagfiles)
 	etags $(tagfiles)
 test:	$(sfiles)
-	scheme Template.scm $(sfiles)
+	$(scheme) Template.scm $(sfiles)
 rights:
-	scm -ladmin -e"(admin:check-all)" $(sfiles) $(tfiles) \
+	$(scheme) -ladmin -e"(admin:check-all)" $(sfiles) $(tfiles) \
 		$(bfiles) $(ifiles)
 report:
-	scmlit -e"(slib:report #t)"
-	scm -e"(slib:report #t)"
+	$(scheme) -e"(slib:report #t)"
 clean:
 	-rm -f *~ *.bak *.orig *.rej core a.out *.o \#*
 	-rm -rf *temp
 	-rm -f slib$(VERSION).info
+	-rm -f version.txi
+	-rm -rf $(htmldir)
+	echo $(scheme) -l guile.init.local -c '(require '\''schmooz) (schmooz-which-files "slib.texi")'
 
 distclean:	realclean
 realclean:
diff --git a/README b/README
index 8d4d31d..1443e0e 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-This directory contains the distribution of Scheme Library slib2d2.
+This directory contains the distribution of Scheme Library slib3a1.
 Slib conforms to Revised^5 Report on the Algorithmic Language Scheme
 and the IEEE P1178 specification.  Slib supports Unix and similar
 systems, VMS, and MS-DOS.
@@ -8,8 +8,8 @@ The maintainer can be reached at agj @ alum.mit.edu.
 
 			       MANIFEST
 
-  `README' is this file.  It contains a MANIFEST, INSTALLATION
-	INSTRUCTIONS, and coding guidelines.
+  `README' is this file.  It contains a MANIFEST and INSTALLATION
+	INSTRUCTIONS.
   `FAQ' Frequently Asked Questions and answers.
   `ChangeLog' documents changes to slib.
   `slib.texi' has documentation on library packages in TexInfo format.
@@ -19,7 +19,7 @@ The maintainer can be reached at agj @ alum.mit.edu.
   `bigloo.init' is a configuration file for Bigloo.
   `chez.init' is a configuration file for Chez Scheme.
   `DrScheme.init' is a configuration file for DrScheme.
-  `elk.init' is a configuration file for ELK 2.1
+  `elk.init' is a configuration file for ELK 3.0.
   `gambit.init' is a configuration file for Gambit Scheme.
   `macscheme.init' is a configuration file for MacScheme.
   `mitscheme.init' is a configuration file for MIT Scheme.
@@ -32,16 +32,15 @@ The maintainer can be reached at agj @ alum.mit.edu.
   `scm.init' is a configuration file for SCM.
   `t3.init' is a configuration file for T3.1 in Scheme mode.
   `STk.init' is a configuration file for STk.
-  `umbscheme.init' is a configuration file for umb-scheme.  
+  `umbscheme.init' is a configuration file for umb-scheme.
   `vscm.init' is a configuration file for VSCM.
   `guile.init' is a configuration file for guile.
   `mklibcat.scm' builds the *catalog* cache.
   `require.scm' has code which allows system independent access to
 	the library files.
 
+  `slib.sh' is a shell script for running various Schemes with SLIB.
   `Bev2slib.scm' Converts Stephen Bevan's "*.map" files to SLIB catalog entries.
-  `format.scm' has Common-Lisp style format.
-  `formatst.scm' has code to test format.scm
   `pp.scm' has pretty-print.
   `ppfile.scm' has pprint-file and pprint-filter-file.
   `obj2str.scm' has object->string.
@@ -63,6 +62,7 @@ The maintainer can be reached at agj @ alum.mit.edu.
   `hash.scm' defines hash, hashq, and hashv.
   `hashtab.scm' has hash tables.
   `sierpinski.scm' 2-dimensional coordinate hash.
+  `phil-spc.scm' Peano-Hilbert Space-Filling Curve.
   `soundex.scm' English name hash.
   `logical.scm' emulates 2's complement logical operations.
   `random.scm' has random number generator compatible with Common Lisp.
@@ -75,10 +75,19 @@ The maintainer can be reached at agj @ alum.mit.edu.
   `selfset.scm' sets single letter identifiers to their symbols.
   `determ.scm' compute determinant of list of lists.
   `charplot.scm' has procedure for plotting on character screens.
+  `grapheps.scm' has procedures for creating PostScript graphs.
+  `grapheps.ps' is PostScript runtime support for creating graphs.
+  `matfile.scm' reads MAT-File Format version 4 (MATLAB).
   `plottest.scm' has code to test charplot.scm.
-  `tek40.scm' has routines for Tektronix 4000 series graphics.
-  `tek41.scm' has routines for Tektronix 4100 series graphics.
-  `getopt.scm' has posix-like getopt for parsing command line arguments. 
+  `solid.scm' has VRML97 solid-modeling.
+  `colorspc.scm' has CIE and sRGB color transforms.
+  `colornam.scm' has color-name database functions.
+  `mkclrnam.scm' creates color-name databases.
+  `color.scm' has color data-type.
+  `cie1931.xyz' CIE XYZ(1931) Spectra from 380.nm to 780.nm.
+  `cie1964.xyz' CIE XYZ(1964) Spectra from 380.nm to 780.nm.
+  `daylight.scm' Model of sky colors.
+  `getopt.scm' has posix-like getopt for parsing command line arguments.
   `psxtime.scm' has Posix time conversion routines.
   `cltime.scm' has Common-Lisp time conversion routines.
   `timezone.scm' has the default time-zone, UTC.
@@ -88,23 +97,29 @@ The maintainer can be reached at agj @ alum.mit.edu.
   `rdms.scm' has code to construct a relational database from a base
 	table implementation.
   `alistab.scm' has association list base tables.
-  `dbutil.scm' has utilities for creating and manipulating relational
+  `dbutil.scm' has procedures for creating and opening relational
 	databases.
+  `dbsyn.scm' has Syntactic extensions for RDMS (within-database).
+  `dbcom.scm' embeds *commands* in relational databases.
+  `dbinterp.scm' Interpolate function from database table.
   `htmlform.scm' generates HTML-3.2 with forms.
   `db2html.scm' convert relational database to hyperlinked tables and
 	pages.
   `http-cgi.scm' serves WWW pages with HTTP or CGI.
+  `html4each.scm' parses HTML files.
+  `dirs.scm' maps over directory filenames.
   `uri.scm' encodes and decodes Uniform Resource Identifiers.
   `dbrowse.scm' browses relational databases.
   `paramlst.scm' has procedures for passing parameters by name.
   `getparam.scm' has procedures for converting getopt to parameters.
-  `report.scm' prints database reports.
+  `manifest.scm' List SLIB module requires and exports; useful for compiling.
+  `top-defs.scm' Finds external references.
+  `vet.scm' Checks each module imports, exports, and documentation.
   `schmooz.scm' is a simple, lightweight markup language for
 	interspersing Texinfo documentation with Scheme source code.
   `glob.scm' has filename matching and manipulation.
   `batch.scm' Group and execute commands on various operating systems.
-  `makcrc.scm' Create Scheme procedure to calculate POSIX.2 checksums
-	or other CRCs.
+  `crc.scm' Calculate POSIX.2 checksums and other CRCs.
 
   `record.scm' a MITScheme user-definable datatypes package
   `promise.scm' has code from R4RS for supporting DELAY and FORCE.
@@ -134,7 +149,8 @@ The maintainer can be reached at agj @ alum.mit.edu.
   `wttree.scm' has weight-balanced trees.
   `wttest.scm' tests weight-balanced trees.
   `process.scm' has multi-processing primitives.
-  `array.scm' has multi-dimensional arrays and sub-arrays.
+  `array.scm' has multi-dimensional arrays.
+  `subarray.scm' has subarray and accessory procedures.
   `arraymap.scm' has array-map!, array-for-each, and array-indexes.
 
   `sort.scm' has sorted?, sort, sort!, merge, and merge!.
@@ -147,7 +163,7 @@ The maintainer can be reached at agj @ alum.mit.edu.
 
   `sc4opt.scm' has optional rev4 procedures.
   `sc4sc3.scm' has procedures to make a rev3 implementation run rev4
-	code. 
+	code.
   `sc2.scm' has rev2 procedures eliminated in subsequent versions.
   `mularg.scm' redefines - and / to take more than 2 arguments.
   `mulapply.scm' redefines apply to take more than 2 arguments.
@@ -161,9 +177,11 @@ The maintainer can be reached at agj @ alum.mit.edu.
   `fluidlet.scm' has fluid-let syntax.
   `structure.scm' has undocumented syntax-case macros.
   `byte.scm' has arrays of small integers.
-  `nclients.scm' provides a Scheme interface to FTP and WWW Browsers.
+  `bytenumb.scm' convert byte-arrays to integers; IEEE floating-point numbers.
+  `transact.scm' File locking and backup.
   `pnm.scm' provides a Scheme interface to "portable bitmap" files.
   `simetrix.scm' provides SI Metric Interchange Format.
+  `ncbi-dna.scm' reads and manipulates DNA and protein sequences.
   `srfi.scm' implements Scheme Request for Implementation.
   `srfi-N.scm' implements srfi-N.
 
@@ -237,6 +255,13 @@ when installing SLIB.
 
      (require 'new-catalog)
 
+  The catalog also supports color-name dictionaries.  With an
+SLIB-installed scheme implementation, type:
+     (require 'color-names)
+     (make-slib-color-name-db)
+     (require 'new-catalog)
+     (slib:exit)
+
 Implementation-specific Instructions
 ------------------------------------
 
@@ -293,7 +318,7 @@ as outlined above.
      To use SLIB in MzScheme, set the SCHEME_LIBRARY_PATH environment
      variable to the installed SLIB location; then invoke MzScheme thus:
 
-     `mzscheme -L init.ss slibinit'
+     `mzscheme -f ${SCHEME_LIBRARY_PATH}DrScheme.init'
 
  - Implementation: MIT Scheme
      `scheme -load ${SCHEME_LIBRARY_PATH}mitscheme.init'
@@ -326,27 +351,14 @@ library will then be accessible in a system independent fashion.
   Please mail new working configuration files to `agj @ alum.mit.edu' so
 that they can be included in the SLIB distribution.
 
-			  CODING GUIDELINES
+			      USING SLIB
 
-  All library packages are written in IEEE P1178 Scheme and assume that
-a configuration file and `require.scm' package have already been
+  All library packages are written in IEEE P1178 Scheme and assume
+that a configuration file and `require.scm' package have already been
 loaded.  Other versions of Scheme can be supported in library packages
-as well by using, for example, `(provided? 'rev3-report)' or `(require
-'rev3-report)'.
-
-  `require.scm' defines `*catalog*', an association list of module
-names and filenames.  When a new package is added to the library, an
-entry should be added to `require.scm'.  Local packages can also be
-added to `*catalog*' and even shadow entries already in the table.
-
-  The module name and `:' should prefix each symbol defined in the
-package.  Definitions for external use should then be exported by having
-`(define foo module-name:foo)'.
+as well by using, for example, `(provided? 'r3rs)' or `(require 'r3rs)'.
 
-  Submitted packages should not duplicate routines which are already in
-SLIB files.  Use `require' to force those features to be supported in
-your package.  Care should be taken that there are no circularities in
-the `require's and `load's between the library packages.
+The first chapter of the SLIB manual "The Library System" explains the
+mechanics of using SLIB modules.
 
-  Documentation should be provided in Emacs Texinfo format if possible,
-But documentation must be provided.
+	      http://swissnet.ai.mit.edu/~jaffer/slib_1
diff --git a/RScheme.init b/RScheme.init
index c03119c..b9a7d84 100644
--- a/RScheme.init
+++ b/RScheme.init
@@ -54,6 +54,19 @@
 	    (else "")))))
     (lambda () library-path)))
 
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+(define (home-vicinity)
+  (let ((home (getenv "HOME")))
+    (and home
+	 (case (software-type)
+	   ((UNIX COHERENT MS-DOS)	;V7 unix has a / on HOME
+	    (if (eqv? #\/ (string-ref home (+ -1 (string-length home))))
+		home
+		(string-append home "/")))
+	   (else home)))))
+
 ;;; *FEATURES* should be set to a list of symbols describing features
 ;;; of this implementation.  Suggestions for features are:
 
@@ -66,7 +79,7 @@
 
 		       ;; Scheme report features
 
-;	rev5-report			;conforms to
+;	r5rs				;conforms to
 ;	eval				;R5RS two-argument eval
 ;	values				;R5RS multiple values
 ;	dynamic-wind			;R5RS dynamic-wind
@@ -80,11 +93,11 @@
 					;STRING-FILL!, LIST->VECTOR,
 					;VECTOR->LIST, and VECTOR-FILL!
 
-	rev4-report			;conforms to
+	r4rs				;conforms to
 
 	ieee-p1178			;conforms to
 
-;	rev3-report			;conforms to
+;	r3rs				;conforms to
 
 ;	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
 					;SUBSTRING-MOVE-RIGHT!,
@@ -95,7 +108,7 @@
 
 	multiarg/and-			;/ and - can take more than 2 args.
 	with-file			;has WITH-INPUT-FROM-FILE and
-					;WITH-OUTPUT-FROM-FILE
+					;WITH-OUTPUT-TO-FILE
 ;	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 ;	ieee-floating-point		;conforms to IEEE Standard 754-1985
 					;IEEE Standard for Binary
@@ -160,6 +173,33 @@
 ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
 ;;; port versions of CALL-WITH-*PUT-FILE.
 
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r rb) (open-input-file filename))
+    ((w wb) (open-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+(define (close-port port)
+  (cond ((input-port? port)
+	 (close-input-port port)
+	 (if (output-port? port) (close-output-port port)))
+	((output-port? port) (close-output-port port))
+	(else (slib:error 'close-port 'port? port))))
+
+(define (browse-url url)
+  (slib:warn "define BROWSE-URL in macscheme.init"))
+
 ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
 ;;; be returned by CHAR->INTEGER.
 (define char-code-limit 65536)
@@ -232,7 +272,7 @@
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Warn: " cep)
-      (for-each (lambda (x) (display x cep)) args))))
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
 
 ;;; define an error procedure for the library
 (define (slib:error msg . args)
diff --git a/STk.init b/STk.init
index b4f256d..97edf81 100644
--- a/STk.init
+++ b/STk.init
@@ -7,35 +7,29 @@
 
 ;;; (software-type) should be set to the generic operating system type.
 ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
-
 (define (software-type) 'UNIX)
 
 ;;; (scheme-implementation-type) should return the name of the scheme
 ;;; implementation loading this file.
-
 (define (scheme-implementation-type) '|STk|)
 
 ;;; (scheme-implementation-home-page) should return a (string) URI
 ;;; (Uniform Resource Identifier) for this scheme implementation's home
 ;;; page; or false if there isn't one.
-
 (define (scheme-implementation-home-page)
   "http://kaolin.unice.fr/STk/STk.html")
 
 ;;; (scheme-implementation-version) should return a string describing
 ;;; the version the scheme implementation loading this file.
-
 (define (scheme-implementation-version) (version))
 
 ;;; (implementation-vicinity) should be defined to be the pathname of
 ;;; the directory where any auxillary files to your Scheme
 ;;; implementation reside.
-
 (define (implementation-vicinity) "/usr/local/lib/stk/3.99.3/")
 
 ;;; (library-vicinity) should be defined to be the pathname of the
 ;;; directory where files of Scheme library functions reside.
-
 (define library-vicinity
   (let ((library-path (or (getenv "SCHEME_LIBRARY_PATH") "/usr/local/lib/slib/")))
     (lambda () library-path)))
@@ -44,14 +38,18 @@
 ;;; (home-vicinity) should return the vicinity of the user's HOME
 ;;; directory, the directory which typically contains files which
 ;;; customize a computer environment for a user.
-
-(define home-vicinity
-  (let ((home-path (or (getenv "HOME") "/")))
-    (lambda () home-path)))
+(define (home-vicinity)
+  (let ((home (getenv "HOME")))
+    (and home
+	 (case (software-type)
+	   ((UNIX COHERENT MS-DOS)	;V7 unix has a / on HOME
+	    (if (eqv? #\/ (string-ref home (+ -1 (string-length home))))
+		home
+		(string-append home "/")))
+	   (else home)))))
 
 ;;; *FEATURES* should be set to a list of symbols describing features
 ;;; of this implementation.  Suggestions for features are:
-
 (define *features*
       '(
 	source				;can load scheme source files
@@ -61,7 +59,7 @@
 
 		       ;; Scheme report features
 
-;	rev5-report			;conforms to
+;	r5rs				;conforms to
 	eval				;R5RS two-argument eval
 ;	values				;R5RS multiple values
 	dynamic-wind			;R5RS dynamic-wind
@@ -75,11 +73,11 @@
 					;STRING-FILL!, LIST->VECTOR,
 					;VECTOR->LIST, and VECTOR-FILL!
 
-	rev4-report			;conforms to
+	r4rs				;conforms to
 
 	ieee-p1178			;conforms to
 
-;	rev3-report			;conforms to
+;	r3rs				;conforms to
 
 ;	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
 					;SUBSTRING-MOVE-RIGHT!,
@@ -90,7 +88,7 @@
 
 	multiarg/and-			;/ and - can take more than 2 args.
 	with-file			;has WITH-INPUT-FROM-FILE and
-					;WITH-OUTPUT-FROM-FILE
+					;WITH-OUTPUT-TO-FILE
 ;	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 	ieee-floating-point		;conforms to IEEE Standard 754-1985
 					;IEEE Standard for Binary
@@ -141,6 +139,37 @@
 ;;; use this definition if your system doesn't have such a procedure.
 (define (force-output . arg) (apply flush arg))
 
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r rb) (open-input-file filename))
+    ((w wb) (open-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+(define (close-port port)
+  (cond ((input-port? port)
+	 (close-input-port port)
+	 (if (output-port? port) (close-output-port port)))
+	((output-port? port) (close-output-port port))
+	(else (slib:error 'close-port 'port? port))))
+
+(define (browse-url url)
+  (define (try cmd) (eqv? 0 (system (sprintf #f cmd url))))
+  (or (try "netscape-remote -remote 'openURL(%s)'")
+      (try "netscape -remote 'openURL(%s)'")
+      (try "netscape '%s'&")
+      (try "netscape '%s'")))
+
 ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
 ;;; be returned by CHAR->INTEGER.
 (define char-code-limit 256)
@@ -199,7 +228,7 @@
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Warn: " cep)
-      (for-each (lambda (x) (display x cep)) args))))
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
 
 ;;; define an error procedure for the library
 (define (slib:error . args)
@@ -230,13 +259,11 @@
 
 ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
 ;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
-
 (define slib:load-source LOAD)
 
 ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
 ;;; by compiling "foo.scm" if this implementation can compile files.
 ;;; See feature 'COMPILED.
-
 (define slib:load-compiled load)
 
 ;;;
diff --git a/Template.scm b/Template.scm
index 6421d92..63c10c9 100644
--- a/Template.scm
+++ b/Template.scm
@@ -3,40 +3,34 @@
 ;;;
 ;;; This code is in the public domain.
 
-;;; (software-type) should be set to the generic operating system type.
+;;@ (software-type) should be set to the generic operating system type.
 ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
-
 (define (software-type) 'UNIX)
 
-;;; (scheme-implementation-type) should return the name of the scheme
+;;@ (scheme-implementation-type) should return the name of the scheme
 ;;; implementation loading this file.
-
 (define (scheme-implementation-type) 'Template)
 
-;;; (scheme-implementation-home-page) should return a (string) URI
+;;@ (scheme-implementation-home-page) should return a (string) URI
 ;;; (Uniform Resource Identifier) for this scheme implementation's home
 ;;; page; or false if there isn't one.
-
 (define (scheme-implementation-home-page) #f)
 
-;;; (scheme-implementation-version) should return a string describing
+;;@ (scheme-implementation-version) should return a string describing
 ;;; the version the scheme implementation loading this file.
-
 (define (scheme-implementation-version) "?")
 
-;;; (implementation-vicinity) should be defined to be the pathname of
+;;@ (implementation-vicinity) should be defined to be the pathname of
 ;;; the directory where any auxillary files to your Scheme
 ;;; implementation reside.
-
 (define (implementation-vicinity)
   (case (software-type)
     ((UNIX)	"/usr/local/src/scheme/")
     ((VMS)	"scheme$src:")
     ((MS-DOS)	"C:\\scheme\\")))
 
-;;; (library-vicinity) should be defined to be the pathname of the
+;;@ (library-vicinity) should be defined to be the pathname of the
 ;;; directory where files of Scheme library functions reside.
-
 (define library-vicinity
   (let ((library-path
 	 (or
@@ -51,17 +45,21 @@
 	    (else "")))))
     (lambda () library-path)))
 
-;;; (home-vicinity) should return the vicinity of the user's HOME
+;;@ (home-vicinity) should return the vicinity of the user's HOME
 ;;; directory, the directory which typically contains files which
 ;;; customize a computer environment for a user.
-
-(define home-vicinity
-  (let ((home-path (getenv "HOME")))
-    (lambda () home-path)))
-
-;;; *FEATURES* should be set to a list of symbols describing features
+(define (home-vicinity)
+  (let ((home (getenv "HOME")))
+    (and home
+	 (case (software-type)
+	   ((UNIX COHERENT MS-DOS)	;V7 unix has a / on HOME
+	    (if (eqv? #\/ (string-ref home (+ -1 (string-length home))))
+		home
+		(string-append home "/")))
+	   (else home)))))
+
+;;@ *FEATURES* should be set to a list of symbols describing features
 ;;; of this implementation.  Suggestions for features are:
-
 (define *features*
       '(
 	source				;can load scheme source files
@@ -71,7 +69,7 @@
 
 		       ;; Scheme report features
 
-	rev5-report			;conforms to
+	r5rs				;conforms to
 	eval				;R5RS two-argument eval
 	values				;R5RS multiple values
 	dynamic-wind			;R5RS dynamic-wind
@@ -85,11 +83,11 @@
 					;STRING-FILL!, LIST->VECTOR,
 					;VECTOR->LIST, and VECTOR-FILL!
 
-	rev4-report			;conforms to
+	r4rs				;conforms to
 
 	ieee-p1178			;conforms to
 
-;	rev3-report			;conforms to
+;	r3rs				;conforms to
 
 ;	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
 					;SUBSTRING-MOVE-RIGHT!,
@@ -100,7 +98,7 @@
 
 ;	multiarg/and-			;/ and - can take more than 2 args.
 ;	with-file			;has WITH-INPUT-FROM-FILE and
-					;WITH-OUTPUT-FROM-FILE
+					;WITH-OUTPUT-TO-FILE
 ;	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 	ieee-floating-point		;conforms to IEEE Standard 754-1985
 					;IEEE Standard for Binary
@@ -133,66 +131,66 @@
 
 	))
 
-;;; (OUTPUT-PORT-WIDTH <port>)
+;;@ (OUTPUT-PORT-WIDTH <port>)
 (define (output-port-width . arg) 79)
 
-;;; (OUTPUT-PORT-HEIGHT <port>)
+;;@ (OUTPUT-PORT-HEIGHT <port>)
 (define (output-port-height . arg) 24)
 
-;;; (CURRENT-ERROR-PORT)
+;;@ (CURRENT-ERROR-PORT)
 (define current-error-port
   (let ((port (current-output-port)))
     (lambda () port)))
 
-;;; (TMPNAM) makes a temporary file name.
+;;@ (TMPNAM) makes a temporary file name.
 (define tmpnam (let ((cntr 100))
 		 (lambda () (set! cntr (+ 1 cntr))
 			 (string-append "slib_" (number->string cntr)))))
 
-;;; (FILE-EXISTS? <string>)
+;;@ (FILE-EXISTS? <string>)
 (define (file-exists? f) #f)
 
-;;; (DELETE-FILE <string>)
+;;@ (DELETE-FILE <string>)
 (define (delete-file f) #f)
 
-;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;@ FORCE-OUTPUT flushes any pending output on optional arg output port
 ;;; use this definition if your system doesn't have such a procedure.
 (define (force-output . arg) #t)
 
 ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
 ;;; port versions of CALL-WITH-*PUT-FILE.
 
-;;; "rationalize" adjunct procedures.
+;;@ "rationalize" adjunct procedures.
 ;;(define (find-ratio x e)
 ;;  (let ((rat (rationalize x e)))
 ;;    (list (numerator rat) (denominator rat))))
 ;;(define (find-ratio-between x y)
 ;;  (find-ratio (/ (+ x y) 2) (/ (- x y) 2)))
 
-;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;@ CHAR-CODE-LIMIT is one greater than the largest integer which can
 ;;; be returned by CHAR->INTEGER.
 (define char-code-limit 256)
 
-;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+;;@ MOST-POSITIVE-FIXNUM is used in modular.scm
 (define most-positive-fixnum #x0FFFFFFF)
 
-;;; Return argument
+;;@ Return argument
 (define (identity x) x)
 
-;;; SLIB:EVAL is single argument eval using the top-level (user) environment.
+;;@ SLIB:EVAL is single argument eval using the top-level (user) environment.
 (define slib:eval eval)
 
-;;; If your implementation provides R4RS macros:
+;; If your implementation provides R4RS macros:
 ;(define macro:eval slib:eval)
 ;(define macro:load load)
-
 (define *defmacros*
   (list (cons 'defmacro
 	      (lambda (name parms . body)
 		`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
 					 *defmacros*))))))
+;@
 (define (defmacro? m) (and (assq m *defmacros*) #t))
-
+;@
 (define (macroexpand-1 e)
   (if (pair? e)
       (let ((a (car e)))
@@ -200,7 +198,7 @@
 	       (if a (apply (cdr a) (cdr e)) e))
 	      (else e)))
       e))
-
+;@
 (define (macroexpand e)
   (if (pair? e)
       (let ((a (car e)))
@@ -209,7 +207,7 @@
 	       (if a (macroexpand (apply (cdr a) (cdr e))) e))
 	      (else e)))
       e))
-
+;@
 (define gentemp
   (let ((*gensym-counter* -1))
     (lambda ()
@@ -218,13 +216,15 @@
        (string-append "slib:G" (number->string *gensym-counter*))))))
 
 (define base:eval slib:eval)
+;@
 (define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+
 (define (defmacro:expand* x)
   (require 'defmacroexpand) (apply defmacro:expand* x '()))
-
+;@
 (define (defmacro:load <pathname>)
   (slib:eval-load <pathname> defmacro:eval))
-
+;@
 (define (slib:eval-load <pathname> evl)
   (if (not (file-exists? <pathname>))
       (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
@@ -236,61 +236,89 @@
 	    ((eof-object? o))
 	  (evl o))
 	(set! *load-pathname* old-load-pathname)))))
-
+;@
 (define slib:warn
   (lambda args
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Warn: " cep)
-      (for-each (lambda (x) (display x cep)) args))))
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
 
-;;; define an error procedure for the library
+;;@ define an error procedure for the library
 (define (slib:error . args)
   (if (provided? 'trace) (print-call-stack (current-error-port)))
   (apply error args))
-
-;;; define these as appropriate for your system.
+;@
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r rb) (open-input-file filename))
+    ((w wb) (open-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+(define (close-port port)
+  (cond ((input-port? port)
+	 (close-input-port port)
+	 (if (output-port? port) (close-output-port port)))
+	((output-port? port) (close-output-port port))
+	(else (slib:error 'close-port 'port? port))))
+;@
+(define (browse-url url)
+  (define (try cmd end) (zero? (system (string-append cmd url end))))
+  (or (try "netscape-remote -remote 'openURL(" ")'")
+      (try "netscape -remote 'openURL(" ")'")
+      (try "netscape '" "'&")
+      (try "netscape '" "'")))
+
+;;@ define these as appropriate for your system.
 (define slib:tab (integer->char 9))
 (define slib:form-feed (integer->char 12))
 
-;;; Support for older versions of Scheme.  Not enough code for its own file.
+;;@ Support for older versions of Scheme.  Not enough code for its own file.
 (define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l))
 (define t #t)
 (define nil #f)
 
-;;; Define these if your implementation's syntax can support it and if
+;;@ Define these if your implementation's syntax can support it and if
 ;;; they are not already defined.
-
 ;(define (1+ n) (+ n 1))
 ;(define (-1+ n) (+ n -1))
 ;(define 1- -1+)
 
+;@
 (define in-vicinity string-append)
 
-;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;@ Define SLIB:EXIT to be the implementation procedure to exit or
 ;;; return if exitting not supported.
 (define slib:exit (lambda args #f))
 
-;;; Here for backward compatability
+;;@ Here for backward compatability
 (define scheme-file-suffix
   (let ((suffix (case (software-type)
 		  ((NOSVE) "_scm")
 		  (else ".scm"))))
     (lambda () suffix)))
 
-;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;@ (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
 ;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
-
 (define (slib:load-source f) (load (string-append f ".scm")))
 
-;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;@ (SLIB:LOAD-COMPILED "foo") should load the file that was produced
 ;;; by compiling "foo.scm" if this implementation can compile files.
 ;;; See feature 'COMPILED.
-
 (define slib:load-compiled load)
 
-;;; At this point SLIB:LOAD must be able to load SLIB files.
-
+;;@ At this point SLIB:LOAD must be able to load SLIB files.
 (define slib:load slib:load-source)
 
 (slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/alist.scm b/alist.scm
index 5917c7c..f1bdd70 100644
--- a/alist.scm
+++ b/alist.scm
@@ -1,5 +1,5 @@
 ;;;"alist.scm", alist functions for Scheme.
-;;;Copyright (c) 1992, 1993 Aubrey Jaffer
+;;;Copyright (c) 1992, 1993, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -17,6 +17,23 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
+;;@code{(require 'alist)}
+;;@ftindex alist
+;;
+;;Alist functions provide utilities for treating a list of key-value pairs
+;;as an associative database.  These functions take an equality predicate,
+;;@var{pred}, as an argument.  This predicate should be repeatable,
+;;symmetric, and transitive.
+;;
+;;Alist functions can be used with a secondary index method such as hash
+;;tables for improved performance.
+
+;;@body
+;;Returns an @dfn{association function} (like @code{assq}, @code{assv}, or
+;;@code{assoc}) corresponding to @var{pred}.  The returned function
+;;returns a key-value pair whose key is @code{pred}-equal to its first
+;;argument or @code{#f} if no key in the alist is @var{pred}-equal to the
+;;first argument.
 (define (predicate->asso pred)
   (cond ((eq? eq? pred) assq)
 	((eq? = pred) assv)
@@ -30,12 +47,28 @@
 			((pred key (caar al)) (car al))
 			(else (l (cdr al)))))))))
 
+;;@body
+;;Returns a procedure of 2 arguments, @var{alist} and @var{key}, which
+;;returns the value associated with @var{key} in @var{alist} or @code{#f} if
+;;@var{key} does not appear in @var{alist}.
 (define (alist-inquirer pred)
   (let ((assofun (predicate->asso pred)))
     (lambda (alist key)
       (let ((pair (assofun key alist)))
 	(and pair (cdr pair))))))
 
+;;@body
+;;Returns a procedure of 3 arguments, @var{alist}, @var{key}, and
+;;@var{value}, which returns an alist with @var{key} and @var{value}
+;;associated.  Any previous value associated with @var{key} will be
+;;lost.  This returned procedure may or may not have side effects on its
+;;@var{alist} argument.  An example of correct usage is:
+;;
+;;@lisp
+;;(define put (alist-associator string-ci=?))
+;;(define alist '())
+;;(set! alist (put alist "Foo" 9))
+;;@end lisp
 (define (alist-associator pred)
   (let ((assofun (predicate->asso pred)))
     (lambda (alist key val)
@@ -44,6 +77,16 @@
 		    alist)
 	      (else (cons (cons key val) alist)))))))
 
+;;@body
+;;Returns a procedure of 2 arguments, @var{alist} and @var{key}, which
+;;returns an alist with an association whose @var{key} is key removed.
+;;This returned procedure may or may not have side effects on its
+;;@var{alist} argument.  An example of correct usage is:
+;;
+;;@lisp
+;;(define rem (alist-remover string-ci=?))
+;;(set! alist (rem alist "foo"))
+;;@end lisp
 (define (alist-remover pred)
   (lambda (alist key)
     (cond ((null? alist) alist)
@@ -58,9 +101,17 @@
 		    (set-cdr! al (cddr al)) alist)
 		   (else (l (cdr al)))))))))
 
+;;@body
+;;Returns a new association list formed by mapping @var{proc} over the
+;;keys and values of @var{alist}.   @var{proc} must be a function of 2
+;;arguments which returns the new value part.
 (define (alist-map proc alist)
   (map (lambda (pair) (cons (car pair) (proc (car pair) (cdr pair))))
        alist))
 
+;;@body
+;;Applies @var{proc} to each pair of keys and values of @var{alist}.
+;;@var{proc} must be a function of 2 arguments.  The returned value is
+;;unspecified.
 (define (alist-for-each proc alist)
   (for-each (lambda (pair) (proc (car pair) (cdr pair))) alist))
diff --git a/alist.txi b/alist.txi
new file mode 100644
index 0000000..804df8a
--- /dev/null
+++ b/alist.txi
@@ -0,0 +1,70 @@
+@code{(require 'alist)}
+@ftindex alist
+
+Alist functions provide utilities for treating a list of key-value pairs
+as an associative database.  These functions take an equality predicate,
+@var{pred}, as an argument.  This predicate should be repeatable,
+symmetric, and transitive.
+
+Alist functions can be used with a secondary index method such as hash
+tables for improved performance.
+
+
+@defun predicate->asso pred
+
+Returns an @dfn{association function} (like @code{assq}, @code{assv}, or
+@cindex association function
+@code{assoc}) corresponding to @var{pred}.  The returned function
+returns a key-value pair whose key is @code{pred}-equal to its first
+argument or @code{#f} if no key in the alist is @var{pred}-equal to the
+first argument.
+@end defun
+
+@defun alist-inquirer pred
+
+Returns a procedure of 2 arguments, @var{alist} and @var{key}, which
+returns the value associated with @var{key} in @var{alist} or @code{#f} if
+@var{key} does not appear in @var{alist}.
+@end defun
+
+@defun alist-associator pred
+
+Returns a procedure of 3 arguments, @var{alist}, @var{key}, and
+@var{value}, which returns an alist with @var{key} and @var{value}
+associated.  Any previous value associated with @var{key} will be
+lost.  This returned procedure may or may not have side effects on its
+@var{alist} argument.  An example of correct usage is:
+
+@lisp
+(define put (alist-associator string-ci=?))
+(define alist '())
+(set! alist (put alist "Foo" 9))
+@end lisp
+@end defun
+
+@defun alist-remover pred
+
+Returns a procedure of 2 arguments, @var{alist} and @var{key}, which
+returns an alist with an association whose @var{key} is key removed.
+This returned procedure may or may not have side effects on its
+@var{alist} argument.  An example of correct usage is:
+
+@lisp
+(define rem (alist-remover string-ci=?))
+(set! alist (rem alist "foo"))
+@end lisp
+@end defun
+
+@defun alist-map proc alist
+
+Returns a new association list formed by mapping @var{proc} over the
+keys and values of @var{alist}.   @var{proc} must be a function of 2
+arguments which returns the new value part.
+@end defun
+
+@defun alist-for-each proc alist
+
+Applies @var{proc} to each pair of keys and values of @var{alist}.
+@var{proc} must be a function of 2 arguments.  The returned value is
+unspecified.
+@end defun
diff --git a/alistab.scm b/alistab.scm
index e51bd26..e8999bf 100644
--- a/alistab.scm
+++ b/alistab.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -23,7 +23,9 @@
 ;;; ROW		is a list of non-primary VALUEs
 
 (require 'common-list-functions)
-
+(require 'relational-database)		;for make-relational-system
+(require-if 'compiling 'sort)
+;@
 (define alist-table
   (let ((catalog-id 0)
 	(resources '*base-resources*)
@@ -42,13 +44,15 @@
 	(list resources (list 'free-id 1))))
 
 (define (open-base infile writable)
-  (and (or (input-port? infile) (file-exists? infile))
-       (cons (if (input-port? infile) #f infile)
-	     ((lambda (fun)
-		(if (input-port? infile)
-		    (fun infile)
-		    (call-with-input-file infile fun)))
-	      read))))
+  (define (reader port)
+    (cond ((eof-object? port) #f)
+	  ((not (eqv? #\; (read-char port))) #f)
+	  ((not (eqv? #\; (read-char port))) #f)
+	  (else (cons (and (not (input-port? infile)) infile)
+		      (read port)))))
+  (cond ((input-port? infile) (reader infile))
+	((file-exists? infile) (call-with-input-file infile reader))
+	(else #f)))
 
 (define (write-base lldb outfile)
   ((lambda (fun)
@@ -57,7 +61,8 @@
 	   (else #f)))
    (lambda (port)
      (display (string-append
-	       ";;; \"" outfile "\" SLIB alist-table database	 -*-scheme-*-")
+	       ";;; \"" outfile "\" SLIB " *SLIB-VERSION*
+	       " alist-table database	 -*-scheme-*-")
 	      port)
      (newline port) (newline port)
      (display "(" port) (newline port)
@@ -303,12 +308,12 @@
 
 (define (supported-type? type)
   (case type
-    ((base-id atom integer boolean string symbol expression number) #t)
+    ((atom ordinal integer boolean string symbol expression number) #t)
     (else #f)))
 
 (define (supported-key-type? type)
   (case type
-    ((atom integer number symbol string) #t)
+    ((atom ordinal integer number symbol string) #t)
     (else #f)))
 
 ;;make-table open-table remover assoc* make-assoc*
@@ -349,4 +354,8 @@
 	(else #f)))
     ))
 
+(set! *base-table-implementations*
+      (cons (list 'alist-table (make-relational-system alist-table))
+	    *base-table-implementations*))
+
 ;; #f (trace-all "/home/jaffer/slib/alistab.scm") (untrace alist-table) (set! *qp-width* 333)
diff --git a/array.scm b/array.scm
index 47df853..417e137 100644
--- a/array.scm
+++ b/array.scm
@@ -1,5 +1,5 @@
 ;;;;"array.scm" Arrays for Scheme
-; Copyright (C) 2001 Aubrey Jaffer
+; Copyright (C) 2001, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -30,7 +30,12 @@
 		      store		;data
 		      )))
 
-(define array:shape (record-accessor array:rtd 'shape))
+(define array:shape
+  (let ((shape (record-accessor array:rtd 'shape)))
+    (lambda (array)
+      (cond ((vector? array) (list (list 0 (+ -1 (vector-length array)))))
+	    ((string? array) (list (list 0 (+ -1 (string-length array)))))
+	    (else (shape array))))))
 
 (define array:scales
   (let ((scales (record-accessor array:rtd 'scales)))
@@ -77,7 +82,8 @@
 ;;corresponding elements of @1 and @2 are @code{equal?}.
 ;;
 ;;@example
-;;(array=? (make-array 'foo 3 3) (make-array 'foo '(0 2) '(1 2)))
+;;(array=? (create-array '#(foo) 3 3)
+;;         (create-array '#(foo) '(0 2) '(0 2)))
 ;;  @result{} #t
 ;;@end example
 (define (array=? array1 array2)
@@ -87,17 +93,133 @@
 (define (array:dimensions->shape dims)
   (map (lambda (dim) (if (list? dim) dim (list 0 (+ -1 dim)))) dims))
 
-;;@args initial-value bound1 bound2 @dots{}
-;;Creates and returns an array with dimensions @var{bound1},
-;;@var{bound2}, @dots{} and filled with @1.
-(define (make-array initial-value . dimensions)
+;;@args prototype bound1 bound2 @dots{}
+;;
+;;Creates and returns an array of type @1 with dimensions @2, @3,
+;;@dots{} and filled with elements from @1.  @1 must be an array,
+;;vector, or string.  The implementation-dependent type of the returned
+;;array will be the same as the type of @1; except if that would be a
+;;vector or string with non-zero origin, in which case some variety of
+;;array will be returned.
+;;
+;;If the @1 has no elements, then the initial contents of the returned
+;;array are unspecified.  Otherwise, the returned array will be filled
+;;with the element at the origin of @1.
+(define (create-array prototype . dimensions)
+  (define range2length (lambda (bnd) (- 1 (apply - bnd))))
+  ;;(if (not (array? prototype)) (set! prototype (vector prototype)))
   (let* ((shape (array:dimensions->shape dimensions))
-	 (dims (map (lambda (bnd) (- 1 (apply - bnd))) shape))
-	 (scales (reverse (cons 1 (cdr (reverse dims))))))
-    (array:construct shape
-		     scales
-		     (- (apply + (map * (map car shape) scales)))
-		     (make-vector (apply * dims) initial-value))))
+	 (dims (map range2length shape))
+	 (scales
+	  (do ((dims (reverse (cdr dims)) (cdr dims))
+	       (scls '(1) (cons (* (car dims) (car scls)) scls)))
+	      ((null? dims) scls))))
+    (array:construct
+     shape
+     scales
+     (- (apply + (map * (map car shape) scales)))
+     (if (string? prototype)
+	 (case (string-length prototype)
+	   ((0) (make-string (apply * dims)))
+	   (else (make-string (apply * dims)
+			      (string-ref prototype 0))))
+	 (let ((pshape (array:shape prototype)))
+	   (case (apply * (map range2length pshape))
+	     ((0) (make-vector (apply * dims)))
+	     (else (make-vector (apply * dims)
+				(apply array-ref prototype
+				       (map car pshape))))))))))
+
+;;@noindent
+;;These functions return a prototypical uniform-array enclosing the
+;;optional argument (which must be of the correct type).  If the
+;;uniform-array type is supported by the implementation, then it is
+;;returned; defaulting to the next larger precision type; resorting
+;;finally to vector.
+
+(define (make-prototype-checker name pred? creator)
+  (lambda args
+    (case (length args)
+      ((1) (if (pred? (car args))
+	       (creator (car args))
+	       (slib:error name 'incompatible 'type (car args))))
+      ((0) (creator))
+      (else (slib:error name 'wrong 'number 'of 'args args)))))
+
+(define (integer-bytes?? n)
+  (lambda (obj)
+    (and (integer? obj)
+	 (exact? obj)
+	 (or (negative? n) (not (negative? obj)))
+	 (do ((num obj (quotient num 256))
+	      (n (+ -1 (abs n)) (+ -1 n)))
+	     ((or (zero? num) (negative? n))
+	      (zero? num))))))
+
+;;@args z
+;;@args
+;;Returns a high-precision complex uniform-array prototype.
+(define Ac64 (make-prototype-checker 'Ac64 complex? vector))
+;;@args z
+;;@args
+;;Returns a complex uniform-array prototype.
+(define Ac32 (make-prototype-checker 'Ac32 complex? vector))
+
+;;@args x
+;;@args
+;;Returns a high-precision real uniform-array prototype.
+(define Ar64 (make-prototype-checker 'Ar64 real? vector))
+;;@args x
+;;@args
+;;Returns a real uniform-array prototype.
+(define Ar32 (make-prototype-checker 'Ar32 real? vector))
+
+;;@args n
+;;@args
+;;Returns an exact signed integer uniform-array prototype with at least
+;;64 bits of precision.
+(define As64 (make-prototype-checker 'As64 (integer-bytes?? -8) vector))
+;;@args n
+;;@args
+;;Returns an exact signed integer uniform-array prototype with at least
+;;32 bits of precision.
+(define As32 (make-prototype-checker 'As32 (integer-bytes?? -4) vector))
+;;@args n
+;;@args
+;;Returns an exact signed integer uniform-array prototype with at least
+;;16 bits of precision.
+(define As16 (make-prototype-checker 'As16 (integer-bytes?? -2) vector))
+;;@args n
+;;@args
+;;Returns an exact signed integer uniform-array prototype with at least
+;;8 bits of precision.
+(define As8 (make-prototype-checker 'As8 (integer-bytes?? -1) vector))
+
+;;@args k
+;;@args
+;;Returns an exact non-negative integer uniform-array prototype with at
+;;least 64 bits of precision.
+(define Au64 (make-prototype-checker 'Au64 (integer-bytes?? 8) vector))
+;;@args k
+;;@args
+;;Returns an exact non-negative integer uniform-array prototype with at
+;;least 32 bits of precision.
+(define Au32 (make-prototype-checker 'Au32 (integer-bytes?? 4) vector))
+;;@args k
+;;@args
+;;Returns an exact non-negative integer uniform-array prototype with at
+;;least 16 bits of precision.
+(define Au16 (make-prototype-checker 'Au16 (integer-bytes?? 2) vector))
+;;@args k
+;;@args
+;;Returns an exact non-negative integer uniform-array prototype with at
+;;least 8 bits of precision.
+(define Au8 (make-prototype-checker 'Au8 (integer-bytes?? 1) vector))
+
+;;@args bool
+;;@args
+;;Returns a boolean uniform-array prototype.
+(define At1 (make-prototype-checker 'At1 boolean? vector))
 
 ;;@noindent
 ;;When constructing an array, @var{bound} is either an inclusive range of
@@ -105,18 +227,18 @@
 ;;a single integer.  So
 ;;
 ;;@example
-;;(make-array 'foo 3 3) @equiv{} (make-array 'foo '(0 2) '(0 2))
+;;(create-array '#(foo) 3 3) @equiv{} (create-array '#(foo) '(0 2) '(0 2))
 ;;@end example
 
 ;;@args array mapper bound1 bound2 @dots{}
-;;@code{make-shared-array} can be used to create shared subarrays of other
+;;@0 can be used to create shared subarrays of other
 ;;arrays.  The @var{mapper} is a function that translates coordinates in
 ;;the new array into coordinates in the old array.  A @var{mapper} must be
 ;;linear, and its range must stay within the bounds of the old array, but
 ;;it can be otherwise arbitrary.  A simple example:
 ;;
 ;;@example
-;;(define fred (make-array #f 8 8))
+;;(define fred (create-array '#(#f) 8 8))
 ;;(define freds-diagonal
 ;;  (make-shared-array fred (lambda (i) (list i i)) 8))
 ;;(array-set! freds-diagonal 'foo 3)
@@ -153,32 +275,28 @@
 ;;Returns the number of dimensions of @1.  If @1 is not an array, 0 is
 ;;returned.
 (define (array-rank obj)
-  (if (array? obj) (length (array-shape obj)) 0))
+  (if (array? obj) (length (array:shape obj)) 0))
 
-;;@body
+;;@args array
 ;;Returns a list of inclusive bounds.
 ;;
 ;;@example
-;;(array-shape (make-array 'foo 3 5))
+;;(array-shape (create-array '#() 3 5))
 ;;   @result{} ((0 2) (0 4))
 ;;@end example
-(define array-shape
-  (lambda (array)
-    (cond ((vector? array) (list (list 0 (+ -1 (vector-length array)))))
-	  ((string? array) (list (list 0 (+ -1 (string-length array)))))
-	  (else (array:shape array)))))
+(define array-shape array:shape)
 
 ;;@body
 ;;@code{array-dimensions} is similar to @code{array-shape} but replaces
 ;;elements with a 0 minimum with one greater than the maximum.
 ;;
 ;;@example
-;;(array-dimensions (make-array 'foo 3 5))
+;;(array-dimensions (create-array '#() 3 5))
 ;;   @result{} (3 5)
 ;;@end example
 (define (array-dimensions array)
   (map (lambda (bnd) (if (zero? (car bnd)) (+ 1 (cadr bnd)) bnd))
-       (array-shape array)))
+       (array:shape array)))
 
 (define (array:in-bounds? array indices)
   (do ((bnds (array:shape array) (cdr bnds))
@@ -217,12 +335,8 @@
 
 ;;; Legacy functions
 
-;; These procedures are fast versions of @code{array-ref} and
-;; @code{array-set!} for non-string arrays; they take a fixed number of
-;; arguments and perform no bounds checking.
-(define array-1d-ref array-ref)
-(define array-2d-ref array-ref)
-(define array-3d-ref array-ref)
-(define array-1d-set! array-set!)
-(define array-2d-set! array-set!)
-(define array-3d-set! array-set!)
+;; ;;@args initial-value bound1 bound2 @dots{}
+;; ;;Creates and returns an array with dimensions @2,
+;; ;;@3, @dots{} and filled with @1.
+;; (define (make-array initial-value . dimensions)
+;;   (apply create-array (vector initial-value) dimensions))
diff --git a/array.txi b/array.txi
index 5d30b19..bb09e16 100644
--- a/array.txi
+++ b/array.txi
@@ -23,15 +23,131 @@ Returns @code{#t} if @var{array1} and @var{array2} have the same rank and shape
 corresponding elements of @var{array1} and @var{array2} are @code{equal?}.
 
 @example
-(array=? (make-array 'foo 3 3) (make-array 'foo '(0 2) '(1 2)))
+(array=? (create-array '#(foo) 3 3)
+         (create-array '#(foo) '(0 2) '(0 2)))
   @result{} #t
 @end example
 @end defun
 
-@defun make-array initial-value bound1 bound2 @dots{}
+@defun create-array prototype bound1 bound2 @dots{}
 
-Creates and returns an array with dimensions @var{bound1},
-@var{bound2}, @dots{} and filled with @var{initial-value}.
+
+Creates and returns an array of type @var{prototype} with dimensions @var{bound1}, @var{bound2},
+@dots{} and filled with elements from @var{prototype}.  @var{prototype} must be an array,
+vector, or string.  The implementation-dependent type of the returned
+array will be the same as the type of @var{prototype}; except if that would be a
+vector or string with non-zero origin, in which case some variety of
+array will be returned.
+
+If the @var{prototype} has no elements, then the initial contents of the returned
+array are unspecified.  Otherwise, the returned array will be filled
+with the element at the origin of @var{prototype}.
+@end defun
+@noindent
+These functions return a prototypical uniform-array enclosing the
+optional argument (which must be of the correct type).  If the
+uniform-array type is supported by the implementation, then it is
+returned; defaulting to the next larger precision type; resorting
+finally to vector.
+
+
+@defun ac64 z
+
+
+@defunx ac64
+Returns a high-precision complex uniform-array prototype.
+@end defun
+
+@defun ac32 z
+
+
+@defunx ac32
+Returns a complex uniform-array prototype.
+@end defun
+
+@defun ar64 x
+
+
+@defunx ar64
+Returns a high-precision real uniform-array prototype.
+@end defun
+
+@defun ar32 x
+
+
+@defunx ar32
+Returns a real uniform-array prototype.
+@end defun
+
+@defun as64 n
+
+
+@defunx as64
+Returns an exact signed integer uniform-array prototype with at least
+64 bits of precision.
+@end defun
+
+@defun as32 n
+
+
+@defunx as32
+Returns an exact signed integer uniform-array prototype with at least
+32 bits of precision.
+@end defun
+
+@defun as16 n
+
+
+@defunx as16
+Returns an exact signed integer uniform-array prototype with at least
+16 bits of precision.
+@end defun
+
+@defun as8 n
+
+
+@defunx as8
+Returns an exact signed integer uniform-array prototype with at least
+8 bits of precision.
+@end defun
+
+@defun au64 k
+
+
+@defunx au64
+Returns an exact non-negative integer uniform-array prototype with at
+least 64 bits of precision.
+@end defun
+
+@defun au32 k
+
+
+@defunx au32
+Returns an exact non-negative integer uniform-array prototype with at
+least 32 bits of precision.
+@end defun
+
+@defun au16 k
+
+
+@defunx au16
+Returns an exact non-negative integer uniform-array prototype with at
+least 16 bits of precision.
+@end defun
+
+@defun au8 k
+
+
+@defunx au8
+Returns an exact non-negative integer uniform-array prototype with at
+least 8 bits of precision.
+@end defun
+
+@defun at1 bool
+
+
+@defunx at1
+Returns a boolean uniform-array prototype.
 @end defun
 @noindent
 When constructing an array, @var{bound} is either an inclusive range of
@@ -39,7 +155,7 @@ indices expressed as a two element list, or an upper bound expressed as
 a single integer.  So
 
 @example
-(make-array 'foo 3 3) @equiv{} (make-array 'foo '(0 2) '(0 2))
+(create-array '#(foo) 3 3) @equiv{} (create-array '#(foo) '(0 2) '(0 2))
 @end example
 
 
@@ -52,7 +168,7 @@ linear, and its range must stay within the bounds of the old array, but
 it can be otherwise arbitrary.  A simple example:
 
 @example
-(define fred (make-array #f 8 8))
+(define fred (create-array '#(#f) 8 8))
 (define freds-diagonal
   (make-shared-array fred (lambda (i) (list i i)) 8))
 (array-set! freds-diagonal 'foo 3)
@@ -77,7 +193,7 @@ returned.
 Returns a list of inclusive bounds.
 
 @example
-(array-shape (make-array 'foo 3 5))
+(array-shape (create-array '#() 3 5))
    @result{} ((0 2) (0 4))
 @end example
 @end defun
@@ -88,7 +204,7 @@ Returns a list of inclusive bounds.
 elements with a 0 minimum with one greater than the maximum.
 
 @example
-(array-dimensions (make-array 'foo 3 5))
+(array-dimensions (create-array '#() 3 5))
    @result{} (3 5)
 @end example
 @end defun
@@ -104,8 +220,8 @@ Returns @code{#t} if its arguments would be acceptable to
 Returns the (@var{index1}, @var{index2}, @dots{}) element of @var{array}.
 @end defun
 
-@defun array-set! array obj index1 index2 @dots{}
+@deffn {Procedure} array-set! array obj index1 index2 @dots{}
 
 Stores @var{obj} in the (@var{index1}, @var{index2}, @dots{}) element of @var{array}.  The value returned
 by @code{array-set!} is unspecified.
-@end defun
+@end deffn
diff --git a/arraymap.scm b/arraymap.scm
index 15e24da..747962e 100644
--- a/arraymap.scm
+++ b/arraymap.scm
@@ -1,5 +1,5 @@
 ;;;; "arraymap.scm", applicative routines for arrays in Scheme.
-;;; Copyright (c) 1993 Aubrey Jaffer
+;;; Copyright (c) 1993, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -19,6 +19,16 @@
 
 (require 'array)
 
+;;@code{(require 'array-for-each)}
+;;@ftindex array-for-each
+
+;;@args array0 proc array1 @dots{}
+;;@var{array1}, @dots{} must have the same number of dimensions as
+;;@var{array0} and have a range for each index which includes the range
+;;for the corresponding index in @var{array0}.  @var{proc} is applied to
+;;each tuple of elements of @var{array1} @dots{} and the result is stored
+;;as the corresponding element in @var{array0}.  The value returned is
+;;unspecified.  The order of application is unspecified.
 (define (array-map! ra0 proc . ras)
   (define (ramap rshape inds)
     (if (null? (cdr rshape))
@@ -27,8 +37,7 @@
 		 (cons (+ -1 i) inds)))
 	    ((< i (caar rshape)))
 	  (apply array-set! ra0
-		 (apply proc (map (lambda (ra) (apply array-ref ra is))
-				  ras))
+		 (apply proc (map (lambda (ra) (apply array-ref ra is)) ras))
 		 is))
 	(let ((crshape (cdr rshape))
 	      (ll (caar rshape)))
@@ -37,14 +46,31 @@
 	    (ramap crshape (cons i inds))))))
   (ramap (reverse (array-shape ra0)) '()))
 
+;;@args prototype proc array1 array2 @dots{}
+;;@var{array2}, @dots{} must have the same number of dimensions as
+;;@var{array1} and have a range for each index which includes the
+;;range for the corresponding index in @var{array1}.  @var{proc} is
+;;applied to each tuple of elements of @var{array1}, @var{array2},
+;;@dots{} and the result is stored as the corresponding element in a
+;;new array of type @var{prototype}.  The new array is returned.  The
+;;order of application is unspecified.
+(define (array-map prototype proc ra1 . ras)
+  (define nra (apply create-array prototype (array-shape ra1)))
+  (apply array-map! nra proc ra1 ras)
+  nra)
+
+;;@args proc array0 @dots{}
+;;@var{proc} is applied to each tuple of elements of @var{array0} @dots{}
+;;in row-major order.  The value returned is unspecified.
 (define (array-for-each proc . ras)
   (define (rafe rshape inds)
     (if (null? (cdr rshape))
-	(do ((i (caar rshape) (+ 1 i)))
-	    ((> i (cadar rshape)))
-	  (apply proc
-		 (map (lambda (ra)
-			(apply array-ref ra (reverse (cons i inds)))) ras)))
+	(let ((sdni (reverse (cons #f inds))))
+	  (define lastpair (last-pair sdni))
+	  (do ((i (caar rshape) (+ 1 i)))
+	      ((> i (cadar rshape)))
+	    (set-car! lastpair i)
+	    (apply proc (map (lambda (ra) (apply array-ref ra sdni)) ras))))
 	(let ((crshape (cdr rshape))
 	      (ll (cadar rshape)))
 	  (do ((i (caar rshape) (+ 1 i)))
@@ -52,6 +78,35 @@
 	    (rafe crshape (cons i inds))))))
   (rafe (array-shape (car ras)) '()))
 
+;;@args array
+;;Returns an array of lists of indexes for @var{array} such that, if
+;;@var{li} is a list of indexes for which @var{array} is defined,
+;;(equal?  @var{li} (apply array-ref (array-indexes @var{array})
+;;@var{li})).
+(define (array-indexes ra)
+  (let ((ra0 (apply create-array '#() (array-shape ra))))
+    (array-index-map! ra0 list)
+    ra0))
+
+;;@args array proc
+;;applies @var{proc} to the indices of each element of @var{array} in
+;;turn, storing the result in the corresponding element.  The value
+;;returned and the order of application are unspecified.
+;;
+;;One can implement @var{array-indexes} as
+;;@example
+;;(define (array-indexes array)
+;;    (let ((ra (apply create-array '#() (array-shape array))))
+;;      (array-index-map! ra (lambda x x))
+;;      ra))
+;;@end example
+;;Another example:
+;;@example
+;;(define (apl:index-generator n)
+;;    (let ((v (make-vector n 1)))
+;;      (array-index-map! v (lambda (i) i))
+;;      v))
+;;@end example
 (define (array-index-map! ra fun)
   (define (ramap rshape inds)
     (if (null? (cdr rshape))
@@ -69,10 +124,10 @@
       (array-set! ra (fun))
       (ramap (reverse (array-shape ra)) '())))
 
-(define (array-indexes ra)
-  (let ((ra0 (apply make-array '() (array-shape ra))))
-    (array-index-map! ra0 list)
-    ra0))
-
+;;@args source destination
+;;Copies every element from vector or array @var{source} to the
+;;corresponding element of @var{destination}.  @var{destination} must
+;;have the same rank as @var{source}, and be at least as large in each
+;;dimension.  The order of copying is unspecified.
 (define (array-copy! source dest)
   (array-map! dest identity source))
diff --git a/arraymap.txi b/arraymap.txi
new file mode 100644
index 0000000..f10ad65
--- /dev/null
+++ b/arraymap.txi
@@ -0,0 +1,68 @@
+@code{(require 'array-for-each)}
+@ftindex array-for-each
+
+
+@deffn {Procedure} array-map! array0 proc array1 @dots{}
+
+@var{array1}, @dots{} must have the same number of dimensions as
+@var{array0} and have a range for each index which includes the range
+for the corresponding index in @var{array0}.  @var{proc} is applied to
+each tuple of elements of @var{array1} @dots{} and the result is stored
+as the corresponding element in @var{array0}.  The value returned is
+unspecified.  The order of application is unspecified.
+@end deffn
+
+@defun array-map prototype proc array1 array2 @dots{}
+
+@var{array2}, @dots{} must have the same number of dimensions as
+@var{array1} and have a range for each index which includes the
+range for the corresponding index in @var{array1}.  @var{proc} is
+applied to each tuple of elements of @var{array1}, @var{array2},
+@dots{} and the result is stored as the corresponding element in a
+new array of type @var{prototype}.  The new array is returned.  The
+order of application is unspecified.
+@end defun
+
+@defun array-for-each proc array0 @dots{}
+
+@var{proc} is applied to each tuple of elements of @var{array0} @dots{}
+in row-major order.  The value returned is unspecified.
+@end defun
+
+@defun array-indexes array
+
+Returns an array of lists of indexes for @var{array} such that, if
+@var{li} is a list of indexes for which @var{array} is defined,
+(equal?  @var{li} (apply array-ref (array-indexes @var{array})
+@var{li})).
+@end defun
+
+@deffn {Procedure} array-index-map! array proc
+
+applies @var{proc} to the indices of each element of @var{array} in
+turn, storing the result in the corresponding element.  The value
+returned and the order of application are unspecified.
+
+One can implement @var{array-indexes} as
+@example
+(define (array-indexes array)
+    (let ((ra (apply create-array '#() (array-shape array))))
+      (array-index-map! ra (lambda x x))
+      ra))
+@end example
+Another example:
+@example
+(define (apl:index-generator n)
+    (let ((v (make-vector n 1)))
+      (array-index-map! v (lambda (i) i))
+      v))
+@end example
+@end deffn
+
+@deffn {Procedure} array-copy! source destination
+
+Copies every element from vector or array @var{source} to the
+corresponding element of @var{destination}.  @var{destination} must
+have the same rank as @var{source}, and be at least as large in each
+dimension.  The order of copying is unspecified.
+@end deffn
diff --git a/batch.scm b/batch.scm
index 45b404c..bef29cc 100644
--- a/batch.scm
+++ b/batch.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -17,11 +17,14 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
+(require 'tree)
 (require 'line-i/o)			;Just for write-line
+(require 'databases)
 (require 'parameters)
-(require 'database-utilities)
 (require 'string-port)
-(require 'tree)
+(require 'pretty-print)
+(require 'common-list-functions)
+(require-if '(and bignum compiling) 'posix-time)
 
 (define system
   (if (provided? 'system)
@@ -43,6 +46,9 @@
 (define (batch:dialect parms)		; was batch-family
   (car (parameter-list-ref parms 'batch-dialect)))
 
+(define (batch:operating-system parms)
+  (car (parameter-list-ref parms 'operating-system)))
+
 (define (write-batch-line str line-limit port)
   (cond ((and line-limit (>= (string-length str) line-limit))
 	 (slib:warn 'write-batch-line 'too-long
@@ -53,7 +59,7 @@
   (write-batch-line str (batch:line-length-limit parms) (batch:port parms)))
 
 ;;; add a Scheme batch-dialect?
-
+;@
 (define (batch:try-chopped-command parms . args)
   (define args-but-last (batch:flatten (butlast args 1)))
   (define line-limit (batch:line-length-limit parms))
@@ -65,7 +71,7 @@
 	     (batch:try-command parms str))
 	    ((< (length fodder) 2)
 	     (slib:warn 'batch:try-chopped-command "can't fit in " line-limit
-			(cons proc (append args-but-last (list fodder))))
+			(append args-but-last (list fodder)))
 	     #f)
 	    (else (let ((hlen (quotient (length fodder) 2)))
 		    (and (loop (last fodder hlen))
@@ -74,15 +80,15 @@
 (define (batch:glued-line parms strings)
   (case (batch:dialect parms)
     ((vms) (apply string-join " " "$" strings))
-    ((unix dos amigados system *unknown*) (apply string-join " " strings))
+    ((unix dos amigaos system *unknown*) (apply string-join " " strings))
     (else #f)))
-
+;@
 (define (batch:try-command parms . strings)
   (set! strings (batch:flatten strings))
   (let ((line (batch:glued-line parms strings)))
     (and line
 	 (case (batch:dialect parms)
-	   ((unix dos vms amigados) (batch-line parms line))
+	   ((unix dos vms amigaos) (batch-line parms line))
 	   ((system)
 	    (let ((port (batch:port parms)))
 	      (write `(system ,line) port) (newline port)
@@ -91,11 +97,11 @@
 	    (let ((port (batch:port parms)))
 	      (write `(system ,line) port) (newline port) #t))
 	   (else #f)))))
-
+;@
 (define (batch:command parms . strings)
   (cond ((apply batch:try-command parms strings))
 	(else (slib:error 'batch:command 'failed strings))))
-
+;@
 (define (batch:run-script parms name . strings)
   (case (batch:dialect parms strings)
     ((vms) (batch:command parms (string-append "@" name) strings))
@@ -106,12 +112,12 @@
     ((unix) (write-batch-line (string-append "# " line) #f port))
     ((dos) (write-batch-line (string-append "rem " line) #f port))
     ((vms) (write-batch-line (string-append "$! " line) #f port))
-    ((amigados) (write-batch-line (string-append "; " line) #f port))
+    ((amigaos) (write-batch-line (string-append "; " line) #f port))
     ((system) (write-batch-line (string-append "; " line) #f port))
     ((*unknown*) (write-batch-line (string-append ";;; " line) #f port)
      ;;(newline port)
      #f)))
-
+;@
 (define (batch:comment parms . lines)
   (define port (batch:port parms))
   (define dialect (batch:dialect parms))
@@ -119,7 +125,7 @@
   (every (lambda (line)
 	   (batch:write-comment-line dialect line port))
 	 lines))
-
+;@
 (define (batch:lines->file parms file . lines)
   (define port (batch:port parms))
   (set! lines (batch:flatten lines))
@@ -142,7 +148,7 @@
 		(every (lambda (string) (batch-line parms string))
 		       lines)
 		(batch-line parms (string-append "$EOD"))))
-    ((amigados) (batch-line parms (string-append "delete force " file))
+    ((amigaos) (batch-line parms (string-append "delete force " file))
 	    (every
 	     (lambda (str)
 	       (letrec ((star-quote
@@ -162,7 +168,6 @@
 	     lines))
     ((system) (write `(delete-file ,file) port) (newline port)
 	      (delete-file file)
-	      (require 'pretty-print)
 	      (pretty-print `(call-with-output-file ,file
 			       (lambda (fp)
 				 (for-each
@@ -175,7 +180,6 @@
 	      #t)
     ((*unknown*)
      (write `(delete-file ,file) port) (newline port)
-     (require 'pretty-print)
      (pretty-print
       `(call-with-output-file ,file
 	 (lambda (fp)
@@ -185,7 +189,7 @@
 	    ,lines)))
       port)
      #f)))
-
+;@
 (define (batch:delete-file parms file)
   (define port (batch:port parms))
   (case (batch:dialect parms)
@@ -195,13 +199,13 @@
 	   #t)
     ((vms) (batch-line parms (string-append "$DELETE " file))
 	   #t)
-    ((amigados) (batch-line parms (string-append "delete force " file))
+    ((amigaos) (batch-line parms (string-append "delete force " file))
 	    #t)
     ((system) (write `(delete-file ,file) port) (newline port)
 	      (delete-file file))	; SLIB provides
     ((*unknown*) (write `(delete-file ,file) port) (newline port)
 		 #f)))
-
+;@
 (define (batch:rename-file parms old-name new-name)
   (define port (batch:port parms))
   (case (batch:dialect parms)
@@ -209,15 +213,18 @@
     ;;((dos) (batch-line parms (string-join " " "REN" old-name new-name)))
     ((dos) (batch-line parms (string-join " " "MOVE" "/Y" old-name new-name)))
     ((vms) (batch-line parms (string-join " " "$RENAME" old-name new-name)))
-    ((amigados) (batch-line parms (string-join " " "failat 21"))
-		(batch-line parms (string-join " " "delete force" new-name))
-		(batch-line parms (string-join " " "rename" old-name new-name)))
+    ((amigaos) (batch-line parms (string-join " " "failat 21"))
+	       (batch-line parms (string-join " " "delete force" new-name))
+	       (batch-line parms (string-join " " "rename" old-name new-name)))
     ((system) (batch:extender 'rename-file batch:rename-file))
     ((*unknown*) (write `(rename-file ,old-name ,new-name) port)
 		 (newline port)
 		 #f)))
 
-(define (batch:write-header-comment dialect name port)
+(define (batch:write-header-comment parms name port)
+  (define dialect (batch:dialect parms))
+  (define operating-system
+    (or (batch:operating-system parms) *operating-system*))
   (batch:write-comment-line
    dialect
    (string-append (if (string? name)
@@ -228,6 +235,7 @@
 			((dos) "DOS")
 			((default-for-platform) "??")
 			(else (symbol->string dialect))))
+		  " (" (symbol->string operating-system) ")"
 		  " script created by SLIB/batch "
 		  (cond ((provided? 'bignum)
 			 (require 'posix-time)
@@ -235,9 +243,11 @@
 			   (substring ct 0 (+ -1 (string-length ct)))))
 			(else "")))
    port))
-
+;@
 (define (batch:call-with-output-script parms name proc)
   (define dialect (batch:dialect parms))
+  (define operating-system
+    (or (batch:operating-system parms) *operating-system*))
   (case dialect
     ((unix) ((cond ((and (string? name) (provided? 'system))
 		    (lambda (proc)
@@ -247,8 +257,11 @@
 		   ((output-port? name) (lambda (proc) (proc name)))
 		   (else (lambda (proc) (proc (current-output-port)))))
 	     (lambda (port)
-	       (write-line "#!/bin/sh" port)
-	       (batch:write-header-comment dialect name port)
+	       (write-line (if (eq? 'plan9 operating-system)
+			       "#! /bin/rc"
+			       "#! /bin/sh")
+			   port)
+	       (batch:write-header-comment parms name port)
 	       (proc port))))
 
     ((dos) ((cond ((string? name)
@@ -257,7 +270,7 @@
 		  ((output-port? name) (lambda (proc) (proc name)))
 		  (else (lambda (proc) (proc (current-output-port)))))
 	    (lambda (port)
-	      (batch:write-header-comment dialect name port)
+	      (batch:write-header-comment parms name port)
 	      (proc port))))
 
     ((vms) ((cond ((string? name)
@@ -266,20 +279,20 @@
 		  ((output-port? name) (lambda (proc) (proc name)))
 		  (else (lambda (proc) (proc (current-output-port)))))
 	    (lambda (port)
-	      (batch:write-header-comment dialect name port)
+	      (batch:write-header-comment parms name port)
 	      ;;(write-line "$DEFINE/USER SYS$OUTPUT BUILD.LOG" port)
 	      (proc port))))
 
-    ((amigados) ((cond ((and (string? name) (provided? 'system))
-		    (lambda (proc)
-		      (let ((ans (call-with-output-file name proc)))
-			(system (string-append "protect " name " rswd"))
-			ans)))
-		   ((output-port? name) (lambda (proc) (proc name)))
-		   (else (lambda (proc) (proc (current-output-port)))))
-	     (lambda (port)
-	       (batch:write-header-comment dialect name port)
-	       (proc port))))
+    ((amigaos) ((cond ((and (string? name) (provided? 'system))
+		       (lambda (proc)
+			 (let ((ans (call-with-output-file name proc)))
+			   (system (string-append "protect " name " rswd"))
+			   ans)))
+		      ((output-port? name) (lambda (proc) (proc name)))
+		      (else (lambda (proc) (proc (current-output-port)))))
+		(lambda (port)
+		  (batch:write-header-comment parms name port)
+		  (proc port))))
 
     ((system) ((cond ((and (string? name) (provided? 'system))
 		      (lambda (proc)
@@ -290,7 +303,7 @@
 		     ((output-port? name) (lambda (proc) (proc name)))
 		     (else (lambda (proc) (proc (current-output-port)))))
 	       (lambda (port)
-		 (batch:write-header-comment dialect name port)
+		 (batch:write-header-comment parms name port)
 		 (proc port))))
 
     ((*unknown*) ((cond ((and (string? name) (provided? 'system))
@@ -302,7 +315,7 @@
 			((output-port? name) (lambda (proc) (proc name)))
 			(else (lambda (proc) (proc (current-output-port)))))
 		  (lambda (port)
-		    (batch:write-header-comment dialect name port)
+		    (batch:write-header-comment parms name port)
 		    (proc port))))))
 
 ;;; This little ditty figures out how to use a Scheme extension or
@@ -321,8 +334,9 @@
      (else
       (let ((pl (make-parameter-list (map car parms))))
 	(adjoin-parameters!
-	 pl (cons 'batch-dialect (os->batch-dialect
-				  (parameter-list-ref parms 'platform))))
+	 pl (cons 'batch-dialect
+		  (os->batch-dialect
+		   (parameter-list-ref parms 'operating-system))))
 	(system
 	 (call-with-output-string
 	  (lambda (port)
@@ -332,7 +346,7 @@
 	       (define new-parms (copy-tree pl))
 	       (adjoin-parameters! new-parms (list 'batch-port batch-port))
 	       (apply BATCHER new-parms args)))))))))))
-
+;@
 (define (truncate-up-to str chars)
   (define (tut str)
     (do ((i (string-length str) (+ -1 i)))
@@ -341,15 +355,15 @@
   (cond ((char? chars) (set! chars (list chars)))
 	((string? chars) (set! chars (string->list chars))))
   (if (string? str) (tut str) (map tut str)))
-
+;@
 (define (must-be-first firsts lst)
   (append (remove-if-not (lambda (i) (member i lst)) firsts)
 	  (remove-if (lambda (i) (member i firsts)) lst)))
-
+;@
 (define (must-be-last lst lasts)
   (append (remove-if (lambda (i) (member i lasts)) lst)
 	  (remove-if-not (lambda (i) (member i lst)) lasts)))
-
+;@
 (define (string-join joiner . args)
   (if (null? args) ""
       (apply string-append
@@ -369,21 +383,15 @@
 				     obj "in" strings))))
 	   strings)))
 
-(define batch:platform (software-type))
-(cond ((and (eq? 'unix batch:platform) (provided? 'system))
-       (let ((file-name (tmpnam)))
-	 (system (string-append "uname > " file-name))
-	 (set! batch:platform (call-with-input-file file-name read))
-	 (delete-file file-name))))
-
 (define batch:database #f)
-(define os->batch-dialect #f)
 (define batch-dialect->line-length-limit #f)
+;@
+(define os->batch-dialect #f)
 
 (define (batch:line-length-limit parms)
   (let ((bl (parameter-list-ref parms 'batch-line-length-limit)))
     (if bl (car bl) (batch-dialect->line-length-limit (batch:dialect parms)))))
-
+;@
 (define (batch:initialize! database)
   (set! batch:database database)
   (define-tables database
@@ -394,7 +402,7 @@
       ((unix 1023)
        (dos 127)
        (vms 1023)
-       (amigados 511)
+       (amigaos 511)
        (system 1023)
        (*unknown* -1)))
 
@@ -406,7 +414,7 @@
        (acorn		*unknown*)
        (aix		unix)
        (alliant		*unknown*)
-       (amiga		amigados)
+       (amiga		amigaos)
        (apollo		unix)
        (apple2		*unknown*)
        (arm		*unknown*)
@@ -415,6 +423,7 @@
        (celerity	*unknown*)
        (concurrent	*unknown*)
        (convex		*unknown*)
+       (darwin		unix)
        (encore		*unknown*)
        (harris		*unknown*)
        (hp-ux		unix)
@@ -432,6 +441,7 @@
        (novell		*unknown*)
        (os/2		dos)
        (osf1		unix)
+       (plan9		unix)
        (prime		*unknown*)
        (psion		*unknown*)
        (pyramid		*unknown*)
@@ -445,10 +455,29 @@
        (vms		vms)
        )))
 
-  ((database 'add-domain) '(operating-system operating-system #f symbol #f))
+  (define-domains database '(operating-system operating-system #f symbol #f))
   (set! os->batch-dialect (((batch:database 'open-table) 'operating-system #f)
 			   'get 'os-family))
   (set! batch-dialect->line-length-limit
 	(((batch:database 'open-table) 'batch-dialect #f)
 	 'get 'line-length-limit))
   )
+;@
+(define *operating-system*
+  (cond ((and (eq? 'unix (software-type)) (provided? 'system))
+	 (let* ((file-name (tmpnam))
+		(uname (and (system (string-append "uname > " file-name))
+			    (call-with-input-file file-name read)))
+		(ustr (and (symbol? uname) (symbol->string uname))))
+	   (delete-file file-name)
+	   (cond ((and ustr
+		       (> (string-length ustr) 5)
+		       (string-ci=? "cygwin" (substring ustr 0 6)))
+		  'gnu-win32)
+		 ((and ustr
+		       (> (string-length ustr) 4)
+		       (string-ci=? "mingw" (substring ustr 0 5)))
+		  'gnu-win32)
+		 (ustr uname)
+		 (else (software-type)))))
+	(else (software-type))))
diff --git a/bigloo.init b/bigloo.init
index 41a4179..9ded1a4 100644
--- a/bigloo.init
+++ b/bigloo.init
@@ -7,34 +7,29 @@
 
 ;;; (scheme-implementation-type) should return the name of the scheme
 ;;; implementation loading this file.
-
 (define (scheme-implementation-type) 'Bigloo)
 
 ;;; (scheme-implementation-home-page) should return a (string) URI
 ;;; (Uniform Resource Identifier) for this scheme implementation's home
 ;;; page; or false if there isn't one.
-
 (define (scheme-implementation-home-page)
-  "http://kaolin.unice.fr/~serrano/bigloo/bigloo.html")
+  "http://www-sop.inria.fr/mimosa/fp/Bigloo/")
 
 ;;; (scheme-implementation-version) should return a string describing
 ;;; the version the scheme implementation loading this file.
-
-(define (scheme-implementation-version) "2.0c")
+(define (scheme-implementation-version) *bigloo-version*)
 
 ;;; (implementation-vicinity) should be defined to be the pathname of
 ;;; the directory where any auxillary files to your Scheme
 ;;; implementation reside.
-
 (define (implementation-vicinity)
   (case (software-type)
-    ((UNIX)	"/usr/local/lib/bigloo/")
-    ((VMS)	"scheme$src:")
-    ((MS-DOS)	"C:\\scheme\\")))
+    ((UNIX) (string-append *default-lib-dir* "/"))
+    ((MS-DOS) "C:\\scheme\\")
+    (else "")))
 
 ;;; (library-vicinity) should be defined to be the pathname of the
 ;;; directory where files of Scheme library functions reside.
-
 (define library-vicinity
   (let ((library-path
 	 (or
@@ -43,8 +38,11 @@
 	  ;; Use this path if your scheme does not support GETENV
 	  ;; or if SCHEME_LIBRARY_PATH is not set.
 	  (case (software-type)
-	    ((UNIX) "/usr/share/slib/")
-	    ((VMS) "lib$scheme:")
+	    ((UNIX) (cond ((directory? "/usr/share/slib/")
+			   "/usr/share/slib/")
+			  ((directory? "/usr/local/lib/slib/")
+			   "/usr/local/lib/slib/")
+			  (else "")))
 	    ((MS-DOS) "C:\\SLIB\\")
 	    (else "")))))
     (lambda () library-path)))
@@ -52,15 +50,19 @@
 ;;; (home-vicinity) should return the vicinity of the user's HOME
 ;;; directory, the directory which typically contains files which
 ;;; customize a computer environment for a user.
-
-(define home-vicinity
-  (let ((home-path (getenv "HOME")))
-    (lambda () home-path)))
+(define (home-vicinity)
+  (let ((home (getenv "HOME")))
+    (and home
+	 (case (software-type)
+	   ((UNIX COHERENT MS-DOS)	;V7 unix has a / on HOME
+	    (if (eqv? #\/ (string-ref home (+ -1 (string-length home))))
+		home
+		(string-append home "/")))
+	   (else home)))))
 
 ;;; *FEATURES* should be set to a list of symbols describing features
 ;;; of this implementation.  See Template.scm for the list of feature
 ;;; names.
-
 (define *features*
       '(
 	source				;can load scheme source files
@@ -70,7 +72,7 @@
 
 		       ;; Scheme report features
 
-;	rev5-report			;conforms to
+;	r5rs				;conforms to
 	eval				;R5RS two-argument eval
 ;	values				;R5RS multiple values
 ;	dynamic-wind			;R5RS dynamic-wind
@@ -84,11 +86,11 @@
 					;STRING-FILL!, LIST->VECTOR,
 					;VECTOR->LIST, and VECTOR-FILL!
 
-	rev4-report			;conforms to
+	r4rs				;conforms to
 
 	ieee-p1178			;conforms to
 
-	rev3-report			;conforms to
+	r3rs				;conforms to
 
 ;	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
 					;SUBSTRING-MOVE-RIGHT!,
@@ -99,7 +101,7 @@
 
 	multiarg/and-			;/ and - can take more than 2 args.
 	with-file			;has WITH-INPUT-FROM-FILE and
-					;WITH-OUTPUT-FROM-FILE
+					;WITH-OUTPUT-TO-FILE
 	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 	ieee-floating-point		;conforms to IEEE Standard 754-1985
 					;IEEE Standard for Binary
@@ -170,6 +172,37 @@
     (close-input-port insp)
     res))
 
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r rb) (open-input-file filename))
+    ((w wb) (open-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+;;(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+(define (close-port port)
+  (cond ((input-port? port)
+	 (close-input-port port)
+	 (if (output-port? port) (close-output-port port)))
+	((output-port? port) (close-output-port port))
+	(else (slib:error 'close-port 'port? port))))
+
+(define (browse-url url)
+  (define (try cmd end) (zero? (system (string-append cmd url end))))
+  (or (try "netscape-remote -remote 'openURL(" ")'")
+      (try "netscape -remote 'openURL(" ")'")
+      (try "netscape '" "'&")
+      (try "netscape '" "'")))
+
 ;;; "rationalize" adjunct procedures.
 (define (find-ratio x e)
   (let ((rat (rationalize x e)))
@@ -216,7 +249,7 @@
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Warn: " cep)
-      (for-each (lambda (x) (display x cep)) args))))
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
 
 
 ;;; define an error procedure for the library
@@ -238,7 +271,7 @@
     ))
 
 
-(define (promise:force p) (force p))
+;;(define force force)
 
 ;;; Define these if your implementation's syntax can support it and if
 ;;; they are not already defined.
@@ -262,17 +295,14 @@
 
 ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
 ;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
-
 (define (slib:load-source f) (loadq (string-append f (scheme-file-suffix))))
 
 ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
 ;;; by compiling "foo.scm" if this implementation can compile files.
 ;;; See feature 'COMPILED.
-
 (define slib:load-compiled loadq)
 
 ;;; At this point SLIB:LOAD must be able to load SLIB files.
-
 (define slib:load slib:load-source)
 
 (define defmacro:eval slib:eval)
diff --git a/break.scm b/break.scm
index 4d18efc..d62eeb6 100644
--- a/break.scm
+++ b/break.scm
@@ -1,5 +1,5 @@
 ;;;; "break.scm" Breakpoints for debugging in Scheme.
-;;; Copyright (C) 1991, 1992, 1993, 1995 Aubrey Jaffer
+;;; Copyright (C) 1991, 1992, 1993, 1995, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -18,6 +18,7 @@
 ;each case.
 
 (require 'qp)
+(require 'alist)
 
 ;;;; BREAKPOINTS
 
@@ -29,8 +30,8 @@
 ;;; of breakpoint:continuation-stack and returns #f to it.
 
 (define breakpoint:continuation-stack '())
-
-(define debug:breakpoint
+;@
+(define breakpoint
   (let ((call-with-current-continuation call-with-current-continuation)
 	(apply apply) (qpn qpn)
 	(cons cons) (length length))
@@ -45,8 +46,8 @@
 		(debug:top-continuation
 		 (length breakpoint:continuation-stack))))))
 	(cond ((not (eq? ans breakpoint:continuation-stack)) ans))))))
-
-(define debug:continue
+;@
+(define continue
   (let ((null? null?) (car car) (cdr cdr))
     (lambda args
       (cond ((null? breakpoint:continuation-stack)
@@ -63,21 +64,17 @@
   (if (provided? 'abort)
       (lambda (val) (display val) (newline) (abort))
       (begin (display "; type (init-debug)") #f)))
-
+;@
 (define (init-debug)
   (call-with-current-continuation
    (lambda (x) (set! debug:top-continuation x))))
-
-(define breakpoint debug:breakpoint)
-(define bkpt debug:breakpoint)
-(define continue debug:continue)
-
+;@
 (define breakf
   (let ((null? null?)			;These bindings are so that
 	(not not)			;breakf will not break on parts
 	(car car) (cdr cdr)		;of itself.
 	(eq? eq?) (+ +) (zero? zero?) (modulo modulo)
-	(apply apply) (display display) (breakpoint debug:breakpoint))
+	(apply apply) (display display) (breakpoint breakpoint))
     (lambda (function . optname)
       ;; (set! trace:indent 0)
       (let ((name (if (null? optname) function (car optname))))
@@ -92,7 +89,7 @@
 
 ;;; the reason I use a symbol for debug:unbreak-object is so
 ;;; that functions can still be unbreaked if this file is read in twice.
-
+;@
 (define (unbreakf function)
   ;; (set! trace:indent 0)
   (function 'debug:unbreak-object))
@@ -101,7 +98,6 @@
 ;;; niceties like keeping track of breakd functions and dealing with
 ;;; redefinition.
 
-(require 'alist)
 (define break:adder (alist-associator eq?))
 (define break:deler (alist-remover eq?))
 
@@ -131,9 +127,8 @@
 	  ((eq? (cdr p) fun)
 	   (unbreakf fun))
 	  (else fun))))
-
 ;;;; Finally, the macros break and unbreak
-
+;@
 (defmacro break xs
   (if (null? xs)
       `(begin ,@(map (lambda (x) `(set! ,x (break:breakf ,x ',x)))
diff --git a/byte.scm b/byte.scm
index b34816d..b7e12da 100644
--- a/byte.scm
+++ b/byte.scm
@@ -1,15 +1,219 @@
 ;;; "byte.scm" small integers, not necessarily chars.
+; Copyright (c) 2001, 2002, 2003 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
 
-(define (byte-ref str ind) (char->integer (string-ref str ind)))
-(define (byte-set! str ind val) (string-set! str ind (integer->char val)))
+;;@code{(require 'byte)}
+;;@ftindex byte
+;;
+;;@noindent
+;;Some algorithms are expressed in terms of arrays of small integers.
+;;Using Scheme strings to implement these arrays is not portable vis-a-vis
+;;the correspondence between integers and characters and non-ascii
+;;character sets.  These functions abstract the notion of a @dfn{byte}.
+;;@cindex byte
+
+;;@body
+;;@2 must be a valid index of @1.  @0 returns byte @2 of @1 using
+;;zero-origin indexing.
+(define (byte-ref bytes k) (char->integer (string-ref bytes k)))
+
+;;@body
+;;@2 must be a valid index of @1, and @var{byte} must be a small
+;;nonnegative integer.  @0 stores @var{byte} in element @2 of @1 and
+;;returns an unspecified value.  @c <!>
+(define (byte-set! bytes k byte) (string-set! bytes k (integer->char byte)))
+
+;;@args k byte
+;;@args k
+;;@0 returns a newly allocated byte-array of length @1.  If @2 is
+;;given, then all elements of the byte-array are initialized to @2,
+;;otherwise the contents of the byte-array are unspecified.
 (define (make-bytes len . opt)
   (if (null? opt) (make-string len)
       (make-string len (integer->char (car opt)))))
+
+;;@args bytes
+;;@0 returns length of byte-array @1.
 (define bytes-length string-length)
+
+;;@args byte @dots{}
+;;Returns a newly allocated byte-array composed of the small
+;;nonnegative arguments.
+(define (bytes . args) (list->bytes args))
+
+;;@args bytes
+;;@0 returns a newly allocated list of the bytes that make up the
+;;given byte-array.
+(define (bytes->list bts) (map char->integer (string->list bts)))
+
+;;@args bytes
+;;@0 returns a newly allocated byte-array formed from the small
+;;nonnegative integers in the list @1.
+(define (list->bytes lst) (list->string (map integer->char lst)))
+
+;;@noindent
+;;@code{Bytes->list} and @code{list->bytes} are inverses so far as
+;;@code{equal?} is concerned.
+;;@findex equal?
+
+;;@args bytes
+;;Returns a newly allocated copy of the given @1.
+(define bytes-copy string-copy)
+
+;;@body
+;;Reverses the order of byte-array @1.
+(define (bytes-reverse! bytes)
+  (do ((idx 0 (+ 1 idx))
+       (xdi (+ -1 (bytes-length bytes)) (+ -1 xdi)))
+      ((>= idx xdi) bytes)
+    (let ((tmp (byte-ref bytes idx)))
+      (byte-set! bytes idx (byte-ref bytes xdi))
+      (byte-set! bytes xdi tmp))))
+
+;;@body
+;;Returns a newly allocated bytes-array consisting of the elements of
+;;@1 in reverse order.
+(define (bytes-reverse bytes)
+  (bytes-reverse! (bytes-copy bytes)))
+
+;;@noindent
+;;@cindex binary
+;;Input and output of bytes should be with ports opened in @dfn{binary}
+;;mode (@pxref{Input/Output}).  Calling @code{open-file} with @r{'rb} or
+;;@findex open-file
+;;@r{'wb} modes argument will return a binary port if the Scheme
+;;implementation supports it.
+
+;;@args byte port
+;;@args byte
+;;Writes the byte @1 (not an external representation of the byte) to
+;;the given @2 and returns an unspecified value.  The @2 argument may
+;;be omitted, in which case it defaults to the value returned by
+;;@code{current-output-port}.
+;;@findex current-output-port
 (define (write-byte byt . opt) (apply write-char (integer->char byt) opt))
+
+;;@args port
+;;@args
+;;Returns the next byte available from the input @1, updating the @1
+;;to point to the following byte.  If no more bytes are available, an
+;;end-of-file object is returned.  @1 may be omitted, in which case it
+;;defaults to the value returned by @code{current-input-port}.
+;;@findex current-input-port
 (define (read-byte . opt)
   (let ((c (apply read-char opt)))
     (if (eof-object? c) c (char->integer c))))
-(define (bytes . args) (list->bytes args))
-(define (bytes->list bts) (map char->integer (string->list bts)))
-(define (list->bytes lst) (list->string (map integer->char lst)))
+
+;;@noindent
+;;When reading and writing binary numbers with @code{read-bytes} and
+;;@code{write-bytes}, the sign of the length argument determines the
+;;endianness (order) of bytes.  Positive treats them as big-endian,
+;;the first byte input or output is highest order.  Negative treats
+;;them as little-endian, the first byte input or output is the lowest
+;;order.
+;;
+;;@noindent
+;;Once read in, SLIB treats byte sequences as big-endian.  The
+;;multi-byte sequences produced and used by number conversion routines
+;;@pxref{Byte/Number Conversions} are always big-endian.
+
+;;@args n port
+;;@args n
+;;@0 returns a newly allocated bytes-array filled with
+;;@code{(abs @var{n})} bytes read from @2.  If @1 is positive, then
+;;the first byte read is stored at index 0; otherwise the last byte
+;;read is stored at index 0.  Note that the length of the returned
+;;string will be less than @code{(abs @var{n})} if @2 reaches
+;;end-of-file.
+;;
+;;@2 may be omitted, in which case it defaults to the value returned
+;;by @code{current-input-port}.
+(define (read-bytes n . port)
+  (let* ((len (abs n))
+	 (byts (make-bytes len))
+	 (cnt (if (positive? n)
+		  (apply substring-read! byts 0 n port)
+		  (apply substring-read! byts (- n) 0 port))))
+    (if (= cnt len)
+	byts
+	(if (positive? n)
+	    (substring byts 0 cnt)
+	    (substring byts (- len cnt) len)))))
+
+;;@args bytes n port
+;;@args bytes n
+;;@0 writes @code{(abs @var{n})} bytes to output-port @3.  If @2 is
+;;positive, then the first byte written is index 0 of @1; otherwise
+;;the last byte written is index 0 of @1.  @0 returns an unspecified
+;;value.
+;;
+;;@3 may be omitted, in which case it defaults to the value returned
+;;by @code{current-output-port}.
+(define (write-bytes bytes n . port)
+  (if (positive? n)
+      (apply substring-write bytes 0 n port)
+      (apply substring-write bytes (- n) 0 port)))
+
+;;@noindent
+;;@code{substring-read!} and @code{substring-write} provide
+;;lower-level procedures for reading and writing blocks of bytes.  The
+;;relative size of @var{start} and @var{end} determines the order of
+;;writing.
+
+;;@args string start end port
+;;@args string start end
+;;Fills @1 with up to @code{(abs (- @var{start} @var{end}))} bytes
+;;read from @4.  The first byte read is stored at index @1.
+;;@0 returns the number of bytes read.
+;;
+;;@4 may be omitted, in which case it defaults to the value returned
+;;by @code{current-input-port}.
+(define (substring-read! string start end . port)
+  (if (>= end start)
+      (do ((idx start (+ 1 idx)))
+	  ((>= idx end) idx)
+	(let ((byt (apply read-byte port)))
+	  (cond ((eof-object? byt)
+		 (set! idx (+ -1 idx))
+		 (set! end idx))
+		(else (byte-set! string idx byt)))))
+      (do ((idx (+ -1 start) (+ -1 idx))
+	   (cnt 0 (+ 1 cnt)))
+	  ((< idx end) cnt)
+	(let ((byt (apply read-byte port)))
+	  (cond ((eof-object? byt)
+		 (set! idx start)
+		 (set! cnt (+ -1 cnt)))
+		(else (byte-set! string idx byt)))))))
+
+;;@args string start end port
+;;@args string start end
+;;@0 writes @code{(abs (- @var{start} @var{end}))} bytes to
+;;output-port @4.  The first byte written is index @2 of @1.  @0
+;;returns the number of bytes written.
+;;
+;;@4 may be omitted, in which case it defaults to the value returned
+;;by @code{current-output-port}.
+(define (substring-write string start end . port)
+  (if (>= end start)
+      (do ((idx start (+ 1 idx)))
+	  ((>= idx end) (- end start))
+	(apply write-byte (byte-ref string idx) port))
+      (do ((idx (+ -1 start) (+ -1 idx)))
+	  ((< idx end) (- start end))
+	(apply write-byte (byte-ref string idx) port))))
diff --git a/byte.txi b/byte.txi
new file mode 100644
index 0000000..01c725b
--- /dev/null
+++ b/byte.txi
@@ -0,0 +1,179 @@
+@code{(require 'byte)}
+@ftindex byte
+
+@noindent
+Some algorithms are expressed in terms of arrays of small integers.
+Using Scheme strings to implement these arrays is not portable vis-a-vis
+the correspondence between integers and characters and non-ascii
+character sets.  These functions abstract the notion of a @dfn{byte}.
+@cindex byte
+@cindex byte
+
+
+@defun byte-ref bytes k
+
+@var{k} must be a valid index of @var{bytes}.  @code{byte-ref} returns byte @var{k} of @var{bytes} using
+zero-origin indexing.
+@end defun
+
+@deffn {Procedure} byte-set! bytes k byte
+
+@var{k} must be a valid index of @var{bytes}, and @var{byte} must be a small
+nonnegative integer.  @code{byte-set!} stores @var{byte} in element @var{k} of @var{bytes} and
+returns an unspecified value.  @c <!>
+@end deffn
+
+@defun make-bytes k byte
+
+
+@defunx make-bytes k
+@code{make-bytes} returns a newly allocated byte-array of length @var{k}.  If @var{byte} is
+given, then all elements of the byte-array are initialized to @var{byte},
+otherwise the contents of the byte-array are unspecified.
+@end defun
+
+@defun bytes-length bytes
+
+@code{bytes-length} returns length of byte-array @var{bytes}.
+@end defun
+
+@defun bytes byte @dots{}
+
+Returns a newly allocated byte-array composed of the small
+nonnegative arguments.
+@end defun
+
+@defun bytes->list bytes
+
+@code{bytes->list} returns a newly allocated list of the bytes that make up the
+given byte-array.
+@end defun
+
+@defun list->bytes bytes
+
+@code{list->bytes} returns a newly allocated byte-array formed from the small
+nonnegative integers in the list @var{bytes}.
+@end defun
+@noindent
+@code{Bytes->list} and @code{list->bytes} are inverses so far as
+@code{equal?} is concerned.
+@findex equal?
+
+
+@defun bytes-copy bytes
+
+Returns a newly allocated copy of the given @var{bytes}.
+@end defun
+
+@deffn {Procedure} bytes-reverse! bytes
+
+Reverses the order of byte-array @var{bytes}.
+@end deffn
+
+@defun bytes-reverse bytes
+
+Returns a newly allocated bytes-array consisting of the elements of
+@var{bytes} in reverse order.
+@end defun
+@noindent
+@cindex binary
+Input and output of bytes should be with ports opened in @dfn{binary}
+@cindex binary
+mode (@pxref{Input/Output}).  Calling @code{open-file} with @r{'rb} or
+@findex open-file
+@r{'wb} modes argument will return a binary port if the Scheme
+implementation supports it.
+
+
+@defun write-byte byte port
+
+
+@defunx write-byte byte
+Writes the byte @var{byte} (not an external representation of the byte) to
+the given @var{port} and returns an unspecified value.  The @var{port} argument may
+be omitted, in which case it defaults to the value returned by
+@code{current-output-port}.
+@findex current-output-port
+@end defun
+
+@defun read-byte port
+
+
+@defunx read-byte
+Returns the next byte available from the input @var{port}, updating the @var{port}
+to point to the following byte.  If no more bytes are available, an
+end-of-file object is returned.  @var{port} may be omitted, in which case it
+defaults to the value returned by @code{current-input-port}.
+@findex current-input-port
+@end defun
+@noindent
+When reading and writing binary numbers with @code{read-bytes} and
+@code{write-bytes}, the sign of the length argument determines the
+endianness (order) of bytes.  Positive treats them as big-endian,
+the first byte input or output is highest order.  Negative treats
+them as little-endian, the first byte input or output is the lowest
+order.
+
+@noindent
+Once read in, SLIB treats byte sequences as big-endian.  The
+multi-byte sequences produced and used by number conversion routines
+@pxref{Byte/Number Conversions} are always big-endian.
+
+
+@defun read-bytes n port
+
+
+@defunx read-bytes n
+@code{read-bytes} returns a newly allocated bytes-array filled with
+@code{(abs @var{n})} bytes read from @var{port}.  If @var{n} is positive, then
+the first byte read is stored at index 0; otherwise the last byte
+read is stored at index 0.  Note that the length of the returned
+string will be less than @code{(abs @var{n})} if @var{port} reaches
+end-of-file.
+
+@var{port} may be omitted, in which case it defaults to the value returned
+by @code{current-input-port}.
+@end defun
+
+@defun write-bytes bytes n port
+
+
+@defunx write-bytes bytes n
+@code{write-bytes} writes @code{(abs @var{n})} bytes to output-port @var{port}.  If @var{n} is
+positive, then the first byte written is index 0 of @var{bytes}; otherwise
+the last byte written is index 0 of @var{bytes}.  @code{write-bytes} returns an unspecified
+value.
+
+@var{port} may be omitted, in which case it defaults to the value returned
+by @code{current-output-port}.
+@end defun
+@noindent
+@code{substring-read!} and @code{substring-write} provide
+lower-level procedures for reading and writing blocks of bytes.  The
+relative size of @var{start} and @var{end} determines the order of
+writing.
+
+
+@deffn {Procedure} substring-read! string start end port
+
+
+@deffnx {Procedure} substring-read! string start end
+Fills @var{string} with up to @code{(abs (- @var{start} @var{end}))} bytes
+read from @var{port}.  The first byte read is stored at index @var{string}.
+@code{substring-read!} returns the number of bytes read.
+
+@var{port} may be omitted, in which case it defaults to the value returned
+by @code{current-input-port}.
+@end deffn
+
+@defun substring-write string start end port
+
+
+@defunx substring-write string start end
+@code{substring-write} writes @code{(abs (- @var{start} @var{end}))} bytes to
+output-port @var{port}.  The first byte written is index @var{start} of @var{string}.  @code{substring-write}
+returns the number of bytes written.
+
+@var{port} may be omitted, in which case it defaults to the value returned
+by @code{current-output-port}.
+@end defun
diff --git a/bytenumb.scm b/bytenumb.scm
new file mode 100644
index 0000000..68ee748
--- /dev/null
+++ b/bytenumb.scm
@@ -0,0 +1,346 @@
+;;; "bytenumb.scm" Byte integer and IEEE floating-point conversions.
+; Copyright (c) 2003 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'byte)
+(require 'logical)
+
+(define bn:expt
+  (if (provided? 'inexact) expt
+      (lambda (n k) (if (negative? k) 0 (integer-expt n k)))))
+
+;;@code{(require 'byte-number)}
+;;@ftindex byte-number
+
+;;@noindent
+;;The multi-byte sequences produced and used by numeric conversion
+;;routines are always big-endian.  Endianness can be changed during
+;;reading and writing bytes using @code{read-bytes} and
+;;@code{write-bytes} @xref{Byte, read-bytes}.
+;;
+;;@noindent
+;;The sign of the length argument to bytes/integer conversion
+;;procedures determines the signedness of the number.
+
+;;@body
+;;Converts the first @code{(abs @var{n})} bytes of big-endian @1 array
+;;to an integer.  If @2 is negative then the integer coded by the
+;;bytes are treated as two's-complement (can be negative).
+;;
+;;@example
+;;(bytes->integer (bytes   0   0   0  15) -4)   @result{}          15
+;;(bytes->integer (bytes   0   0   0  15)  4)   @result{}          15
+;;(bytes->integer (bytes 255 255 255 255) -4)   @result{}          -1
+;;(bytes->integer (bytes 255 255 255 255)  4)   @result{}  4294967295
+;;(bytes->integer (bytes 128   0   0   0) -4)   @result{} -2147483648
+;;(bytes->integer (bytes 128   0   0   0)  4)   @result{}  2147483648
+;;@end example
+(define (bytes->integer bytes n)
+  (define cnt (abs n))
+  (cond ((zero? n) 0)
+	((and (negative? n) (> (byte-ref bytes 0) 127))
+	 (do ((lng (- 255 (byte-ref bytes 0))
+		   (+ (- 255 (byte-ref bytes idx)) (* 256 lng)))
+	      (idx 1 (+ 1 idx)))
+	     ((>= idx cnt) (- -1 lng))))
+	(else
+	 (do ((lng (byte-ref bytes 0)
+		   (+ (byte-ref bytes idx) (* 256 lng)))
+	      (idx 1 (+ 1 idx)))
+	     ((>= idx cnt) lng)))))
+
+;;@body
+;;Converts the integer @1 to a byte-array of @code{(abs @var{n})}
+;;bytes.  If @1 and @2 are both negative, then the bytes in the
+;;returned array are coded two's-complement.
+;;
+;;@example
+;;(bytes->list (integer->bytes          15 -4))   @result{} (0 0 0 15)
+;;(bytes->list (integer->bytes          15  4))   @result{} (0 0 0 15)
+;;(bytes->list (integer->bytes          -1 -4))   @result{} (255 255 255 255)
+;;(bytes->list (integer->bytes  4294967295  4))   @result{} (255 255 255 255)
+;;(bytes->list (integer->bytes -2147483648 -4))   @result{} (128 0 0 0)
+;;(bytes->list (integer->bytes  2147483648  4))   @result{} (128 0 0 0)
+;;@end example
+(define (integer->bytes n len)
+  (define bytes (make-bytes (abs len)))
+  (cond ((and (negative? n) (negative? len))
+	 (do ((idx (+ -1 (abs len)) (+ -1 idx))
+	      (res (- -1 n) (quotient res 256)))
+	     ((negative? idx) bytes)
+	   (byte-set! bytes idx (- 255 (modulo res 256)))))
+	(else
+	 (do ((idx (+ -1 (abs len)) (+ -1 idx))
+	      (res n (quotient res 256)))
+	     ((negative? idx) bytes)
+	   (byte-set! bytes idx (modulo res 256))))))
+
+;;@body
+;;@1 must be a 4-element byte-array.  @0 calculates and returns the
+;;value of @1 interpreted as a big-endian IEEE 4-byte (32-bit) number.
+(define (bytes->ieee-float bytes)
+  (define zero (or (string->number "0.0") 0))
+  (define one  (or (string->number "1.0") 1))
+  (define len (bytes-length bytes))
+  (define S (logbit? 7 (byte-ref bytes 0)))
+  (define E (+ (ash (logand #x7F (byte-ref bytes 0)) 1)
+	       (ash (logand #x80 (byte-ref bytes 1)) -7)))
+  (if (not (eqv? 4 len))
+      (slib:error 'bytes->ieee-float 'wrong 'length len))
+  (do ((F (byte-ref bytes (+ -1 len))
+	  (+ (byte-ref bytes idx) (/ F 256)))
+       (idx (+ -2 len) (+ -1 idx)))
+      ((<= idx 1)
+       (set! F (/ (+ (logand #x7F (byte-ref bytes 1)) (/ F 256)) 128))
+       (cond ((< 0 E 255) (* (if S -1 1) (bn:expt 2 (- E 127)) (+ 1 F)))
+	     ((zero? E)
+	      (if (zero? F)
+		  (if S (- zero) zero)
+		  (* (if S -1 1) (expt 2 -126) F)))
+	     ;; E must be 255
+	     ((not (zero? F)) (/ zero zero))
+	     (else (/ (if S (- one) one) zero))))))
+
+;;  S EEEEEEE E FFFFFFF FFFFFFFF FFFFFFFF
+;;  ========= ========= ======== ========
+;;  0 1       8 9                      31
+
+;;@example
+;;(bytes->ieee-float (bytes #x40    0 0 0))  @result{}  2.0
+;;(bytes->ieee-float (bytes #x40 #xd0 0 0))  @result{}  6.5
+;;(bytes->ieee-float (bytes #xc0 #xd0 0 0))  @result{} -6.5
+;;
+;;(bytes->ieee-float (bytes    0 #x80 0 0))  @result{} 11.754943508222875e-39
+;;(bytes->ieee-float (bytes    0 #x40 0 0))  @result{}  5.877471754111437e-39
+;;(bytes->ieee-float (bytes    0    0 0 1))  @result{}  1.401298464324817e-45
+;;
+;;(bytes->ieee-float (bytes #xff #x80 0 0))  @result{} -1/0
+;;(bytes->ieee-float (bytes #x7f #x80 0 0))  @result{}  1/0
+;;(bytes->ieee-float (bytes #x7f #x80 0 1))  @result{}  0/0
+;;@end example
+
+;;@body
+;;@1 must be a 8-element byte-array.  @0 calculates and returns the
+;;value of @1 interpreted as a big-endian IEEE 8-byte (64-bit) number.
+(define (bytes->ieee-double bytes)
+  (define zero (or (string->number "0.0") 0))
+  (define one  (or (string->number "1.0") 1))
+  (define len (bytes-length bytes))
+  (define S (logbit? 7 (byte-ref bytes 0)))
+  (define E (+ (ash (logand #x7F (byte-ref bytes 0)) 4)
+	       (ash (logand #xF0 (byte-ref bytes 1)) -4)))
+  (if (not (eqv? 8 len))
+      (slib:error 'bytes->ieee-double 'wrong 'length len))
+  (do ((F (byte-ref bytes (+ -1 len))
+	  (+ (byte-ref bytes idx) (/ F 256)))
+       (idx (+ -2 len) (+ -1 idx)))
+      ((<= idx 1)
+       (set! F (/ (+ (logand #x0F (byte-ref bytes 1)) (/ F 256)) 16))
+       (cond ((< 0 E 2047) (* (if S -1 1) (bn:expt 2 (- E 1023)) (+ 1 F)))
+	     ((zero? E)
+	      (if (zero? F)
+		  (if S (- zero) zero)
+		  (* (if S -1 1) (expt 2 -1022) F)))
+	     ;; E must be 2047
+	     ((not (zero? F)) (/ zero zero))
+	     (else (/ (if S (- one) one) zero))))))
+
+;;  S EEEEEEE EEEE FFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF
+;;  ========= ========= ======== ======== ======== ======== ======== ========
+;;  0 1         11 12                                                      63
+
+;;@example
+;;(bytes->ieee-double (bytes    0    0 0 0 0 0 0 0))  @result{}  0.0
+;;(bytes->ieee-double (bytes #x40    0 0 0 0 0 0 0))  @result{}  2
+;;(bytes->ieee-double (bytes #x40 #x1A 0 0 0 0 0 0))  @result{}  6.5
+;;(bytes->ieee-double (bytes #xC0 #x1A 0 0 0 0 0 0))  @result{} -6.5
+;;
+;;(bytes->ieee-double (bytes 0 8 0 0 0 0 0 0)) @result{} 11.125369292536006e-309
+;;(bytes->ieee-double (bytes 0 4 0 0 0 0 0 0)) @result{}  5.562684646268003e-309
+;;(bytes->ieee-double (bytes 0 0 0 0 0 0 0 1)) @result{}  4.0e-324
+;;
+;;(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0))  @result{} -1/0
+;;(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0))  @result{}  1/0
+;;(bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0))  @result{}  0/0
+;;@end example
+
+;;@args x
+;;Returns a 4-element byte-array encoding the IEEE single-precision
+;;floating-point of @1.
+(define ieee-float->bytes
+  (let ((zero (or (string->number "0.0") 0))
+	(exactify (if (provided? 'inexact) inexact->exact identity)))
+    (lambda (flt)
+      (define byts (make-bytes 4 0))
+      (define S (negative? flt))
+      (define (scale flt scl)
+	(cond ((zero? scl)            (out (/ flt 2) scl))
+	      ((zero? flt) byts)
+	      ((>= flt 16)
+	       (let ((flt/16 (/ flt 16)))
+		 (cond ((= flt/16 flt)
+			(byte-set! byts 0 (if S #xFF #x7F))
+			(byte-set! byts 1 (if (= flt (* zero flt)) #xC0 #x80))
+			byts)
+		       (else          (scale flt/16 (+ scl 4))))))
+	      ((>= flt 2)             (scale (/ flt 2) (+ scl 1)))
+	      ((and (>= scl 4)
+		    (< (* 16 flt) 1)) (scale (* flt 16) (+ scl -4)))
+	      ((< flt 1)              (scale (* flt 2) (+ scl -1)))
+	      (else                   (out (+ -1 flt) scl))))
+      (define (out flt scl)
+	(do ((flt (* 128 flt) (* 256 (- flt val)))
+	     (val (exactify (floor (* 128 flt)))
+		  (exactify (floor (* 256 (- flt val)))))
+	     (idx 1 (+ 1 idx)))
+	    ((> idx 3)
+	     (byte-set! byts 1 (bitwise-if #x80 (ash scl 7) (byte-ref byts 1)))
+	     (byte-set! byts 0 (+ (if S 128 0) (ash scl -1)))
+	     byts)
+	  (byte-set! byts idx val)))
+      (scale (abs flt) 127))))
+;;@example
+;;(bytes->list (ieee-float->bytes  2.0))                    @result{} (64    0 0 0)
+;;(bytes->list (ieee-float->bytes  6.5))                    @result{} (64  208 0 0)
+;;(bytes->list (ieee-float->bytes -6.5))                    @result{} (192 208 0 0)
+;;
+;;(bytes->list (ieee-float->bytes 11.754943508222875e-39))  @result{} (  0 128 0 0)
+;;(bytes->list (ieee-float->bytes  5.877471754111438e-39))  @result{} (  0  64 0 0)
+;;(bytes->list (ieee-float->bytes  1.401298464324817e-45))  @result{} (  0   0 0 1)
+;;
+;;(bytes->list (ieee-float->bytes -1/0))                    @result{} (255 128 0 0)
+;;(bytes->list (ieee-float->bytes  1/0))                    @result{} (127 128 0 0)
+;;(bytes->list (ieee-float->bytes  0/0))                    @result{} (127 128 0 1)
+;;@end example
+
+
+;;@args x
+;;Returns a 8-element byte-array encoding the IEEE double-precision
+;;floating-point of @1.
+(define ieee-double->bytes
+  (let ((zero (or (string->number "0.0") 0))
+	(exactify (if (provided? 'inexact) inexact->exact identity)))
+    (lambda (flt)
+      (define byts (make-bytes 8 0))
+      (define S (negative? flt))
+      (define (scale flt scl)
+	(cond ((zero? scl)            (out (/ flt 2) scl))
+	      ((zero? flt) byts)
+	      ((>= flt 16)
+	       (let ((flt/16 (/ flt 16)))
+		 (cond ((= flt/16 flt)
+			(byte-set! byts 0 (if S #xFF #x7F))
+			(byte-set! byts 1 (if (= flt (* zero flt)) #xF8 #xF0))
+			byts)
+		       (else          (scale flt/16 (+ scl 4))))))
+	      ((>= flt 2)             (scale (/ flt 2) (+ scl 1)))
+	      ((and (>= scl 4)
+		    (< (* 16 flt) 1)) (scale (* flt 16) (+ scl -4)))
+	      ((< flt 1)              (scale (* flt 2) (+ scl -1)))
+	      (else                   (out (+ -1 flt) scl))))
+      (define (out flt scl)
+	(do ((flt (* 16 flt) (* 256 (- flt val)))
+	     (val (exactify (floor (* 16 flt)))
+		  (exactify (floor (* 256 (- flt val)))))
+	     (idx 1 (+ 1 idx)))
+	    ((> idx 7)
+	     (byte-set! byts 1 (bitwise-if #xF0 (ash scl 4) (byte-ref byts 1)))
+	     (byte-set! byts 0 (+ (if S 128 0) (ash scl -4)))
+	     byts)
+	  (byte-set! byts idx val)))
+      (scale (abs flt) 1023))))
+;;@example
+;;(bytes->list (ieee-double->bytes  2.0)) @result{} (64    0 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes  6.5)) @result{} (64   26 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes -6.5)) @result{} (192  26 0 0 0 0 0 0)
+;;
+;;(bytes->list (ieee-double->bytes 11.125369292536006e-309))
+;;                                        @result{} (  0   8 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes  5.562684646268003e-309))
+;;                                        @result{} (  0   4 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes  4.0e-324))
+;;                                        @result{} (  0   0 0 0 0 0 0 1)
+;;
+;;(bytes->list (ieee-double->bytes -1/0)) @result{} (255 240 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes  1/0)) @result{} (127 240 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes  0/0)) @result{} (127 248 0 0 0 0 0 0)
+;;@end example
+
+;;@subsubheading Byte Collation Order
+;;
+;;@noindent
+;;The @code{string<?} ordering of big-endian byte-array
+;;representations of fixed and IEEE floating-point numbers agrees with
+;;the numerical ordering only when those numbers are non-negative.
+;;
+;;@noindent
+;;Straighforward modification of these formats can extend the
+;;byte-collating order to work for their entire ranges.  This
+;;agreement enables the full range of numbers as keys in
+;;@dfn{indexed-sequential-access-method} databases.
+
+;;@body
+;;Modifies sign bit of @1 so that @code{string<?} ordering of
+;;two's-complement byte-vectors matches numerical order.  @0 returns
+;;@1 and is its own functional inverse.
+(define (integer-byte-collate! byte-vector)
+  (byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0)))
+  byte-vector)
+
+;;@body
+;;Returns copy of @1 with sign bit modified so that @code{string<?}
+;;ordering of two's-complement byte-vectors matches numerical order.
+;;@0 is its own functional inverse.
+(define (integer-byte-collate byte-vector)
+  (integer-byte-collate! (bytes-copy byte-vector)))
+
+;;@body
+;;Modifies @1 so that @code{string<?} ordering of IEEE floating-point
+;;byte-vectors matches numerical order.  @0 returns @1.
+(define (IEEE-byte-collate! byte-vector)
+  (cond ((logtest #x80 (byte-ref byte-vector 0))
+	 (do ((idx (+ -1 (bytes-length byte-vector)) (+ -1 idx)))
+	     ((negative? idx))
+	   (byte-set! byte-vector idx
+		      (logxor #xFF (byte-ref byte-vector idx)))))
+	(else
+	 (byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0)))))
+  byte-vector)
+;;@body
+;;Given @1 modified by @code{IEEE-byte-collate!}, reverses the @1
+;;modifications.
+(define (IEEE-byte-decollate! byte-vector)
+  (cond ((not (logtest #x80 (byte-ref byte-vector 0)))
+	 (do ((idx (+ -1 (bytes-length byte-vector)) (+ -1 idx)))
+	     ((negative? idx))
+	   (byte-set! byte-vector idx
+		      (logxor #xFF (byte-ref byte-vector idx)))))
+	(else
+	 (byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0)))))
+  byte-vector)
+
+;;@body
+;;Returns copy of @1 encoded so that @code{string<?} ordering of IEEE
+;;floating-point byte-vectors matches numerical order.
+(define (IEEE-byte-collate byte-vector)
+  (IEEE-byte-collate! (bytes-copy byte-vector)))
+;;@body
+;;Given @1 returned by @code{IEEE-byte-collate}, reverses the @1
+;;modifications.
+(define (IEEE-byte-decollate byte-vector)
+  (IEEE-byte-decollate! (bytes-copy byte-vector)))
diff --git a/bytenumb.txi b/bytenumb.txi
new file mode 100644
index 0000000..67c340b
--- /dev/null
+++ b/bytenumb.txi
@@ -0,0 +1,181 @@
+@code{(require 'byte-number)}
+@ftindex byte-number
+
+@noindent
+The multi-byte sequences produced and used by numeric conversion
+routines are always big-endian.  Endianness can be changed during
+reading and writing bytes using @code{read-bytes} and
+@code{write-bytes} @xref{Byte, read-bytes}.
+
+@noindent
+The sign of the length argument to bytes/integer conversion
+procedures determines the signedness of the number.
+
+
+@defun bytes->integer bytes n
+
+Converts the first @code{(abs @var{n})} bytes of big-endian @var{bytes} array
+to an integer.  If @var{n} is negative then the integer coded by the
+bytes are treated as two's-complement (can be negative).
+
+@example
+(bytes->integer (bytes   0   0   0  15) -4)   @result{}          15
+(bytes->integer (bytes   0   0   0  15)  4)   @result{}          15
+(bytes->integer (bytes 255 255 255 255) -4)   @result{}          -1
+(bytes->integer (bytes 255 255 255 255)  4)   @result{}  4294967295
+(bytes->integer (bytes 128   0   0   0) -4)   @result{} -2147483648
+(bytes->integer (bytes 128   0   0   0)  4)   @result{}  2147483648
+@end example
+@end defun
+
+@defun integer->bytes n len
+
+Converts the integer @var{n} to a byte-array of @code{(abs @var{n})}
+bytes.  If @var{n} and @var{len} are both negative, then the bytes in the
+returned array are coded two's-complement.
+
+@example
+(bytes->list (integer->bytes          15 -4))   @result{} (0 0 0 15)
+(bytes->list (integer->bytes          15  4))   @result{} (0 0 0 15)
+(bytes->list (integer->bytes          -1 -4))   @result{} (255 255 255 255)
+(bytes->list (integer->bytes  4294967295  4))   @result{} (255 255 255 255)
+(bytes->list (integer->bytes -2147483648 -4))   @result{} (128 0 0 0)
+(bytes->list (integer->bytes  2147483648  4))   @result{} (128 0 0 0)
+@end example
+@end defun
+
+@defun bytes->ieee-float bytes
+
+@var{bytes} must be a 4-element byte-array.  @code{bytes->ieee-float} calculates and returns the
+value of @var{bytes} interpreted as a big-endian IEEE 4-byte (32-bit) number.
+@end defun
+@example
+(bytes->ieee-float (bytes #x40    0 0 0))  @result{}  2.0
+(bytes->ieee-float (bytes #x40 #xd0 0 0))  @result{}  6.5
+(bytes->ieee-float (bytes #xc0 #xd0 0 0))  @result{} -6.5
+
+(bytes->ieee-float (bytes    0 #x80 0 0))  @result{} 11.754943508222875e-39
+(bytes->ieee-float (bytes    0 #x40 0 0))  @result{}  5.877471754111437e-39
+(bytes->ieee-float (bytes    0    0 0 1))  @result{}  1.401298464324817e-45
+
+(bytes->ieee-float (bytes #xff #x80 0 0))  @result{} -1/0
+(bytes->ieee-float (bytes #x7f #x80 0 0))  @result{}  1/0
+(bytes->ieee-float (bytes #x7f #x80 0 1))  @result{}  0/0
+@end example
+
+
+@defun bytes->ieee-double bytes
+
+@var{bytes} must be a 8-element byte-array.  @code{bytes->ieee-double} calculates and returns the
+value of @var{bytes} interpreted as a big-endian IEEE 8-byte (64-bit) number.
+@end defun
+@example
+(bytes->ieee-double (bytes    0    0 0 0 0 0 0 0))  @result{}  0.0
+(bytes->ieee-double (bytes #x40    0 0 0 0 0 0 0))  @result{}  2
+(bytes->ieee-double (bytes #x40 #x1A 0 0 0 0 0 0))  @result{}  6.5
+(bytes->ieee-double (bytes #xC0 #x1A 0 0 0 0 0 0))  @result{} -6.5
+
+(bytes->ieee-double (bytes 0 8 0 0 0 0 0 0)) @result{} 11.125369292536006e-309
+(bytes->ieee-double (bytes 0 4 0 0 0 0 0 0)) @result{}  5.562684646268003e-309
+(bytes->ieee-double (bytes 0 0 0 0 0 0 0 1)) @result{}  4.0e-324
+
+(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0))  @result{} -1/0
+(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0))  @result{}  1/0
+(bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0))  @result{}  0/0
+@end example
+
+
+@defun ieee-float->bytes x
+
+Returns a 4-element byte-array encoding the IEEE single-precision
+floating-point of @var{x}.
+@end defun
+@example
+(bytes->list (ieee-float->bytes  2.0))                    @result{} (64    0 0 0)
+(bytes->list (ieee-float->bytes  6.5))                    @result{} (64  208 0 0)
+(bytes->list (ieee-float->bytes -6.5))                    @result{} (192 208 0 0)
+
+(bytes->list (ieee-float->bytes 11.754943508222875e-39))  @result{} (  0 128 0 0)
+(bytes->list (ieee-float->bytes  5.877471754111438e-39))  @result{} (  0  64 0 0)
+(bytes->list (ieee-float->bytes  1.401298464324817e-45))  @result{} (  0   0 0 1)
+
+(bytes->list (ieee-float->bytes -1/0))                    @result{} (255 128 0 0)
+(bytes->list (ieee-float->bytes  1/0))                    @result{} (127 128 0 0)
+(bytes->list (ieee-float->bytes  0/0))                    @result{} (127 128 0 1)
+@end example
+
+
+@defun ieee-double->bytes x
+
+Returns a 8-element byte-array encoding the IEEE double-precision
+floating-point of @var{x}.
+@end defun
+@example
+(bytes->list (ieee-double->bytes  2.0)) @result{} (64    0 0 0 0 0 0 0)
+(bytes->list (ieee-double->bytes  6.5)) @result{} (64   26 0 0 0 0 0 0)
+(bytes->list (ieee-double->bytes -6.5)) @result{} (192  26 0 0 0 0 0 0)
+
+(bytes->list (ieee-double->bytes 11.125369292536006e-309))
+                                        @result{} (  0   8 0 0 0 0 0 0)
+(bytes->list (ieee-double->bytes  5.562684646268003e-309))
+                                        @result{} (  0   4 0 0 0 0 0 0)
+(bytes->list (ieee-double->bytes  4.0e-324))
+                                        @result{} (  0   0 0 0 0 0 0 1)
+
+(bytes->list (ieee-double->bytes -1/0)) @result{} (255 240 0 0 0 0 0 0)
+(bytes->list (ieee-double->bytes  1/0)) @result{} (127 240 0 0 0 0 0 0)
+(bytes->list (ieee-double->bytes  0/0)) @result{} (127 248 0 0 0 0 0 0)
+@end example
+
+@subsubheading Byte Collation Order
+
+@noindent
+The @code{string<?} ordering of big-endian byte-array
+representations of fixed and IEEE floating-point numbers agrees with
+the numerical ordering only when those numbers are non-negative.
+
+@noindent
+Straighforward modification of these formats can extend the
+byte-collating order to work for their entire ranges.  This
+agreement enables the full range of numbers as keys in
+@dfn{indexed-sequential-access-method} databases.
+@cindex indexed-sequential-access-method
+
+
+@deffn {Procedure} integer-byte-collate! byte-vector
+
+Modifies sign bit of @var{byte-vector} so that @code{string<?} ordering of
+two's-complement byte-vectors matches numerical order.  @code{integer-byte-collate!} returns
+@var{byte-vector} and is its own functional inverse.
+@end deffn
+
+@defun integer-byte-collate byte-vector
+
+Returns copy of @var{byte-vector} with sign bit modified so that @code{string<?}
+ordering of two's-complement byte-vectors matches numerical order.
+@code{integer-byte-collate} is its own functional inverse.
+@end defun
+
+@deffn {Procedure} ieee-byte-collate! byte-vector
+
+Modifies @var{byte-vector} so that @code{string<?} ordering of IEEE floating-point
+byte-vectors matches numerical order.  @code{ieee-byte-collate!} returns @var{byte-vector}.
+@end deffn
+
+@deffn {Procedure} ieee-byte-decollate! byte-vector
+
+Given @var{byte-vector} modified by @code{IEEE-byte-collate!}, reverses the @var{byte-vector}
+modifications.
+@end deffn
+
+@defun ieee-byte-collate byte-vector
+
+Returns copy of @var{byte-vector} encoded so that @code{string<?} ordering of IEEE
+floating-point byte-vectors matches numerical order.
+@end defun
+
+@defun ieee-byte-decollate byte-vector
+
+Given @var{byte-vector} returned by @code{IEEE-byte-collate}, reverses the @var{byte-vector}
+modifications.
+@end defun
diff --git a/chap.scm b/chap.scm
index 0d8f99f..1766720 100644
--- a/chap.scm
+++ b/chap.scm
@@ -1,5 +1,5 @@
 ;;;; "chap.scm" Chapter ordering		-*-scheme-*-
-;;; Copyright 1992, 1993, 1994 Aubrey Jaffer
+;;; Copyright 1992, 1993, 1994, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -22,6 +22,27 @@
 ;;; section of the string consists of consecutive numeric or
 ;;; consecutive aphabetic characters.
 
+
+;;@code{(require 'chapter-order)}
+;;@ftindex chapter-order
+;;
+;;The @samp{chap:} functions deal with strings which are ordered like
+;;chapter numbers (or letters) in a book.  Each section of the string
+;;consists of consecutive numeric or consecutive aphabetic characters of
+;;like case.
+
+;;@args string1 string2
+;;Returns #t if the first non-matching run of alphabetic upper-case or
+;;the first non-matching run of alphabetic lower-case or the first
+;;non-matching run of numeric characters of @var{string1} is
+;;@code{string<?} than the corresponding non-matching run of
+;;characters of @var{string2}.
+;;
+;;@example
+;;(chap:string<? "a.9" "a.10")                    @result{} #t
+;;(chap:string<? "4c" "4aa")                      @result{} #t
+;;(chap:string<? "Revised^@{3.99@}" "Revised^@{4@}")  @result{} #t
+;;@end example
 (define (chap:string<? s1 s2)
   (let ((l1 (string-length s1))
 	(l2 (string-length s2)))
@@ -78,6 +99,11 @@
 		      (length-race (+ 1 i) ctype1 (char<? c1 c2)))
 		     (else (char<? c1 c2)))))))
     (delimited 0)))
+;;@body
+;;Implement the corresponding chapter-order predicates.
+(define (chap:string>? string1 string2) (chap:string<? string2 string1))
+(define (chap:string<=? string1 string2) (not (chap:string<? string2 string1)))
+(define (chap:string>=? string1 string2) (not (chap:string<? string1 string2)))
 
 (define chap:char-incr (- (char->integer #\2) (char->integer #\1)))
 
@@ -120,6 +146,19 @@
 	   s)
 	  (else (slib:error "inc-string error" s p)))))
 
+;;@args string
+;;Returns the next string in the @emph{chapter order}.  If @var{string}
+;;has no alphabetic or numeric characters,
+;;@code{(string-append @var{string} "0")} is returnd.  The argument to
+;;chap:next-string will always be @code{chap:string<?} than the result.
+;;
+;;@example
+;;(chap:next-string "a.9")                @result{} "a.10"
+;;(chap:next-string "4c")                 @result{} "4d"
+;;(chap:next-string "4z")                 @result{} "4aa"
+;;(chap:next-string "Revised^@{4@}")        @result{} "Revised^@{5@}"
+;;
+;;@end example
 (define (chap:next-string s)
   (do ((i (+ -1 (string-length s)) (+ -1 i)))
       ((or (negative? i)
@@ -144,7 +183,3 @@
 ;	   (display " > ")
 ;	   (display s2)
 ;	   (newline)))))
-
-(define (chap:string>? s1 s2) (chap:string<? s2 s1))
-(define (chap:string>=? s1 s2) (not (chap:string<? s1 s2)))
-(define (chap:string<=? s1 s2) (not (chap:string<? s2 s1)))
diff --git a/chap.txi b/chap.txi
new file mode 100644
index 0000000..514decd
--- /dev/null
+++ b/chap.txi
@@ -0,0 +1,46 @@
+@code{(require 'chapter-order)}
+@ftindex chapter-order
+
+The @samp{chap:} functions deal with strings which are ordered like
+chapter numbers (or letters) in a book.  Each section of the string
+consists of consecutive numeric or consecutive aphabetic characters of
+like case.
+
+
+@defun chap:string<? string1 string2
+
+Returns #t if the first non-matching run of alphabetic upper-case or
+the first non-matching run of alphabetic lower-case or the first
+non-matching run of numeric characters of @var{string1} is
+@code{string<?} than the corresponding non-matching run of
+characters of @var{string2}.
+
+@example
+(chap:string<? "a.9" "a.10")                    @result{} #t
+(chap:string<? "4c" "4aa")                      @result{} #t
+(chap:string<? "Revised^@{3.99@}" "Revised^@{4@}")  @result{} #t
+@end example
+@end defun
+
+@defun chap:string>? string1 string2
+@defunx chap:string<=? string1 string2
+@defunx chap:string>=? string1 string2
+
+Implement the corresponding chapter-order predicates.
+@end defun
+
+@defun chap:next-string string
+
+Returns the next string in the @emph{chapter order}.  If @var{string}
+has no alphabetic or numeric characters,
+@code{(string-append @var{string} "0")} is returnd.  The argument to
+chap:next-string will always be @code{chap:string<?} than the result.
+
+@example
+(chap:next-string "a.9")                @result{} "a.10"
+(chap:next-string "4c")                 @result{} "4d"
+(chap:next-string "4z")                 @result{} "4aa"
+(chap:next-string "Revised^@{4@}")        @result{} "Revised^@{5@}"
+
+@end example
+@end defun
diff --git a/charplot.scm b/charplot.scm
index 3e0e019..890fca0 100644
--- a/charplot.scm
+++ b/charplot.scm
@@ -1,5 +1,5 @@
 ;;;; "charplot.scm", plotting on character devices for Scheme
-;;; Copyright (C) 1992, 1993 Aubrey Jaffer
+;;; Copyright (C) 1992, 1993, 2001, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -17,155 +17,283 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
-(require 'sort)
 (require 'printf)
 (require 'array)
 (require 'array-for-each)
+(require 'multiarg/and-)
 
-(define charplot:rows 24)
-(define charplot:columns (output-port-width (current-output-port)))
+;;;@ These determine final graph size.
+(define charplot:dimensions #f)
 
-(define charplot:xborder #\_)
-(define charplot:yborder #\|)
-(define charplot:xaxchar #\-)
-(define charplot:yaxchar #\:)
-(define charplot:curve1 #\*)
-(define charplot:xtick #\.)
+;;; The left margin and legends
+(define charplot:left-margin 12)
 
-(define charplot:height (- charplot:rows 5))
-(define charplot:width (- charplot:columns 15))
+(define char:xborder #\_)
+(define char:yborder #\|)
+(define char:xaxis   #\-)
+(define char:yaxis   #\:)
+(define char:xtick   #\.)
+(define char:bar     #\I)
+(define char:curves  "*+x@#$%&='")
 
-(define (charplot:printn! n char)
-  (cond ((positive? n)
-	 (write-char char)
-	 (charplot:printn! (+ n -1) char))))
+;;;Converts X to a string whose length is at most MWID.
+(define (charplot:number->string x mwid)
+  (define str (sprintf #f "%g" x))
+  (if (> (string-length str) mwid)
+      (substring str 0 mwid)
+      str))
 
-(define (charplot:center-print! str width)
-  (let ((lpad (quotient (- width (string-length str)) 2)))
-    (charplot:printn! lpad #\ )
-    (display str)
-    (charplot:printn! (- width (+ (string-length  str) lpad)) #\ )))
-
-(define (charplot:number->string x)
-  (sprintf #f "%g" x))
-
-(define (charplot:scale-it z scale)
-  (if (and (exact? z) (integer? z))
-      (quotient (* z (car scale)) (cadr scale))
-      (inexact->exact (round (/ (* z (car scale)) (cadr scale))))))
+;;;SCALE is a list of numerator and denominator.
+(define charplot:scale-it
+  (if (provided? 'inexact)
+      (lambda (z scale)
+	(inexact->exact (round (/ (* z (car scale)) (cadr scale)))))
+      (lambda (z scale)
+	(quotient (+ (* z (car scale)) (quotient (cadr scale) 2))
+		  (cadr scale)))))
 
+;;; Given the width or height (in characters) and the data-span,
+;;; returns a list of numerator and denominator (NUM DEN) suitable for
+;;; passing as a second argument to CHARPLOT:SCALE-IT.
+;;;
+;;; NUM will be 1, 2, 3, 4, 5, 6, or 8 times a power of ten.
+;;; DEN will be a power of ten.
+;;;
+;;; num   isize
+;;; === < =====
+;;; den   delta
 (define (charplot:find-scale isize delta)
-  (define (fs2)
-    (cond ((< (* delta 8) isize) 8)
-	  ((< (* delta 6) isize) 6)
-	  ((< (* delta 5) isize) 5)
-	  ((< (* delta 4) isize) 4)
-	  ((< (* delta 3) isize) 3)
-	  ((< (* delta 2) isize) 2)
-	  (else 1)))
   (cond ((zero? delta) (set! delta 1))
 	((inexact? delta) (set! isize (exact->inexact isize))))
-  (do ((d 1 (* d 10)))
+  (do ((d 1 (* d 10))
+       (isize isize (* isize 10)))
       ((<= delta isize)
-       (do ((n 1 (* n 10)))
+       (do ((n 1 (* n 10))
+	    (delta delta (* delta 10)))
 	   ((>= (* delta 10) isize)
-	    (list (* n (fs2)) d))
-	 (set! delta (* delta 10))))
-    (set! isize (* isize 10))))
+	    (list (* n (cond ((<= (* delta 8) isize) 8)
+			     ((<= (* delta 6) isize) 6)
+			     ((<= (* delta 5) isize) 5)
+			     ((<= (* delta 4) isize) 4)
+			     ((<= (* delta 3) isize) 3)
+			     ((<= (* delta 2) isize) 2)
+			     (else 1)))
+		  d))))))
+
+(define (charplot:make-array)
+  (let ((height (or (and charplot:dimensions (car charplot:dimensions))
+		    (output-port-height (current-output-port))))
+	(width (or  (and charplot:dimensions (cadr charplot:dimensions))
+		    (output-port-width (current-output-port)))))
+    (define pra (create-array " "  height width))
+    ;;Put newlines on right edge
+    (do ((idx (+ -1 height) (+ -1 idx)))
+	((negative? idx))
+      (array-set! pra #\newline idx (+ -1 width)))
+    pra))
 
-(define (charplot:iplot! data xlabel ylabel xmin xscale ymin yscale)
+;;;Creates and initializes character array with axes, scales, and
+;;;labels.
+(define (charplot:init-array pra xlabel ylabel xmin xscale ymin yscale)
+  (define plot-height (- (car (array-dimensions pra)) 3))
+  (define plot-width (- (cadr (array-dimensions pra)) charplot:left-margin 4))
   (define xaxis (- (charplot:scale-it ymin yscale)))
   (define yaxis (- (charplot:scale-it xmin xscale)))
-  (charplot:center-print! ylabel 11)
-  (charplot:printn! (+ charplot:width 1) charplot:xborder)
-  (newline)
-  (set! data (sort! data (lambda (x y) (if (= (cdr x) (cdr y))
-					   (< (car x) (car y))
-					   (> (cdr x) (cdr y))))))
-  (do ((ht (- charplot:height 1) (- ht 1)))
+  (define xstep (if (zero? (modulo (car xscale) 3)) 12 10))
+  ;;CL is the left edge of WIDTH field
+  (define (center-field str width ln cl)
+    (define len (string-length str))
+    (if (< width len)
+	(center-field (substring str 0 width) width ln cl)
+	(do ((cnt (+ -1 len) (+ -1 cnt))
+	     (adx (+ (quotient (- width len) 2) cl) (+ 1 adx))
+	     (idx 0 (+ 1 idx)))
+	    ((negative? cnt))
+	  (array-set! pra (string-ref str idx) ln adx))))
+
+  ;;x and y labels
+  (center-field ylabel (+ charplot:left-margin -1) 0 0)
+  (center-field xlabel (+ -1 charplot:left-margin) (+ 2 plot-height) 0)
+
+  ;;horizontal borders, x-axis, and ticking
+  (let ((xstep/2 (quotient (- xstep 2) 2)))
+    (define faxis (modulo (+ charplot:left-margin yaxis) xstep))
+    (define faxis/2 (modulo (+ charplot:left-margin yaxis xstep/2 1) xstep))
+    (define xfudge (modulo yaxis xstep))
+    (do ((cl (+ charplot:left-margin -1) (+ 1 cl)))
+	((>= cl (+ plot-width charplot:left-margin)))
+      (array-set! pra char:xborder 0 cl)
+      (array-set! pra
+		  (cond ((eqv? faxis (modulo cl xstep)) char:yaxis)
+			((eqv? faxis/2 (modulo cl xstep)) char:xtick)
+			(else char:xborder))
+		  (+ 1 plot-height) cl)
+      (if (<= 0 xaxis plot-height)
+	  (array-set! pra char:xaxis (- plot-height xaxis) cl)))
+
+    ;;horizontal coordinates
+    (do ((i xfudge (+ i xstep))
+	 (cl (+ charplot:left-margin xfudge (- xstep/2)) (+ xstep cl)))
+	((> i plot-width))
+      (center-field (charplot:number->string
+		     (/ (* (- i yaxis) (cadr xscale))
+			(car xscale))
+		     xstep)
+		    xstep (+ 2 plot-height) cl)))
+
+  ;;vertical borders and y-axis
+  (do ((ht plot-height (- ht 1)))
+      ((negative? ht))
+    (array-set! pra char:yborder (+ 1 ht) (+ charplot:left-margin -2))
+    (array-set! pra char:yborder (+ 1 ht) (+ charplot:left-margin plot-width))
+    (if (< -1 yaxis plot-width)
+	(array-set! pra char:yaxis (+ 1 ht) (+ charplot:left-margin yaxis))))
+
+  ;;vertical ticking and coordinates
+  (do ((ht (- plot-height 1) (- ht 1))
+       (ln 1 (+ 1 ln)))
       ((negative? ht))
-    (let ((a (make-string (+ charplot:width 1)
-			  (if (= ht xaxis) charplot:xaxchar #\ )))
-	  (ystep (if (= 1 (gcd (car yscale) 3)) 2 3)))
-      (string-set! a charplot:width charplot:yborder)
-      (if (< -1 yaxis charplot:width) (string-set! a yaxis charplot:yaxchar))
-      (do ()
-	  ((or (null? data) (not (>= (cdar data) ht))))
-	(string-set! a (caar data) charplot:curve1)
-	(set! data (cdr data)))
+    (let ((ystep (if (zero? (modulo (car yscale) 3)) 3 2)))
       (if (zero? (modulo (- ht xaxis) ystep))
 	  (let* ((v (charplot:number->string (/ (* (- ht xaxis) (cadr yscale))
-						(car yscale))))
-		 (l (string-length v)))
-	    (if (> l 10)
-		(display (substring v 0 10))
-		(begin
-		  (charplot:printn! (- 10 l) #\ )
-		  (display v)))
-	    (display charplot:yborder)
-	    (display charplot:xaxchar))
-	  (begin
-	    (charplot:printn! 10 #\ )
-	    (display charplot:yborder)
-	    (display #\ )))
-      (display a) (newline)))
-  (let* ((xstep (if (= 1 (gcd (car xscale) 3)) 10 12))
-	 (xstep/2 (quotient (- xstep 2) 2))
-	 (fudge (modulo yaxis xstep)))
-    (charplot:printn! 10 #\ ) (display charplot:yborder)
-    (charplot:printn! (+ 1 fudge) charplot:xborder)
-    (display charplot:yaxchar)
-    (do ((i fudge (+ i xstep)))
-	((> (+ i xstep) charplot:width)
-	 (charplot:printn! (modulo (- charplot:width (+ i 1)) xstep)
-			   charplot:xborder))
-      (charplot:printn! xstep/2 charplot:xborder)
-      (display charplot:xtick)
-      (charplot:printn! xstep/2 charplot:xborder)
-      (display charplot:yaxchar))
-    (display charplot:yborder) (newline)
-    (charplot:center-print! xlabel (+ 12 fudge (- xstep/2)))
-    (do ((i fudge (+ i xstep)))
-	((>= i charplot:width))
-      (charplot:center-print! (charplot:number->string
-			       (/ (* (- i yaxis) (cadr xscale))
-				  (car xscale)))
-			      xstep))
-    (newline)))
-
-(define (charplot:plot! data xlabel ylabel)
+						(car yscale))
+					     (+ charplot:left-margin -2)))
+		 (len (string-length v)))
+	    (center-field v len ln (- charplot:left-margin 2 len)) ;Actually flush right
+	    (array-set! pra char:xaxis ln (+ charplot:left-margin -1))))))
+  ;;return initialized array
+  pra)
+
+(define (charplot:array->list ra)
+  (define dims (array-dimensions ra))
+  (do ((idx (+ -1 (car dims)) (+ -1 idx))
+       (cols '() (cons (do ((jdx (+ -1 (cadr dims)) (+ -1 jdx))
+			    (row '() (cons (array-ref ra idx jdx) row)))
+			   ((negative? jdx) row))
+		       cols)))
+      ((negative? idx) cols)))
+
+;;;Converts data to list of coordinates (list).
+(define (charplot:data->lists data)
   (cond ((array? data)
 	 (case (array-rank data)
-	   ((1) (set! data (map cons
-				(let ((ra (apply make-array #f
+	   ((1) (set! data (map list
+				(let ((ra (apply create-array '#()
 						 (array-shape data))))
 				  (array-index-map! ra identity)
-				  (array->list ra))
-				(array->list data))))
-	   ((2) (set! data (map (lambda (lst) (cons (car lst) (cadr lst)))
-				(array->list data)))))))
-  (let* ((xmax (apply max (map car data)))
-	 (xmin (apply min (map car data)))
-	 (xscale (charplot:find-scale charplot:width (- xmax xmin)))
-	 (ymax (apply max (map cdr data)))
-	 (ymin (apply min (map cdr data)))
-	 (yscale (charplot:find-scale charplot:height (- ymax ymin)))
-	 (ixmin (charplot:scale-it xmin xscale))
-	 (iymin (charplot:scale-it ymin yscale)))
-    (charplot:iplot! (map (lambda (p)
-			    (cons (- (charplot:scale-it (car p) xscale) ixmin)
-				  (- (charplot:scale-it (cdr p) yscale) iymin)))
-			  data)
-		     xlabel ylabel xmin xscale ymin yscale)))
-
-(define (plot-function! func vlo vhi . npts)
-  (set! npts (if (null? npts) 100 (car npts)))
-  (let ((dats (make-array 0.0 npts 2)))
+				  (charplot:array->list ra))
+				(charplot:array->list data))))
+	   ((2) (set! data (charplot:array->list data)))))
+	((and (pair? (car data)) (not (list? (car data))))
+	 (set! data (map (lambda (lst) (list (car lst) (cdr lst))) data))))
+  (cond ((list? (cadar data))
+	 (set! data (map (lambda (lst) (cons (car lst) (cadr lst))) data))))
+  data)
+
+;;;An extremum is a list of the maximum and minimum values.
+;;;COORDINATE-EXTREMA returns a rank-length list of these.
+(define (coordinate-extrema data)
+  (define extrema (map (lambda (x) (list x x)) (car data)))
+  (for-each (lambda (lst)
+	      (set! extrema (map (lambda (x max-min)
+				   (list (max x (car max-min))
+					 (min x (cadr max-min))))
+				 lst extrema)))
+	    data)
+  extrema)
+
+;;;Count occurrences of numbers within evenly spaced ranges; and return
+;;;lists of coordinates for graph.
+(define (histobins data plot-width)
+  (define datcnt (length data))
+  (define xmax (apply max data))
+  (define xmin (apply min data))
+  (if (null? data)
+      '()
+      (let* ((xscale (charplot:find-scale plot-width (- xmax xmin)))
+	     (actual-width (- (charplot:scale-it xmax xscale)
+			      (charplot:scale-it xmin xscale)
+			      -1)))
+	(define ix-min (charplot:scale-it xmin xscale))
+	(define xinc (/ (- xmax xmin) actual-width))
+	(define bins (make-vector actual-width 0))
+	(for-each (lambda (x)
+		    (define idx (- (charplot:scale-it x xscale) ix-min))
+		    (if (< -1 idx actual-width)
+			(vector-set! bins idx (+ 1 (vector-ref bins idx)))
+			(slib:error x (/ (* x (car xscale)) (cadr xscale))
+				    (+ ix-min idx))))
+		  data)
+	(map list
+	     (do ((idx (+ -1 (vector-length bins)) (+ -1 idx))
+		  (xvl xmax (- xvl xinc))
+		  (lst '() (cons xvl lst)))
+		 ((negative? idx) lst))
+	     (vector->list bins)))))
+
+;;;@ Plot histogram of DATA.
+(define (histograph data label)
+  (if (vector? data) (set! data (vector->list data)))
+  (charplot:plot (histobins data
+			    (- (or (and charplot:dimensions
+					(cadr charplot:dimensions))
+				   (output-port-width (current-output-port)))
+			       charplot:left-margin 3))
+		 label "" #t))
+
+(define (charplot:plot data xlabel ylabel . histogram?)
+  (define clen (string-length char:curves))
+  (set! histogram? (if (null? histogram?) #f (car histogram?)))
+  (set! data (charplot:data->lists data))
+  (let* ((pra (charplot:make-array))
+	 (plot-height (- (car (array-dimensions pra)) 3))
+	 (plot-width (- (cadr (array-dimensions pra)) charplot:left-margin 4))
+	 (extrema (coordinate-extrema data))
+	 (xmax (caar extrema))
+	 (xmin (cadar extrema))
+	 (ymax (apply max (map car (cdr extrema))))
+	 (ymin (apply min (map cadr (cdr extrema))))
+	 (xscale (charplot:find-scale plot-width (- xmax xmin)))
+	 (yscale (charplot:find-scale plot-height (- ymax ymin)))
+	 (ix-min (- (charplot:scale-it xmin xscale) charplot:left-margin))
+	 (ybot (charplot:scale-it ymin yscale))
+	 (iy-min (+ ybot plot-height)))
+    (charplot:init-array pra xlabel ylabel xmin xscale ymin yscale)
+    (for-each (if histogram?
+		  ;;display data bars
+		  (lambda (datum)
+		    (define x (- (charplot:scale-it (car datum) xscale) ix-min))
+		    (do ((y (charplot:scale-it (cadr datum) yscale) (+ -1 y)))
+			((< y ybot))
+		      (array-set! pra char:bar (- iy-min y) x)))
+		  ;;display data points
+		  (lambda (datum)
+		    (define x (- (charplot:scale-it (car datum) xscale) ix-min))
+		    (define cdx 0)
+		    (for-each
+		     (lambda (y)
+		       (array-set! pra (string-ref char:curves cdx)
+				   (- iy-min (charplot:scale-it y yscale)) x)
+		       (set! cdx (modulo (+ 1 cdx) clen)))
+		     (cdr datum))))
+	      data)
+    (array-for-each write-char pra)
+    (if (not (eqv? #\newline (apply array-ref pra
+				    (map cadr (array-shape pra)))))
+	(newline))))
+
+(define (charplot:plot-function func vlo vhi . npts)
+  (set! npts (if (null? npts) 64 (car npts)))
+  (let ((dats (create-array (Ar64) npts 2)))
     (array-index-map! (make-shared-array dats (lambda (idx) (list idx 0)) npts)
-		      (lambda (idx) (+ vlo (* (- vhi vlo) (/ idx npts)))))
+		      (lambda (idx)
+			(+ vlo (* (- vhi vlo) (/ idx (+ -1 npts))))))
     (array-map! (make-shared-array dats (lambda (idx) (list idx 1)) npts)
 		func
 		(make-shared-array dats (lambda (idx) (list idx 0)) npts))
-    (charplot:plot! dats "" "")))
-
-(define plot! charplot:plot!)
+    (charplot:plot dats "" "")))
+;@
+(define (plot . args)
+  (if (procedure? (car args))
+      (apply charplot:plot-function args)
+      (apply charplot:plot args)))
diff --git a/chez.init b/chez.init
index 44acba8..19d796e 100644
--- a/chez.init
+++ b/chez.init
@@ -8,36 +8,30 @@
 
 ;;; (software-type) should be set to the generic operating system type.
 ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
-
 (define (software-type) 'UNIX)
 
 ;;; (scheme-implementation-type) should return the name of the scheme
 ;;; implementation loading this file.
-
 (define (scheme-implementation-type) 'chez)
 
 ;;; (scheme-implementation-home-page) should return a (string) URI
 ;;; (Uniform Resource Identifier) for this scheme implementation's home
 ;;; page; or false if there isn't one.
-
 (define (scheme-implementation-home-page)
-  "http://www.cs.indiana.edu/chezscheme/")
+  "http://www.scheme.com/")
 
 ;;; (scheme-implementation-version) should return a string describing
 ;;; the version the scheme implementation loading this file.
-
 (define (scheme-implementation-version) "6.0a")
 
 ;;; (implementation-vicinity) should be defined to be the pathname of
 ;;; the directory where any auxillary files to your Scheme
 ;;; implementation reside.
-
 (define implementation-vicinity
   (lambda () "/usr/unsup/scheme/chez/"))
 
 ;;; (library-vicinity) should be defined to be the pathname of the
 ;;; directory where files of Scheme library functions reside.
-
 (define library-vicinity
   (let ((library-path
 	 (or
@@ -55,14 +49,18 @@
 ;;; (home-vicinity) should return the vicinity of the user's HOME
 ;;; directory, the directory which typically contains files which
 ;;; customize a computer environment for a user.
-
-(define home-vicinity
-  (let ((home-path (getenv "HOME")))
-    (lambda () home-path)))
+(define (home-vicinity)
+  (let ((home (getenv "HOME")))
+    (and home
+	 (case (software-type)
+	   ((UNIX COHERENT MS-DOS)	;V7 unix has a / on HOME
+	    (if (eqv? #\/ (string-ref home (+ -1 (string-length home))))
+		home
+		(string-append home "/")))
+	   (else home)))))
 
 ;;; *FEATURES* should be set to a list of symbols describing features
 ;;; of this implementation.  Suggestions for features are:
-
 (define *features*
       '(
 	source				;can load scheme source files
@@ -72,7 +70,7 @@
 
 		       ;; Scheme report features
 
-	rev5-report			;conforms to
+	r5rs				;conforms to
 	eval				;R5RS two-argument eval
 	values				;R5RS multiple values
 	dynamic-wind			;R5RS dynamic-wind
@@ -86,11 +84,11 @@
 					;STRING-FILL!, LIST->VECTOR,
 					;VECTOR->LIST, and VECTOR-FILL!
 
-	rev4-report			;conforms to
+	r4rs				;conforms to
 
 	ieee-p1178			;conforms to
 
-	rev3-report			;conforms to
+	r3rs				;conforms to
 
 ;	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
 					;SUBSTRING-MOVE-RIGHT!,
@@ -101,7 +99,7 @@
 
 	multiarg/and-			;/ and - can take more than 2 args.
 	with-file			;has WITH-INPUT-FROM-FILE and
-					;WITH-OUTPUT-FROM-FILE
+					;WITH-OUTPUT-TO-FILE
 	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 ;	ieee-floating-point		;conforms to IEEE Standard 754-1985
 					;IEEE Standard for Binary
@@ -132,13 +130,12 @@
 
 		  ;; Implementation Specific features
 
+;;;	random				;Not the same as SLIB random
 	fluid-let
-	random
 	))
 
 ;;; (OUTPUT-PORT-WIDTH <port>) returns the number of graphic characters
 ;;; that can reliably be displayed on one line of the standard output port.
-
 (define output-port-width
   (lambda arg
     (let ((env-width-string (getenv "COLUMNS")))
@@ -154,7 +151,6 @@
 
 ;;; (OUTPUT-PORT-HEIGHT <port>) returns the number of lines of text that
 ;;; can reliably be displayed simultaneously in the standard output port.
-
 (define output-port-height
   (lambda arg
     (let ((env-height-string (getenv "LINES")))
@@ -189,6 +185,37 @@
 ;; port to be transferred all the way out to its ultimate destination.
 (define force-output flush-output-port)
 
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r rb) (open-input-file filename))
+    ((w wb) (open-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+(define (close-port port)
+  (cond ((input-port? port)
+	 (close-input-port port)
+	 (if (output-port? port) (close-output-port port)))
+	((output-port? port) (close-output-port port))
+	(else (slib:error 'close-port 'port? port))))
+
+(define (browse-url url)
+  (define (try cmd end) (zero? (system (string-append cmd url end))))
+  (or (try "netscape-remote -remote 'openURL(" ")'")
+      (try "netscape -remote 'openURL(" ")'")
+      (try "netscape '" "'&")
+      (try "netscape '" "'")))
+
 ;;; "rationalize" adjunct procedures.
 (define (find-ratio x e)
   (let ((rat (rationalize x e)))
@@ -218,7 +245,7 @@
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Error: " cep)
-      (for-each (lambda (x) (display x cep)) args)
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args)
       (error #f ""))))
 
 ;;; define these as appropriate for your system.
@@ -269,17 +296,14 @@
 
 ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
 ;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
-
 (define (slib:load-source f) (load (string-append f ".scm")))
 
 ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
 ;;; by compiling "foo.scm" if this implementation can compile files.
 ;;; See feature 'COMPILED.
-
 (define slib:load-compiled load)
 
 ;;; At this point SLIB:LOAD must be able to load SLIB files.
-
 (define slib:load slib:load-source)
 
 ;;; The following make procedures in Chez Scheme compatible with
@@ -309,7 +333,6 @@
 
 ;;; Chez's (FORMAT F . A) corresponds to SLIB's (FORMAT #F F . A)
 ;;; See the FORMAT feature.
-
 (define chez:format format)
 
 (define format
@@ -325,7 +348,6 @@
 ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
 ;;; port versions of CALL-WITH-INPUT-FILE and CALL-WITH-OUTPUT-FILE.
 ;;; See the STRING-PORT feature.
-
 (define call-with-output-string
   (lambda (f)
     (let ((outsp (open-output-string)))
@@ -397,10 +419,9 @@
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Warn: " cep)
-      (for-each (lambda (x) (display x cep)) args))))
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
 
 ;;; Load the REQUIRE package.
-
 (slib:load (in-vicinity (library-vicinity) "require"))
 
 ;; end of chez.init
diff --git a/cie1931.xyz b/cie1931.xyz
new file mode 100644
index 0000000..ce74214
--- /dev/null
+++ b/cie1931.xyz
@@ -0,0 +1,82 @@
+;;; "cie1931.xyz" CIE XYZ(1931) Spectra from 380.nm to 780.nm.
+380 0.0014 0.0000 0.0065
+385 0.0022 0.0001 0.0105
+390 0.0042 0.0001 0.0201
+395 0.0076 0.0002 0.0362
+400 0.0143 0.0004 0.0679
+405 0.0232 0.0006 0.1102
+410 0.0435 0.0012 0.2074
+415 0.0776 0.0022 0.3713
+420 0.1344 0.0040 0.6456
+425 0.2148 0.0073 1.0391
+430 0.2839 0.0116 1.3856
+435 0.3285 0.0168 1.6230
+440 0.3483 0.0230 1.7471
+445 0.3481 0.0298 1.7826
+450 0.3362 0.0380 1.7721
+455 0.3187 0.0480 1.7441
+460 0.2908 0.0600 1.6692
+465 0.2511 0.0739 1.5281
+470 0.1954 0.0910 1.2876
+475 0.1421 0.1126 1.0419
+480 0.0956 0.1390 0.8130
+485 0.0580 0.1693 0.6162
+490 0.0320 0.2080 0.4652
+495 0.0147 0.2586 0.3533
+500 0.0049 0.3230 0.2720
+505 0.0024 0.4073 0.2123
+510 0.0093 0.5030 0.1582
+515 0.0291 0.6082 0.1117
+520 0.0633 0.7100 0.0782
+525 0.1096 0.7932 0.0573
+530 0.1655 0.8620 0.0422
+535 0.2257 0.9149 0.0298
+540 0.2904 0.9540 0.0203
+545 0.3597 0.9803 0.0134
+550 0.4334 0.9950 0.0087
+555 0.5121 1.0000 0.0057
+560 0.5945 0.9950 0.0039
+565 0.6784 0.9786 0.0027
+570 0.7621 0.9520 0.0021
+575 0.8425 0.9154 0.0018
+580 0.9163 0.8700 0.0017
+585 0.9786 0.8163 0.0014
+590 1.0263 0.7570 0.0011
+595 1.0567 0.6949 0.0010
+600 1.0622 0.6310 0.0008
+605 1.0456 0.5668 0.0006
+610 1.0026 0.5030 0.0003
+615 0.9384 0.4412 0.0002
+620 0.8544 0.3810 0.0002
+625 0.7514 0.3210 0.0001
+630 0.6424 0.2650 0.0000
+635 0.5419 0.2170 0.0000
+640 0.4479 0.1750 0.0000
+645 0.3608 0.1382 0.0000
+650 0.2835 0.1070 0.0000
+655 0.2187 0.0816 0.0000
+660 0.1649 0.0610 0.0000
+665 0.1212 0.0446 0.0000
+670 0.0874 0.0320 0.0000
+675 0.0636 0.0232 0.0000
+680 0.0468 0.0170 0.0000
+685 0.0329 0.0119 0.0000
+690 0.0227 0.0082 0.0000
+695 0.0158 0.0057 0.0000
+700 0.0114 0.0041 0.0000
+705 0.0081 0.0029 0.0000
+710 0.0058 0.0021 0.0000
+715 0.0041 0.0015 0.0000
+720 0.0029 0.0010 0.0000
+725 0.0020 0.0007 0.0000
+730 0.0014 0.0005 0.0000
+735 0.0010 0.0004 0.0000
+740 0.0007 0.0002 0.0000
+745 0.0005 0.0002 0.0000
+750 0.0003 0.0001 0.0000
+755 0.0002 0.0001 0.0000
+760 0.0002 0.0001 0.0000
+765 0.0001 0.0000 0.0000
+770 0.0001 0.0000 0.0000
+775 0.0001 0.0000 0.0000
+780 0.0000 0.0000 0.0000
diff --git a/cie1964.xyz b/cie1964.xyz
new file mode 100644
index 0000000..89fa244
--- /dev/null
+++ b/cie1964.xyz
@@ -0,0 +1,82 @@
+;;; "cie1964.xyz" CIE XYZ(1964) Spectra from 380.nm to 780.nm.
+380 0.0002 0.0000 0.0007
+385 0.0007 0.0001 0.0029
+390 0.0024 0.0003 0.0105
+395 0.0072 0.0008 0.0323
+400 0.0191 0.0020 0.0860
+405 0.0434 0.0045 0.1971
+410 0.0847 0.0088 0.3894
+415 0.1406 0.0145 0.6568
+420 0.2045 0.0214 0.9725
+425 0.2647 0.0295 1.2825
+430 0.3147 0.0387 1.5535
+435 0.3577 0.0496 1.7985
+440 0.3837 0.0621 1.9673
+445 0.3867 0.0747 2.0273
+450 0.3707 0.0895 1.9948
+455 0.3430 0.1063 1.9007
+460 0.3023 0.1282 1.7454
+465 0.2541 0.1528 1.5549
+470 0.1956 0.1852 1.3176
+475 0.1323 0.2199 1.0302
+480 0.0805 0.2536 0.7721
+485 0.0411 0.2977 0.5701
+490 0.0162 0.3391 0.4153
+495 0.0051 0.3954 0.3024
+500 0.0038 0.4608 0.2185
+505 0.0154 0.5314 0.1592
+510 0.0375 0.6067 0.1120
+515 0.0714 0.6857 0.0822
+520 0.1177 0.7618 0.0607
+525 0.1730 0.8233 0.0431
+530 0.2365 0.8752 0.0305
+535 0.3042 0.9238 0.0206
+540 0.3768 0.9620 0.0137
+545 0.4516 0.9822 0.0079
+550 0.5298 0.9918 0.0040
+555 0.6161 0.9991 0.0011
+560 0.7052 0.9973 0.0000
+565 0.7938 0.9824 0.0000
+570 0.8787 0.9556 0.0000
+575 0.9512 0.9152 0.0000
+580 1.0142 0.8689 0.0000
+585 1.0743 0.8256 0.0000
+590 1.1185 0.7774 0.0000
+595 1.1343 0.7204 0.0000
+600 1.1240 0.6583 0.0000
+605 1.0891 0.5939 0.0000
+610 1.0305 0.5280 0.0000
+615 0.9507 0.4618 0.0000
+620 0.8563 0.3981 0.0000
+625 0.7549 0.3396 0.0000
+630 0.6475 0.2835 0.0000
+635 0.5351 0.2283 0.0000
+640 0.4316 0.1798 0.0000
+645 0.3437 0.1402 0.0000
+650 0.2683 0.1076 0.0000
+655 0.2043 0.0812 0.0000
+660 0.1526 0.0603 0.0000
+665 0.1122 0.0441 0.0000
+670 0.0813 0.0318 0.0000
+675 0.0579 0.0226 0.0000
+680 0.0409 0.0159 0.0000
+685 0.0286 0.0111 0.0000
+690 0.0199 0.0077 0.0000
+695 0.0138 0.0054 0.0000
+700 0.0096 0.0037 0.0000
+705 0.0066 0.0026 0.0000
+710 0.0046 0.0018 0.0000
+715 0.0031 0.0012 0.0000
+720 0.0022 0.0008 0.0000
+725 0.0015 0.0006 0.0000
+730 0.0010 0.0004 0.0000
+735 0.0007 0.0003 0.0000
+740 0.0005 0.0002 0.0000
+745 0.0004 0.0001 0.0000
+750 0.0003 0.0001 0.0000
+755 0.0002 0.0001 0.0000
+760 0.0001 0.0000 0.0000
+765 0.0001 0.0000 0.0000
+770 0.0001 0.0000 0.0000
+775 0.0000 0.0000 0.0000
+780 0.0000 0.0000 0.0000
diff --git a/cltime.scm b/cltime.scm
index d22922c..76d06d2 100644
--- a/cltime.scm
+++ b/cltime.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -22,13 +22,13 @@
 (require 'posix-time)
 
 (define time:1900 (time:invert time:gmtime '#(0 0 0 1 0 0 #f #f 0 0 "GMT")))
-
+;@
 (define (get-decoded-time)
   (decode-universal-time (get-universal-time)))
-
+;@
 (define (get-universal-time)
   (difftime (current-time) time:1900))
-
+;@
 (define (decode-universal-time utime . tzarg)
   (let ((tv (apply time:split
 		   (offset-time time:1900 utime)
@@ -48,7 +48,7 @@
 	 (inexact->exact (/ (vector-ref tv 9) 3600))
 	 (/ (vector-ref tv 9) 3600))	;time-zone	[-24..24]
      )))
-
+;@
 (define (encode-universal-time second minute hour date month year . tzarg)
   (let* ((tz (if (null? tzarg)
 		 (tzset)
diff --git a/coerce.scm b/coerce.scm
index 83023df..7505f3f 100644
--- a/coerce.scm
+++ b/coerce.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
diff --git a/collect.scm b/collect.scm
index 35a333d..05bc2cf 100644
--- a/collect.scm
+++ b/collect.scm
@@ -2,49 +2,55 @@
 ; COPYRIGHT (c) Kenneth Dickey 1992
 ;
 ;               This software may be used for any purpose whatever
-;               without warrantee of any kind.
+;               without warranty of any kind.
 ; AUTHOR        Ken Dickey
 ; DATE          1992 September 1
 ; LAST UPDATED  1992 September 2
 ; NOTES         Expository (optimizations & checks elided).
 ;               Requires YASOS (Yet Another Scheme Object System).
 
+(require 'object)
 (require 'yasos)
 
-(define-operation (collect:collection? obj)
+(define collect:size size)
+(define collect:print print)
+
+;@
+(define-operation (collection? obj)
  ;; default
   (cond
     ((or (list? obj) (vector? obj) (string? obj)) #t)
     (else #f)
 ) )
-
-(define (collect:empty? collection) (zero? (yasos:size collection)))
-
-(define-operation (collect:gen-elts <collection>) ;; return element generator
+;@
+(define (empty? collection) (zero? (collect:size collection)))
+;@
+(define-operation (gen-elts <collection>) ;; return element generator
   ;; default behavior
   (cond                      ;; see utilities, below, for generators
     ((vector? <collection>) (collect:vector-gen-elts <collection>))
     ((list?   <collection>) (collect:list-gen-elts   <collection>))
     ((string? <collection>) (collect:string-gen-elts <collection>))
     (else
-     (slib:error "Operation not supported: GEN-ELTS " (yasos:print obj #f)))
+     (slib:error 'gen-elts 'operation-not-supported
+		 (collect:print <collection> #f)))
 ) )
-
-(define-operation (collect:gen-keys collection)
+;@
+(define-operation (gen-keys collection)
   (if (or (vector? collection) (list? collection) (string? collection))
-      (let ( (max+1 (yasos:size collection)) (index 0) )
+      (let ( (max+1 (collect:size collection)) (index 0) )
 	 (lambda ()
             (cond
 	      ((< index max+1)
 	       (set! index (collect:add1 index))
 	       (collect:sub1 index))
-	      (else (slib:error "no more keys in generator"))
+	      (else (slib:error 'no-more 'keys 'in 'generator))
       ) ) )
-      (slib:error "Operation not handled: GEN-KEYS " collection)
+      (slib:error 'gen-keys 'operation-not-handled collection)
 ) )
-
-(define (collect:do-elts <proc> . <collections>)
-  (let ( (max+1 (yasos:size (car <collections>)))
+;@
+(define (do-elts <proc> . <collections>)
+  (let ( (max+1 (collect:size (car <collections>)))
          (generators (map collect:gen-elts <collections>))
        )
     (let loop ( (counter 0) )
@@ -56,9 +62,9 @@
           (else 'unspecific)  ; done
     )  )
 ) )
-
-(define (collect:do-keys <proc> . <collections>)
-  (let ( (max+1 (yasos:size (car <collections>)))
+;@
+(define (do-keys <proc> . <collections>)
+  (let ( (max+1 (collect:size (car <collections>)))
          (generators (map collect:gen-keys <collections>))
        )
     (let loop ( (counter 0) )
@@ -70,11 +76,11 @@
           (else 'unspecific)  ; done
     )  )
 ) )
-
-(define (collect:map-elts <proc> . <collections>)
-  (let ( (max+1 (yasos:size (car <collections>)))
+;@
+(define (map-elts <proc> . <collections>)
+  (let ( (max+1 (collect:size (car <collections>)))
          (generators (map collect:gen-elts <collections>))
-         (vec (make-vector (yasos:size (car <collections>))))
+         (vec (make-vector (collect:size (car <collections>))))
        )
     (let loop ( (index 0) )
        (cond
@@ -85,11 +91,11 @@
           (else vec)  ; done
     )  )
 ) )
-
-(define (collect:map-keys <proc> . <collections>)
-  (let ( (max+1 (yasos:size (car <collections>)))
+;@
+(define (map-keys <proc> . <collections>)
+  (let ( (max+1 (collect:size (car <collections>)))
          (generators (map collect:gen-keys <collections>))
-	 (vec (make-vector (yasos:size (car <collections>))))
+	 (vec (make-vector (collect:size (car <collections>))))
        )
     (let loop ( (index 0) )
        (cond
@@ -100,18 +106,18 @@
           (else vec)  ; done
     )  )
 ) )
-
-(define-operation (collect:for-each-key <collection> <proc>)
+;@
+(define-operation (for-each-key <collection> <proc>)
    ;; default
    (collect:do-keys <proc> <collection>)  ;; talk about lazy!
 )
-
-(define-operation (collect:for-each-elt <collection> <proc>)
+;@
+(define-operation (for-each-elt <collection> <proc>)
    (collect:do-elts <proc> <collection>)
 )
-
-(define (collect:reduce <proc> <seed> . <collections>)
-   (let ( (max+1 (yasos:size (car <collections>)))
+;@
+(define (reduce <proc> <seed> . <collections>)
+   (let ( (max+1 (collect:size (car <collections>)))
           (generators (map collect:gen-elts <collections>))
         )
      (let loop ( (count 0) )
@@ -127,9 +133,9 @@
 
 
 
-;; pred true for every elt?
-(define (collect:every? <pred?> . <collections>)
-   (let ( (max+1 (yasos:size (car <collections>)))
+;;@ pred true for every elt?
+(define (every? <pred?> . <collections>)
+   (let ( (max+1 (collect:size (car <collections>)))
           (generators (map collect:gen-elts <collections>))
         )
      (let loop ( (count 0) )
@@ -143,9 +149,9 @@
      ) )
 )  )
 
-;; pred true for any elt?
-(define (collect:any? <pred?> . <collections>)
-   (let ( (max+1 (yasos:size (car <collections>)))
+;;@ pred true for any elt?
+(define (any? <pred?> . <collections>)
+   (let ( (max+1 (collect:size (car <collections>)))
           (generators (map collect:gen-elts <collections>))
         )
      (let loop ( (count 0) )
@@ -191,7 +197,7 @@
 (define (collect:list-gen-elts <list>)
   (lambda ()
      (if (null? <list>)
-         (slib:error "No more list elements in generator")
+         (slib:error 'no-more 'list-elements 'in 'generator)
          (let ( (elt (car <list>)) )
            (set! <list> (cdr <list>))
            elt))
@@ -200,7 +206,7 @@
 ;; generator for vector elements
 (define (collect:make-vec-gen-elts <accessor>)
   (lambda (vec)
-    (let ( (max+1 (yasos:size vec))
+    (let ( (max+1 (collect:size vec))
            (index 0)
          )
       (lambda ()
@@ -219,18 +225,9 @@
 
 ;;; exports:
 
-(define collection? collect:collection?)
-(define empty? collect:empty?)
-(define gen-keys collect:gen-keys)
-(define gen-elts collect:gen-elts)
-(define do-elts collect:do-elts)
-(define do-keys collect:do-keys)
-(define map-elts collect:map-elts)
-(define map-keys collect:map-keys)
-(define for-each-key collect:for-each-key)
-(define for-each-elt collect:for-each-elt)
-(define reduce collect:reduce)		; reduce is also in comlist.scm
-(define every? collect:every?)
-(define any? collect:any?)
+(define collect:gen-keys gen-keys)
+(define collect:gen-elts gen-elts)
+(define collect:do-elts do-elts)
+(define collect:do-keys do-keys)
 
 ;;                        --- E O F "collect.oo" ---                    ;;
diff --git a/collectx.scm b/collectx.scm
new file mode 100644
index 0000000..7ba46b9
--- /dev/null
+++ b/collectx.scm
@@ -0,0 +1,247 @@
+;"collect.scm" Sample collection operations
+; COPYRIGHT (c) Kenneth Dickey 1992
+;
+;               This software may be used for any purpose whatever
+;               without warranty of any kind.
+; AUTHOR        Ken Dickey
+; DATE          1992 September 1
+; LAST UPDATED  1992 September 2
+; NOTES         Expository (optimizations & checks elided).
+;               Requires YASOS (Yet Another Scheme Object System).
+
+(require 'object)
+(require 'yasos)
+
+(define collect:size size)
+(define collect:print print)
+
+;@
+(define collection?
+  (make-generic-method
+    (lambda (obj!2)
+      (cond ((or (list? obj!2)
+                 (vector? obj!2)
+                 (string? obj!2))
+             #t)
+            (else #f)))))
+;@
+(define empty?
+  (lambda (collection!1)
+    (zero? (collect:size collection!1))))
+;@
+(define gen-elts
+  (make-generic-method
+    (lambda (<collection>!2)
+      (cond ((vector? <collection>!2)
+             (collect:vector-gen-elts <collection>!2))
+            ((list? <collection>!2)
+             (collect:list-gen-elts <collection>!2))
+            ((string? <collection>!2)
+             (collect:string-gen-elts <collection>!2))
+            (else
+             (slib:error
+               'gen-elts
+               'operation-not-supported
+               (collect:print <collection>!2 #f)))))))
+;@
+(define gen-keys
+  (make-generic-method
+    (lambda (collection!2)
+      (if (or (vector? collection!2)
+              (list? collection!2)
+              (string? collection!2))
+        (let ((max+1!3 (collect:size collection!2))
+              (index!3 0))
+          (lambda ()
+            (cond ((< index!3 max+1!3)
+                   (set! index!3 (collect:add1 index!3))
+                   (collect:sub1 index!3))
+                  (else (slib:error 'no-more 'keys 'in 'generator)))))
+        (slib:error
+          'gen-keys
+          'operation-not-handled
+          collection!2)))))
+;@
+(define do-elts
+  (lambda (<proc>!1 . <collections>!1)
+    (let ((max+1!2 (collect:size (car <collections>!1)))
+          (generators!2
+            (map collect:gen-elts <collections>!1)))
+      (let loop!4 ((counter!3 0))
+        (cond ((< counter!3 max+1!2)
+               (apply <proc>!1
+                      (map (lambda (g!5) (g!5)) generators!2))
+               (loop!4 (collect:add1 counter!3)))
+              (else 'unspecific))))))
+;@
+(define do-keys
+  (lambda (<proc>!1 . <collections>!1)
+    (let ((max+1!2 (collect:size (car <collections>!1)))
+          (generators!2
+            (map collect:gen-keys <collections>!1)))
+      (let loop!4 ((counter!3 0))
+        (cond ((< counter!3 max+1!2)
+               (apply <proc>!1
+                      (map (lambda (g!5) (g!5)) generators!2))
+               (loop!4 (collect:add1 counter!3)))
+              (else 'unspecific))))))
+;@
+(define map-elts
+  (lambda (<proc>!1 . <collections>!1)
+    (let ((max+1!2 (collect:size (car <collections>!1)))
+          (generators!2
+            (map collect:gen-elts <collections>!1))
+          (vec!2 (make-vector
+                   (collect:size (car <collections>!1)))))
+      (let loop!4 ((index!3 0))
+        (cond ((< index!3 max+1!2)
+               (vector-set!
+                 vec!2
+                 index!3
+                 (apply <proc>!1
+                        (map (lambda (g!5) (g!5)) generators!2)))
+               (loop!4 (collect:add1 index!3)))
+              (else vec!2))))))
+;@
+(define map-keys
+  (lambda (<proc>!1 . <collections>!1)
+    (let ((max+1!2 (collect:size (car <collections>!1)))
+          (generators!2
+            (map collect:gen-keys <collections>!1))
+          (vec!2 (make-vector
+                   (collect:size (car <collections>!1)))))
+      (let loop!4 ((index!3 0))
+        (cond ((< index!3 max+1!2)
+               (vector-set!
+                 vec!2
+                 index!3
+                 (apply <proc>!1
+                        (map (lambda (g!5) (g!5)) generators!2)))
+               (loop!4 (collect:add1 index!3)))
+              (else vec!2))))))
+;@
+(define for-each-key
+  (make-generic-method
+    (lambda (<collection>!2 <proc>!2)
+      (collect:do-keys <proc>!2 <collection>!2))))
+;@
+(define for-each-elt
+  (make-generic-method
+    (lambda (<collection>!2 <proc>!2)
+      (collect:do-elts <proc>!2 <collection>!2))))
+;@
+(define reduce
+  (lambda (<proc>!1 <seed>!1 . <collections>!1)
+    (let ((max+1!2 (collect:size (car <collections>!1)))
+          (generators!2
+            (map collect:gen-elts <collections>!1)))
+      (let loop!4 ((count!3 0))
+        (cond ((< count!3 max+1!2)
+               (set! <seed>!1
+                 (apply <proc>!1
+                        <seed>!1
+                        (map (lambda (g!5) (g!5)) generators!2)))
+               (loop!4 (collect:add1 count!3)))
+              (else <seed>!1))))))
+
+
+
+;;@ pred true for every elt?
+(define every?
+  (lambda (<pred?>!1 . <collections>!1)
+    (let ((max+1!2 (collect:size (car <collections>!1)))
+          (generators!2
+            (map collect:gen-elts <collections>!1)))
+      (let loop!4 ((count!3 0))
+        (cond ((< count!3 max+1!2)
+               (if (apply <pred?>!1
+                          (map (lambda (g!5) (g!5)) generators!2))
+                 (loop!4 (collect:add1 count!3))
+                 #f))
+              (else #t))))))
+
+;;@ pred true for any elt?
+(define any?
+  (lambda (<pred?>!1 . <collections>!1)
+    (let ((max+1!2 (collect:size (car <collections>!1)))
+          (generators!2
+            (map collect:gen-elts <collections>!1)))
+      (let loop!4 ((count!3 0))
+        (cond ((< count!3 max+1!2)
+               (if (apply <pred?>!1
+                          (map (lambda (g!5) (g!5)) generators!2))
+                 #t
+                 (loop!4 (collect:add1 count!3))))
+              (else #f))))))
+
+
+;; MISC UTILITIES
+
+(define collect:add1
+  (lambda (obj!1) (+ obj!1 1)))
+(define collect:sub1
+  (lambda (obj!1) (- obj!1 1)))
+
+;; Nota Bene:  list-set! is bogus for element 0
+
+(define collect:list-set!
+  (lambda (<list>!1 <index>!1 <value>!1)
+    (letrec ((set-loop!3
+               (lambda (last!4 this!4 idx!4)
+                 (cond ((zero? idx!4)
+                        (set-cdr! last!4 (cons <value>!1 (cdr this!4)))
+                        <list>!1)
+                       (else
+                        (set-loop!3
+                          (cdr last!4)
+                          (cdr this!4)
+                          (collect:sub1 idx!4)))))))
+      (if (zero? <index>!1)
+        (cons <value>!1 (cdr <list>!1))
+        (set-loop!3
+          <list>!1
+          (cdr <list>!1)
+          (collect:sub1 <index>!1))))))
+
+(add-setter list-ref collect:list-set!)
+  ; for (setter list-ref)
+
+
+;; generator for list elements
+(define collect:list-gen-elts
+  (lambda (<list>!1)
+    (lambda ()
+      (if (null? <list>!1)
+        (slib:error
+          'no-more
+          'list-elements
+          'in
+          'generator)
+        (let ((elt!3 (car <list>!1)))
+          (begin (set! <list>!1 (cdr <list>!1)) elt!3))))))
+
+;; generator for vector elements
+(define collect:make-vec-gen-elts
+  (lambda (<accessor>!1)
+    (lambda (vec!2)
+      (let ((max+1!3 (collect:size vec!2)) (index!3 0))
+        (lambda ()
+          (cond ((< index!3 max+1!3)
+                 (set! index!3 (collect:add1 index!3))
+                 (<accessor>!1 vec!2 (collect:sub1 index!3)))
+                (else #f)))))))
+
+(define collect:vector-gen-elts
+  (collect:make-vec-gen-elts vector-ref))
+
+(define collect:string-gen-elts
+  (collect:make-vec-gen-elts string-ref))
+
+;;; exports:
+
+(define collect:gen-keys gen-keys)
+(define collect:gen-elts gen-elts)
+(define collect:do-elts do-elts)
+(define collect:do-keys do-keys)
+
+;;                        --- E O F "collect.oo" ---                    ;;
diff --git a/color.scm b/color.scm
new file mode 100644
index 0000000..7f80fe5
--- /dev/null
+++ b/color.scm
@@ -0,0 +1,674 @@
+;;; "color.scm" color data-type
+;Copyright 2001, 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'record)
+(require 'color-space)
+(require 'scanf)
+(require 'printf)
+(require 'string-case)
+
+(define color:rtd
+  (make-record-type "color"
+		    '(encoding		;symbol
+		      coordinates	;list of coordinates
+		      parameter		;white-point or precision
+		      )))
+
+(define color:construct
+  (record-constructor color:rtd '(encoding coordinates parameter)))
+
+(define color:encoding (record-accessor color:rtd 'encoding))
+
+(define color:coordinates (record-accessor color:rtd 'coordinates))
+
+(define color:parameter (record-accessor color:rtd 'parameter))
+(define color:precision color:parameter)
+
+(define color:color? (record-predicate color:rtd))
+
+(define (color:white-point color)
+  (case (color:encoding color)
+    ((CIEXYZ
+      RGB709
+      sRGB
+      xRGB
+      e-sRGB) CIEXYZ:D65)
+    ((L*a*b*
+      L*u*v*
+      L*C*h)
+     (or (color:parameter color) CIEXYZ:D65))))
+
+;;@subsubheading Measurement-based Color Spaces
+
+(define (color:helper num-of-nums name list->color)
+  (lambda args
+    (define cnt 0)
+    (for-each (lambda (x)
+		(if (and (< cnt num-of-nums) (not (real? x)))
+		    (slib:error name ': 'wrong-type x))
+		(set! cnt (+ 1 cnt)))
+	      args)
+    (or (list->color args)
+	(slib:error name ': 'out-of-range args))))
+
+;;@noindent
+;;@cindex tristimulus
+;;The @dfn{tristimulus} color spaces are those whose component values
+;;are proportional measurements of light intensity.  The CIEXYZ(1931)
+;;system provides 3 sets of spectra to convolve with a spectrum of
+;;interest.  The result of those convolutions is coordinates in CIEXYZ
+;;space.  All tristimuls color spaces are related to CIEXYZ by linear
+;;transforms, namely matrix multiplication.  Of the color spaces listed
+;;here, CIEXYZ and RGB709 are tristimulus spaces.
+
+;;@deftp {Color Space} CIEXYZ
+;;The CIEXYZ color space covers the full @dfn{gamut}.
+;;It is the basis for color-space conversions.
+;;
+;;CIEXYZ is a list of three inexact numbers between 0 and 1.1.
+;;'(0. 0. 0.) is black; '(1. 1. 1.) is white.
+;;@end deftp
+
+;;@body
+;;@1 must be a list of 3 numbers.  If @1 is valid CIEXYZ coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (CIEXYZ->color XYZ)
+  (and (eqv? 3 (length XYZ))
+       (apply (lambda (x y z)
+		(and (real? x) (<= -0.001 x)
+		     (real? y) (<= -0.001 y 1.001)
+		     (real? z) (<= -0.001 z)
+		     (color:construct 'CIEXYZ XYZ #f)))
+	      XYZ)))
+
+;;@args x y z
+;;Returns the CIEXYZ color composed of @1, @2, @3.  If the
+;;coordinates do not encode a valid CIEXYZ color, then an error is
+;;signaled.
+(define color:CIEXYZ (color:helper 3 'color:CIEXYZ CIEXYZ->color))
+
+;;@body Returns the list of 3 numbers encoding @1 in CIEXYZ.
+(define (color->CIEXYZ color)
+  (if (not (color:color? color))
+      (slib:error 'color->CIEXYZ ': 'not 'color? color))
+  (case (color:encoding color)
+    ((CIEXYZ) (append (color:coordinates color) '()))
+    ((RGB709) (RGB709->CIEXYZ (color:coordinates color)))
+    ((L*a*b*) (L*a*b*->CIEXYZ (color:coordinates color)
+			      (color:white-point color)))
+    ((L*u*v*) (L*u*v*->CIEXYZ (color:coordinates color)
+			      (color:white-point color)))
+    ((sRGB)     (sRGB->CIEXYZ (color:coordinates color)))
+    ((e-sRGB) (e-sRGB->CIEXYZ (color:precision color)
+			      (color:coordinates color)))
+    ((L*C*h)  (L*a*b*->CIEXYZ (L*C*h->L*a*b* (color:coordinates color))
+			      (color:white-point color)))
+    (else (slib:error 'color->CIEXYZ ': (color:encoding color) color))))
+
+
+;;@deftp {Color Space} RGB709
+;;BT.709-4 (03/00) @cite{Parameter values for the HDTV standards for
+;;production and international programme exchange} specifies parameter
+;;values for chromaticity, sampling, signal format, frame rates, etc., of
+;;high definition television signals.
+;;
+;;An RGB709 color is represented by a list of three inexact numbers
+;;between 0 and 1.  '(0. 0. 0.) is black '(1. 1. 1.) is white.
+;;@end deftp
+
+;;@body
+;;@1 must be a list of 3 numbers.  If @1 is valid RGB709 coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (RGB709->color RGB)
+  (and (eqv? 3 (length RGB))
+       (apply (lambda (r g b)
+		(and (real? r) (<= -0.001 r 1.001)
+		     (real? g) (<= -0.001 g 1.001)
+		     (real? b) (<= -0.001 b 1.001)
+		     (color:construct 'RGB709 RGB #f)))
+	      RGB)))
+
+;;@args r g b
+;;Returns the RGB709 color composed of @1, @2, @3.  If the
+;;coordinates do not encode a valid RGB709 color, then an error is
+;;signaled.
+(define color:RGB709 (color:helper 3 'color:RGB709 RGB709->color))
+
+;;@body Returns the list of 3 numbers encoding @1 in RGB709.
+(define (color->RGB709 color)
+  (if (not (color:color? color))
+      (slib:error 'color->RGB709 ': 'not 'color? color))
+  (case (color:encoding color)
+    ((RGB709) (append (color:coordinates color) '()))
+    ((CIEXYZ) (CIEXYZ->RGB709 (color:coordinates color)))
+    (else     (CIEXYZ->RGB709 (color->CIEXYZ color)))))
+
+;;@subsubheading Perceptual Uniformity
+
+;;@noindent
+;;Although properly encoding the chromaticity, tristimulus spaces do not
+;;match the logarithmic response of human visual systems to intensity.
+;;Minimum detectable differences between colors correspond to a smaller
+;;range of distances (6:1) in the L*a*b* and L*u*v* spaces than in
+;;tristimulus spaces (80:1).  For this reason, color distances are
+;;computed in L*a*b* (or L*C*h).
+  
+;;@deftp {Color Space} L*a*b*
+;;Is a CIE color space which better matches the human visual system's
+;;perception of color.  It is a list of three numbers:
+
+;;@itemize @bullet
+;;@item
+;;0 <= L* <= 100 (CIE @dfn{Lightness})
+
+;;@item
+;;-500 <= a* <= 500
+;;@item
+;;-200 <= b* <= 200
+;;@end itemize
+;;@end deftp
+
+;;@args L*a*b* white-point
+;;@1 must be a list of 3 numbers.  If @1 is valid L*a*b* coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (L*a*b*->color L*a*b* . white-point)
+  (and (list? L*a*b*)
+       (eqv? 3 (length L*a*b*))
+       (<= 0 (length white-point) 1)
+       (apply (lambda (L* a* b*)
+		(and (real? L*) (<= 0 L* 100)
+		     (real? a*) (<= -500 a* 500)
+		     (real? b*) (<= -200 b* 200)
+		     (color:construct
+		      'L*a*b* L*a*b*
+		      (if (null? white-point) #f
+			  (color->CIEXYZ (car white-point))))))
+	      L*a*b*)))
+
+;;@args L* a* b* white-point
+;;Returns the L*a*b* color composed of @1, @2, @3 with @4.
+;;@args L* a* b*
+;;Returns the L*a*b* color composed of @1, @2, @3.  If the coordinates
+;;do not encode a valid L*a*b* color, then an error is signaled.
+(define color:L*a*b* (color:helper 3 'color:L*a*b* L*a*b*->color))
+
+;;@args color white-point
+;;Returns the list of 3 numbers encoding @1 in L*a*b* with @2.
+;;@args color
+;;Returns the list of 3 numbers encoding @1 in L*a*b*.
+(define (color->L*a*b* color . white-point)
+  (define (wp) (if (null? white-point)
+		   CIEXYZ:D65
+		   (color:coordinates (car white-point))))
+  (if (not (color:color? color))
+      (slib:error 'color->L*a*b* ': 'not 'color? color))
+  (case (color:encoding color)
+    ((L*a*b*) (if (equal? (wp) (color:white-point color))
+		  (append (color:coordinates color) '())
+		  (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ color
+						  (color:white-point color))
+				  (wp))))
+    ((L*u*v*) (CIEXYZ->L*a*b* (L*u*v*->CIEXYZ (color:coordinates color)
+					      (color:white-point color))
+			      (wp)))
+    ((L*C*h)  (if (equal? (wp) (color:white-point color))
+		  (L*C*h->L*a*b* (color:coordinates color))
+		  (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ
+				   (L*C*h->L*a*b* (color:coordinates color))
+				   (color:white-point color))
+				  (wp))))
+    ((CIEXYZ) (CIEXYZ->L*a*b* (color:coordinates color) (wp)))
+    (else     (CIEXYZ->L*a*b* (color->CIEXYZ color) (wp)))))
+
+;;@deftp {Color Space} L*u*v*
+;;Is another CIE encoding designed to better match the human visual
+;;system's perception of color.
+;;@end deftp
+
+;;@args L*u*v* white-point
+;;@1 must be a list of 3 numbers.  If @1 is valid L*u*v* coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (L*u*v*->color L*u*v* . white-point)
+  (and (list? L*u*v*)
+       (eqv? 3 (length L*u*v*))
+       (<= 0 (length white-point) 1)
+       (apply (lambda (L* u* v*)
+		(and (real? L*) (<= 0 L* 100)
+		     (real? u*) (<= -500 u* 500)
+		     (real? v*) (<= -200 v* 200)
+		     (color:construct
+		      'L*u*v* L*u*v*
+		      (if (null? white-point) #f
+			  (color->CIEXYZ (car white-point))))))
+	      L*u*v*)))
+
+;;@args L* u* v* white-point
+;;Returns the L*u*v* color composed of @1, @2, @3 with @4.
+;;@args L* u* v*
+;;Returns the L*u*v* color composed of @1, @2, @3.  If the coordinates
+;;do not encode a valid L*u*v* color, then an error is signaled.
+(define color:L*u*v* (color:helper 3 'color:L*u*v* L*u*v*->color))
+
+;;@args color white-point
+;;Returns the list of 3 numbers encoding @1 in L*u*v* with @2.
+;;@args color
+;;Returns the list of 3 numbers encoding @1 in L*u*v*.
+(define (color->L*u*v* color . white-point)
+  (define (wp) (if (null? white-point)
+		   (color:white-point color)
+		   (car white-point)))
+  (if (not (color:color? color))
+      (slib:error 'color->L*u*v* ': 'not 'color? color))
+  (case (color:encoding color)
+    ((L*u*v*) (append (color:coordinates color) '()))
+    ((L*a*b*) (CIEXYZ->L*u*v* (L*a*b*->CIEXYZ (color:coordinates color)
+					      (color:white-point color))
+			      (wp)))
+    ((L*C*h)  (CIEXYZ->L*u*v*
+	       (L*a*b*->CIEXYZ (L*C*h->L*a*b* (color:coordinates color))
+			       (color:white-point color))
+	       (wp)))
+    ((CIEXYZ) (CIEXYZ->L*u*v* (color:coordinates color) (wp)))
+    (else     (CIEXYZ->L*u*v* (color->CIEXYZ color) (wp)))))
+
+;;@subsubheading Cylindrical Coordinates
+
+;;@noindent
+;;HSL (Hue Saturation Lightness), HSV (Hue Saturation Value), HSI (Hue
+;;Saturation Intensity) and HCI (Hue Chroma Intensity) are cylindrical
+;;color spaces (with angle hue).  But these spaces are all defined in
+;;terms device-dependent RGB spaces.
+
+;;@noindent
+;;One might wonder if there is some fundamental reason why intuitive
+;;specification of color must be device-dependent.  But take heart!  A
+;;cylindrical system can be based on L*a*b* and is used for predicting how
+;;close colors seem to observers.
+
+;;@deftp {Color Space} L*C*h
+;;Expresses the *a and b* of L*a*b* in polar coordinates.  It is a list of
+;;three numbers:
+
+;;@itemize @bullet
+;;@item
+;;0 <= L* <= 100 (CIE @dfn{Lightness})
+
+;;@item
+;;C* (CIE @dfn{Chroma}) is the distance from the neutral (gray) axis.
+;;@item
+;;0 <= h <= 360 (CIE @dfn{Hue}) is the angle.
+;;@end itemize
+;;
+;;The colors by quadrant of h are:
+
+;;@multitable @columnfractions .20 .60 .20
+;;@item 0 @tab red, orange, yellow @tab 90
+;;@item 90 @tab yellow, yellow-green, green @tab 180
+;;@item 180 @tab green, cyan (blue-green), blue @tab 270
+;;@item 270 @tab blue, purple, magenta @tab 360
+;;@end multitable
+
+;;@end deftp
+
+
+;;@args L*C*h white-point
+;;@1 must be a list of 3 numbers.  If @1 is valid L*C*h coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (L*C*h->color L*C*h . white-point)
+  (and (list? L*C*h)
+       (eqv? 3 (length L*C*h))
+       (<= 0 (length white-point) 1)
+       (apply (lambda (L* C* h)
+		(and (real? L*) (<= 0 L* 100)
+		     (real? C*) (<= 0 C*)
+		     (real? h)  (<= 0 h 360)
+		     (color:construct
+		      'L*C*h L*C*h
+		      (if (null? white-point) #f
+			  (color->CIEXYZ (car white-point))))))
+	      L*C*h)))
+
+;;@args L* C* h white-point
+;;Returns the L*C*h color composed of @1, @2, @3 with @4.
+;;@args L* C* h
+;;Returns the L*C*h color composed of @1, @2, @3.  If the coordinates
+;;do not encode a valid L*C*h color, then an error is signaled.
+(define color:L*C*h (color:helper 3 'color:L*C*h L*C*h->color))
+
+;;@args color white-point
+;;Returns the list of 3 numbers encoding @1 in L*C*h with @2.
+;;@args color
+;;Returns the list of 3 numbers encoding @1 in L*C*h.
+(define (color->L*C*h color . white-point)
+  (if (not (color:color? color))
+      (slib:error 'color->L*C*h ': 'not 'color? color))
+  (if (and (eqv? 'L*C*h (color:encoding color))
+	   (equal? (color:white-point color)
+		   (if (null? white-point)
+		       CIEXYZ:D65
+		       (color:coordinates (car white-point)))))
+      (append (color:coordinates color) '())
+      (L*a*b*->L*C*h (apply color->L*a*b* color white-point))))
+
+;;@subsubheading Digital Color Spaces
+
+;;@noindent
+;;The color spaces discussed so far are impractical for image data because
+;;of numerical precision and computational requirements.  In 1998 the IEC
+;;adopted @cite{A Standard Default Color Space for the Internet - sRGB}
+;;(@url{http://www.w3.org/Graphics/Color/sRGB}).  sRGB was cleverly
+;;designed to employ the 24-bit (256x256x256) color encoding already in
+;;widespread use; and the 2.2 gamma intrinsic to CRT monitors.
+
+;;@noindent
+;;Conversion from CIEXYZ to digital (sRGB) color spaces is accomplished by
+;;conversion first to a RGB709 tristimulus space with D65 white-point;
+;;then each coordinate is individually subjected to the same non-linear
+;;mapping.  Inverse operations in the reverse order create the inverse
+;;transform.
+
+;;@deftp {Color Space} sRGB
+;;Is "A Standard Default Color Space for the Internet".  Most display
+;;monitors will work fairly well with sRGB directly.  Systems using ICC
+;;profiles
+;;@ftindex ICC Profile
+;;@footnote{
+;;@noindent
+;;A comprehensive encoding of transforms between CIEXYZ and device color
+;;spaces is the International Color Consortium profile format,
+;;ICC.1:1998-09:
+
+;;@quotation
+;;The intent of this format is to provide a cross-platform device profile
+;;format.  Such device profiles can be used to translate color data
+;;created on one device into another device's native color space.
+;;@end quotation
+;;}
+;;should work very well with sRGB.
+
+;;An sRGB color is a triplet of integers ranging 0 to 255.  D65 is the
+;;white-point for sRGB.
+;;@end deftp
+
+;;@body
+;;@1 must be a list of 3 numbers.  If @1 is valid sRGB coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (sRGB->color RGB)
+  (and (eqv? 3 (length RGB))
+       (apply (lambda (r g b)
+		(and  (integer? r) (<= 0 r 255)
+		      (integer? g) (<= 0 g 255)
+		      (integer? b) (<= 0 b 255)
+		      (color:construct 'sRGB RGB #f)))
+	      RGB)))
+
+;;@args r g b
+;;Returns the sRGB color composed of @1, @2, @3.  If the
+;;coordinates do not encode a valid sRGB color, then an error is
+;;signaled.
+(define color:sRGB (color:helper 3 'color:sRGB sRGB->color))
+
+;;@deftp {Color Space} xRGB
+;;Represents the equivalent sRGB color with a single 24-bit integer.  The
+;;most significant 8 bits encode red, the middle 8 bits blue, and the
+;;least significant 8 bits green.
+;;@end deftp
+
+;;@body
+;;Returns the list of 3 integers encoding @1 in sRGB.
+(define (color->sRGB color)
+  (if (not (color:color? color))
+      (slib:error 'color->sRGB ': 'not 'color? color))
+  (case (color:encoding color)
+    ((CIEXYZ) (CIEXYZ->sRGB (color:coordinates color)))
+    ((sRGB)   (append (color:coordinates color) '()))
+    (else     (CIEXYZ->sRGB (color->CIEXYZ color)))))
+
+;;@body Returns the 24-bit integer encoding @1 in sRGB.
+(define (color->xRGB color) (sRGB->xRGB (color->sRGB color)))
+
+;;@args k
+;;Returns the sRGB color composed of the 24-bit integer @1.
+(define (xRGB->color xRGB)
+  (and (integer? xRGB) (<= 0 xRGB #xffffff)
+       (sRGB->color (xRGB->sRGB xRGB))))
+
+
+;;@deftp {Color Space} e-sRGB
+;;Is "Photography - Electronic still picture imaging - Extended sRGB color
+;;encoding" (PIMA 7667:2001).  It extends the gamut of sRGB; and its
+;;higher precision numbers provide a larger dynamic range.
+;;
+;;A triplet of integers represent e-sRGB colors.  Three precisions are
+;;supported:
+
+;;@table @r
+;;@item e-sRGB10
+;;0 to 1023
+;;@item e-sRGB12
+;;0 to 4095
+;;@item e-sRGB16
+;;0 to 65535
+;;@end table
+;;@end deftp
+
+(define (esRGB->color prec-RGB)
+  (and (eqv? 4 (length prec-RGB))
+       (let ((range (and (pair? prec-RGB)
+			 (case (car prec-RGB)
+			   ((10) 1023)
+			   ((12) 4095)
+			   ((16) 65535)
+			   (else #f)))))
+	 (apply (lambda (precision r g b)
+		  (and  (integer? r) (<= 0 r range)
+			(integer? g) (<= 0 g range)
+			(integer? b) (<= 0 b range)
+			(color:construct 'e-sRGB (cdr prec-RGB) precision)))
+		prec-RGB))))
+
+;;@body @1 must be the integer 10, 12, or 16.  @2 must be a list of 3
+;;numbers.  If @2 is valid e-sRGB coordinates, then @0 returns the color
+;;specified by @2; otherwise returns #f.
+(define (e-sRGB->color precision RGB)
+  (esRGB->color (cons precision RGB)))
+
+;;@args 10 r g b
+;;Returns the e-sRGB10 color composed of integers @2, @3, @4.
+;;@args 12 r g b
+;;Returns the e-sRGB12 color composed of integers @2, @3, @4.
+;;@args 16 r g b
+;;Returns the e-sRGB16 color composed of integers @2, @3, @4.
+;;If the coordinates do not encode a valid e-sRGB color, then an error
+;;is signaled.
+(define color:e-sRGB (color:helper 4 'color:e-sRGB esRGB->color))
+
+;;@body @1 must be the integer 10, 12, or 16.  @0 returns the list of 3
+;;integers encoding @2 in sRGB10, sRGB12, or sRGB16.
+(define (color->e-sRGB precision color)
+  (case precision
+    ((10 12 16)
+     (if (not (color:color? color))
+	 (slib:error 'color->e-sRGB ': 'not 'color? color)))
+    (else (slib:error 'color->e-sRGB ': 'invalid 'precision precision)))
+  (case (color:encoding color)
+    ((e-sRGB) (e-sRGB->e-sRGB (color:precision color)
+			      (color:coordinates color)
+			      precision))
+    ((sRGB)     (sRGB->e-sRGB precision (color:coordinates color)))
+    (else     (CIEXYZ->e-sRGB precision (color->CIEXYZ color)))))
+
+;;;; Polytypic Colors
+
+;;; The rest of documentation is in "slib.texi"
+;@
+(define D65 (CIEXYZ->color CIEXYZ:D65))
+(define D50 (CIEXYZ->color CIEXYZ:D50))
+;@
+(define (color? obj . typ)
+  (cond ((not (color:color? obj)) #f)
+	((null? typ) #t)
+	(else (eqv? (car typ) (color:encoding obj)))))
+;@
+(define (make-color space . args)
+  (case space
+    ((CIEXYZ) (CIEXYZ->color args))
+    ((RGB709) (RGB709->color args))
+    ((L*a*b*) (L*a*b*->color args))
+    ((L*u*v*) (L*u*v*->color args))
+    ((L*C*h)  (L*C*h->color args))
+    ((sRGB)   (sRGB->color args))
+    ((xRGB)  (apply xRGB->color args))
+    ((e-sRGB) (e-sRGB->color args))
+    (else (slib:error 'make-color ': 'not 'space? space))))
+;@
+(define color-space color:encoding)
+;@
+(define (color-precision color)
+  (if (not (color:color? color))
+      (slib:error 'color-precision ': 'not 'color? color))
+  (case (color:encoding color)
+    ((e-sRGB) (color:precision color))
+    ((sRGB)   8)
+    (else     #f)))
+;@
+(define (color-white-point color)
+  (if (not (color:color? color))
+      (slib:error 'color-white-point ': 'not 'color? color))
+  (case (color:encoding color)
+    ((L*a*b*) (color:CIEXYZ (color:white-point color)))
+    ((L*u*v*) (color:CIEXYZ (color:white-point color)))
+    ((L*C*h)  (color:CIEXYZ (color:white-point color)))
+    ((RGB709) D65)
+    ((sRGB)   D65)
+    ((e-sRGB) D65)
+    (else #f)))
+;@
+(define (convert-color color encoding . opt-arg)
+  (define (noarg)
+    (if (not (null? opt-arg))
+	(slib:error 'convert-color ': 'too-many 'arguments opt-arg)))
+  (if (not (color:color? color))
+      (slib:error 'convert-color ': 'not 'color? color))
+  (case encoding
+    ((CIEXYZ) (noarg) (CIEXYZ->color (color->CIEXYZ color)))
+    ((RGB709) (noarg) (RGB709->color (color->RGB709 color)))
+    ((sRGB)   (noarg) (sRGB->color   (color->sRGB color)))
+    ((e-sRGB) (e-sRGB->color (car opt-arg) (color->e-sRGB (car opt-arg) color)))
+    ((L*a*b*) (apply L*a*b*->color (color->L*a*b* color) opt-arg))
+    ((L*u*v*) (apply L*u*v*->color (color->L*u*v* color) opt-arg))
+    ((L*C*h)  (apply L*C*h->color  (color->L*C*h color) opt-arg))
+    (else (slib:error 'convert-color ': encoding '?))))
+
+;;; External color representations
+;@
+(define (color->string color)
+  (if (not (color:color? color))
+      (slib:error 'color->string ': 'not 'color? color))
+  (case (color:encoding color)
+    ((CIEXYZ) (apply sprintf #f "CIEXYZ:%g/%g/%g"
+		     (color:coordinates color)))
+    ((L*a*b*) (apply sprintf #f "CIELab:%.4f/%.4f/%.4f"
+		     (if (equal? CIEXYZ:D65 (color:white-point color))
+			 (color:coordinates color)
+			 (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ
+					  (color:coordinates color)
+					  (color:white-point color))))))
+    ((L*u*v*) (apply sprintf #f "CIELuv:%.4f/%.4f/%.4f"
+		     (if (equal? CIEXYZ:D65 (color:white-point color))
+			 (color:coordinates color)
+			 (CIEXYZ->L*u*v* (L*u*v*->CIEXYZ
+					  (color:coordinates color)
+					  (color:white-point color))))))
+    ((L*C*h)  (apply sprintf #f "CIELCh:%.4f/%.4f/%.4f"
+		     (if (equal? CIEXYZ:D65 (color:white-point color))
+			 (color:coordinates color)
+			 (L*a*b*->L*C*h
+			  (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ
+					   (L*C*h->L*a*b*
+					    (color:coordinates color))
+					   (color:white-point color)))))))
+    ((RGB709) (apply sprintf #f "RGBi:%g/%g/%g" (color:coordinates color)))
+    ((sRGB)   (apply sprintf #f "sRGB:%d/%d/%d" (color:coordinates color)))
+    ((e-sRGB) (apply sprintf #f "e-sRGB%d:%d/%d/%d"
+		     (color:precision color) (color:coordinates color)))
+    (else (slib:error 'color->string ': (color:encoding color) color))))
+;@
+(define (string->color str)
+  (define prec #f) (define coding #f)
+  (define x #f) (define y #f) (define z #f)
+  (cond ((eqv? 4 (sscanf str " %[CIEXYZciexyzLABUVlabuvHhRrGg709]:%f/%f/%f"
+			 coding x y z))
+	 (case (string-ci->symbol coding)
+	   ((CIEXYZ) (color:CIEXYZ x y z))
+	   ((CIELab) (color:L*a*b* x y z))
+	   ((CIELuv) (color:L*u*v* x y z))
+	   ((CIELCh) (color:L*C*h  x y z))
+	   ((RGBi			; Xlib - C Language X Interface
+	     RGB709) (color:RGB709 x y z))
+	   (else #f)))
+	((eqv? 4 (sscanf str " %[sRGBSrgb]:%d/%d/%d" coding x y z))
+	 (case (string-ci->symbol coding)
+	   ((sRGB)   (color:sRGB x y z))
+	   (else #f)))
+	((eqv? 5 (sscanf str " %[-esRGBESrgb]%d:%d/%d/%d" coding prec x y z))
+	 (case (string-ci->symbol coding)
+	   ((e-sRGB) (color:e-sRGB prec x y z))
+	   (else #f)))
+	((eqv? 2 (sscanf str " %[sRGBxXXRGB]:%6x%[/0-9a-fA-F]" coding x y))
+	 (case (string-ci->symbol coding)
+	   ((sRGB
+	     xRGB
+	     sRGBx)  (xRGB->color x))
+	   (else #f)))
+	((and (eqv? 2 (sscanf str " %[#0xX]%6[0-9a-fA-F]%[0-9a-fA-F]"
+			      coding x y))
+	      (eqv? 6 (string-length x))
+	      (member coding '("#" "#x" "0x" "#X" "0X")))
+	 (xRGB->color (string->number x 16)))
+	(else #f)))
+
+;;;; visual color metrics
+;@
+(define (CIE:DE* color1 color2 . white-point)
+  (L*a*b*:DE* (apply color->L*a*b* color1 white-point)
+	      (apply color->L*a*b* color2 white-point)))
+;@
+(define (CIE:DE*94 color1 color2 . parametric-factors)
+  (apply L*C*h:DE*94
+	 (color->L*C*h color1)
+	 (color->L*C*h color2)
+	 parametric-factors))
+;@
+(define (CMC:DE* color1 color2 . parametric-factors)
+  (apply CMC-DE
+	 (color->L*C*h color1)
+	 (color->L*C*h color2)
+	 parametric-factors))
+
+;;; Short names
+
+;; (define CIEXYZ color:CIEXYZ)
+;; (define RGB709 color:RGB709)
+;; (define L*a*b* color:L*a*b*)
+;; (define L*u*v* color:L*u*v*)
+;; (define L*C*h  color:L*C*h)
+;; (define sRGB   color:sRGB)
+;; (define xRGB   xRGB->color)
+;; (define e-sRGB color:e-sRGB)
diff --git a/color.txi b/color.txi
new file mode 100644
index 0000000..ccbb3de
--- /dev/null
+++ b/color.txi
@@ -0,0 +1,345 @@
+@subsubheading Measurement-based Color Spaces
+
+@noindent
+@cindex tristimulus
+The @dfn{tristimulus} color spaces are those whose component values
+@cindex tristimulus
+are proportional measurements of light intensity.  The CIEXYZ(1931)
+system provides 3 sets of spectra to convolve with a spectrum of
+interest.  The result of those convolutions is coordinates in CIEXYZ
+space.  All tristimuls color spaces are related to CIEXYZ by linear
+transforms, namely matrix multiplication.  Of the color spaces listed
+here, CIEXYZ and RGB709 are tristimulus spaces.
+
+@deftp {Color Space} CIEXYZ
+The CIEXYZ color space covers the full @dfn{gamut}.
+@cindex gamut
+It is the basis for color-space conversions.
+
+CIEXYZ is a list of three inexact numbers between 0 and 1.1.
+'(0. 0. 0.) is black; '(1. 1. 1.) is white.
+@end deftp
+
+
+@defun ciexyz->color xyz
+
+@var{xyz} must be a list of 3 numbers.  If @var{xyz} is valid CIEXYZ coordinates,
+then @code{ciexyz->color} returns the color specified by @var{xyz}; otherwise returns #f.
+@end defun
+
+@defun color:ciexyz x y z
+
+Returns the CIEXYZ color composed of @var{x}, @var{y}, @var{z}.  If the
+coordinates do not encode a valid CIEXYZ color, then an error is
+signaled.
+@end defun
+
+@defun color->ciexyz color
+Returns the list of 3 numbers encoding @var{color} in CIEXYZ.
+@end defun
+@deftp {Color Space} RGB709
+BT.709-4 (03/00) @cite{Parameter values for the HDTV standards for
+production and international programme exchange} specifies parameter
+values for chromaticity, sampling, signal format, frame rates, etc., of
+high definition television signals.
+
+An RGB709 color is represented by a list of three inexact numbers
+between 0 and 1.  '(0. 0. 0.) is black '(1. 1. 1.) is white.
+@end deftp
+
+
+@defun rgb709->color rgb
+
+@var{rgb} must be a list of 3 numbers.  If @var{rgb} is valid RGB709 coordinates,
+then @code{rgb709->color} returns the color specified by @var{rgb}; otherwise returns #f.
+@end defun
+
+@defun color:rgb709 r g b
+
+Returns the RGB709 color composed of @var{r}, @var{g}, @var{b}.  If the
+coordinates do not encode a valid RGB709 color, then an error is
+signaled.
+@end defun
+
+@defun color->rgb709 color
+Returns the list of 3 numbers encoding @var{color} in RGB709.
+@end defun
+@subsubheading Perceptual Uniformity
+
+@noindent
+Although properly encoding the chromaticity, tristimulus spaces do not
+match the logarithmic response of human visual systems to intensity.
+Minimum detectable differences between colors correspond to a smaller
+range of distances (6:1) in the L*a*b* and L*u*v* spaces than in
+tristimulus spaces (80:1).  For this reason, color distances are
+computed in L*a*b* (or L*C*h).
+
+@deftp {Color Space} L*a*b*
+Is a CIE color space which better matches the human visual system's
+perception of color.  It is a list of three numbers:
+
+@itemize @bullet
+@item
+0 <= L* <= 100 (CIE @dfn{Lightness})
+@cindex Lightness
+
+@item
+-500 <= a* <= 500
+@item
+-200 <= b* <= 200
+@end itemize
+@end deftp
+
+
+@defun l*a*b*->color L*a*b* white-point
+
+@var{L*a*b*} must be a list of 3 numbers.  If @var{L*a*b*} is valid L*a*b* coordinates,
+then @code{l*a*b*->color} returns the color specified by @var{L*a*b*}; otherwise returns #f.
+@end defun
+
+@defun color:l*a*b* L* a* b* white-point
+
+Returns the L*a*b* color composed of @var{L*}, @var{a*}, @var{b*} with @var{white-point}.
+
+@defunx color:l*a*b* L* a* b*
+Returns the L*a*b* color composed of @var{L*}, @var{a*}, @var{b*}.  If the coordinates
+do not encode a valid L*a*b* color, then an error is signaled.
+@end defun
+
+@defun color->l*a*b* color white-point
+
+Returns the list of 3 numbers encoding @var{color} in L*a*b* with @var{white-point}.
+
+@defunx color->l*a*b* color
+Returns the list of 3 numbers encoding @var{color} in L*a*b*.
+@end defun
+@deftp {Color Space} L*u*v*
+Is another CIE encoding designed to better match the human visual
+system's perception of color.
+@end deftp
+
+
+@defun l*u*v*->color L*u*v* white-point
+
+@var{L*u*v*} must be a list of 3 numbers.  If @var{L*u*v*} is valid L*u*v* coordinates,
+then @code{l*u*v*->color} returns the color specified by @var{L*u*v*}; otherwise returns #f.
+@end defun
+
+@defun color:l*u*v* L* u* v* white-point
+
+Returns the L*u*v* color composed of @var{L*}, @var{u*}, @var{v*} with @var{white-point}.
+
+@defunx color:l*u*v* L* u* v*
+Returns the L*u*v* color composed of @var{L*}, @var{u*}, @var{v*}.  If the coordinates
+do not encode a valid L*u*v* color, then an error is signaled.
+@end defun
+
+@defun color->l*u*v* color white-point
+
+Returns the list of 3 numbers encoding @var{color} in L*u*v* with @var{white-point}.
+
+@defunx color->l*u*v* color
+Returns the list of 3 numbers encoding @var{color} in L*u*v*.
+@end defun
+@subsubheading Cylindrical Coordinates
+
+@noindent
+HSL (Hue Saturation Lightness), HSV (Hue Saturation Value), HSI (Hue
+Saturation Intensity) and HCI (Hue Chroma Intensity) are cylindrical
+color spaces (with angle hue).  But these spaces are all defined in
+terms device-dependent RGB spaces.
+
+@noindent
+One might wonder if there is some fundamental reason why intuitive
+specification of color must be device-dependent.  But take heart!  A
+cylindrical system can be based on L*a*b* and is used for predicting how
+close colors seem to observers.
+
+@deftp {Color Space} L*C*h
+Expresses the *a and b* of L*a*b* in polar coordinates.  It is a list of
+three numbers:
+
+@itemize @bullet
+@item
+0 <= L* <= 100 (CIE @dfn{Lightness})
+@cindex Lightness
+
+@item
+C* (CIE @dfn{Chroma}) is the distance from the neutral (gray) axis.
+@cindex Chroma
+@item
+0 <= h <= 360 (CIE @dfn{Hue}) is the angle.
+@cindex Hue
+@end itemize
+
+The colors by quadrant of h are:
+
+@multitable @columnfractions .20 .60 .20
+@item 0 @tab red, orange, yellow @tab 90
+@item 90 @tab yellow, yellow-green, green @tab 180
+@item 180 @tab green, cyan (blue-green), blue @tab 270
+@item 270 @tab blue, purple, magenta @tab 360
+@end multitable
+
+@end deftp
+
+
+@defun l*c*h->color L*C*h white-point
+
+@var{L*C*h} must be a list of 3 numbers.  If @var{L*C*h} is valid L*C*h coordinates,
+then @code{l*c*h->color} returns the color specified by @var{L*C*h}; otherwise returns #f.
+@end defun
+
+@defun color:l*c*h L* C* h white-point
+
+Returns the L*C*h color composed of @var{L*}, @var{C*}, @var{h} with @var{white-point}.
+
+@defunx color:l*c*h L* C* h
+Returns the L*C*h color composed of @var{L*}, @var{C*}, @var{h}.  If the coordinates
+do not encode a valid L*C*h color, then an error is signaled.
+@end defun
+
+@defun color->l*c*h color white-point
+
+Returns the list of 3 numbers encoding @var{color} in L*C*h with @var{white-point}.
+
+@defunx color->l*c*h color
+Returns the list of 3 numbers encoding @var{color} in L*C*h.
+@end defun
+@subsubheading Digital Color Spaces
+
+@noindent
+The color spaces discussed so far are impractical for image data because
+of numerical precision and computational requirements.  In 1998 the IEC
+adopted @cite{A Standard Default Color Space for the Internet - sRGB}
+(@url{http://www.w3.org/Graphics/Color/sRGB}).  sRGB was cleverly
+designed to employ the 24-bit (256x256x256) color encoding already in
+widespread use; and the 2.2 gamma intrinsic to CRT monitors.
+
+@noindent
+Conversion from CIEXYZ to digital (sRGB) color spaces is accomplished by
+conversion first to a RGB709 tristimulus space with D65 white-point;
+then each coordinate is individually subjected to the same non-linear
+mapping.  Inverse operations in the reverse order create the inverse
+transform.
+
+@deftp {Color Space} sRGB
+Is "A Standard Default Color Space for the Internet".  Most display
+monitors will work fairly well with sRGB directly.  Systems using ICC
+profiles
+@ftindex ICC Profile
+@footnote{
+@noindent
+A comprehensive encoding of transforms between CIEXYZ and device color
+spaces is the International Color Consortium profile format,
+ICC.1:1998-09:
+
+@quotation
+The intent of this format is to provide a cross-platform device profile
+format.  Such device profiles can be used to translate color data
+created on one device into another device's native color space.
+@end quotation
+}
+should work very well with sRGB.
+
+@end deftp
+
+
+@defun srgb->color rgb
+
+@var{rgb} must be a list of 3 numbers.  If @var{rgb} is valid sRGB coordinates,
+then @code{srgb->color} returns the color specified by @var{rgb}; otherwise returns #f.
+@end defun
+
+@defun color:srgb r g b
+
+Returns the sRGB color composed of @var{r}, @var{g}, @var{b}.  If the
+coordinates do not encode a valid sRGB color, then an error is
+signaled.
+@end defun
+@deftp {Color Space} xRGB
+Represents the equivalent sRGB color with a single 24-bit integer.  The
+most significant 8 bits encode red, the middle 8 bits blue, and the
+least significant 8 bits green.
+@end deftp
+
+
+@defun color->srgb color
+
+Returns the list of 3 integers encoding @var{color} in sRGB.
+@end defun
+
+@defun color->xrgb color
+Returns the 24-bit integer encoding @var{color} in sRGB.
+@end defun
+
+@defun xrgb->color k
+
+Returns the sRGB color composed of the 24-bit integer @var{k}.
+@end defun
+@deftp {Color Space} e-sRGB
+Is "Photography - Electronic still picture imaging - Extended sRGB color
+encoding" (PIMA 7667:2001).  It extends the gamut of sRGB; and its
+higher precision numbers provide a larger dynamic range.
+
+A triplet of integers represent e-sRGB colors.  Three precisions are
+supported:
+
+@table @r
+@item e-sRGB10
+0 to 1023
+@item e-sRGB12
+0 to 4095
+@item e-sRGB16
+0 to 65535
+@end table
+@end deftp
+
+
+@defun e-srgb->color precision rgb
+@var{precision} must be the integer 10, 12, or 16.  @var{rgb} must be a list of 3
+numbers.  If @var{rgb} is valid e-sRGB coordinates, then @code{e-srgb->color} returns the color
+specified by @var{rgb}; otherwise returns #f.
+@end defun
+
+@defun color:e-srgb 10 r g b
+
+Returns the e-sRGB10 color composed of integers @var{r}, @var{g}, @var{b}.
+
+@defunx color:e-srgb 12 r g b
+Returns the e-sRGB12 color composed of integers @var{r}, @var{g}, @var{b}.
+
+@defunx color:e-srgb 16 r g b
+Returns the e-sRGB16 color composed of integers @var{r}, @var{g}, @var{b}.
+If the coordinates do not encode a valid e-sRGB color, then an error
+is signaled.
+@end defun
+
+@defun color->e-srgb precision color
+@var{precision} must be the integer 10, 12, or 16.  @code{color->e-srgb} returns the list of 3
+integers encoding @var{color} in sRGB10, sRGB12, or sRGB16.
+@end defun
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/colornam.scm b/colornam.scm
new file mode 100644
index 0000000..e8e8812
--- /dev/null
+++ b/colornam.scm
@@ -0,0 +1,117 @@
+;;; "colornam.scm" color name databases
+;Copyright 2001, 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'databases)
+(require 'color)
+
+;;@code{(require 'color-names)}
+;;@ftindex color-names
+
+;;@noindent
+;;Rather than ballast the color dictionaries with numbered grays,
+;;@code{file->color-dictionary} discards them.  They are provided
+;;through the @code{grey} procedure:
+
+;;@body
+;;Returns @code{(inexact->exact (round (* k 2.55)))}, the X11 color
+;;grey@i{<k>}.
+(define (grey k)
+  (define int (inexact->exact (round (* k 2.55))))
+  (color:sRGB int int int))
+
+;;@noindent
+;;A color dictionary is a database table relating @dfn{canonical}
+;;color-names to color-strings
+;;(@pxref{Color Data-Type, External Representation}).
+;;
+;;@noindent
+;;The column names in a color dictionary are unimportant; the first
+;;field is the key, and the second is the color-string.
+
+;;@body Returns a downcased copy of the string or symbol @1 with
+;;@samp{_}, @samp{-}, and whitespace removed.
+(define (color-name:canonicalize name)
+  (list->string
+   (apply append (map (lambda (c) (if (or (char-alphabetic? c)
+					  (char-numeric? c))
+				      (list (char-downcase c))
+				      '()))
+		      (string->list (if (symbol? name)
+					(symbol->string name)
+					name))))))
+
+;;@args name table1 table2 @dots{}
+;;
+;;@2, @3, @dots{} must be color-dictionary tables.  @0 searches for the
+;;canonical form of @1 in @2, @3, @dots{} in order; returning the
+;;color-string of the first matching record; #f otherwise.
+(define (color-name->color name . tables)
+  (define cancol (color-name:canonicalize name))
+  (define found #f)
+  (do ((tabs tables (cdr tabs)))
+      ((or found (null? tabs)) (and found (string->color found)))
+    (set! found (((car tabs) 'get 2) cancol))))
+
+;;@args table1 table2 @dots{}
+;;
+;;@1, @2, @dots{} must be color-dictionary tables.  @0 returns a
+;;procedure which searches for the canonical form of its string argument
+;;in @1, @2, @dots{}; returning the color-string of the first matching
+;;record; and #f otherwise.
+(define (color-dictionaries->lookup . tables)
+  (define procs (map (lambda (tab) (tab 'get 2)) tables))
+  (lambda (name)
+    (define cancol (color-name:canonicalize name))
+    (define found #f)
+    (do ((procs procs (cdr procs)))
+	((or found (null? procs)) (and found (string->color found)))
+      (set! found ((car procs) cancol)))))
+
+;;@args name rdb base-table-type
+;;
+;;@2 must be a string naming a relational database file; and the symbol
+;;@1 a table therein.  The database will be opened as
+;;@var{base-table-type}.  @0 returns the read-only table @1 in database
+;;@1 if it exists; #f otherwise.
+;;
+;;@args name rdb
+;;
+;;@2 must be an open relational database or a string naming a relational
+;;database file; and the symbol @1 a table therein.  @0 returns the
+;;read-only table @1 in database @1 if it exists; #f otherwise.
+(define (color-dictionary table-name . *db*)
+  (define rdb (apply open-database *db*))
+  (and rdb ((rdb 'open-table) table-name #f)))
+
+
+;;@args name rdb base-table-type
+;;@args name rdb
+;;
+;;@2 must be a string naming a relational database file; and the symbol
+;;@1 a table therein.  If the symbol @3 is provided, the database will
+;;be opened as @3.  @0 creates a top-level definition of the symbol @1
+;;to a lookup procedure for the color dictionary @1 in @2.
+;;
+;;The value returned by @0 is unspecified.
+(define (load-color-dictionary table-name . db)
+  (slib:eval
+   `(define ,table-name
+      (color-dictionaries->lookup
+       (color-dictionary ',table-name
+			 ,@(map (lambda (arg) (list 'quote arg)) db))))))
diff --git a/colornam.txi b/colornam.txi
new file mode 100644
index 0000000..f72167b
--- /dev/null
+++ b/colornam.txi
@@ -0,0 +1,75 @@
+@code{(require 'color-names)}
+@ftindex color-names
+
+@noindent
+Rather than ballast the color dictionaries with numbered grays,
+@code{file->color-dictionary} discards them.  They are provided
+through the @code{grey} procedure:
+
+
+@defun grey k
+
+Returns @code{(inexact->exact (round (* k 2.55)))}, the X11 color
+grey@i{<k>}.
+@end defun
+@noindent
+A color dictionary is a database table relating @dfn{canonical}
+@cindex canonical
+color-names to color-strings
+(@pxref{Color Data-Type, External Representation}).
+
+@noindent
+The column names in a color dictionary are unimportant; the first
+field is the key, and the second is the color-string.
+
+
+@defun color-name:canonicalize name
+Returns a downcased copy of the string or symbol @var{name} with
+@samp{_}, @samp{-}, and whitespace removed.
+@end defun
+
+@defun color-name->color name table1 table2 @dots{}
+
+
+@var{table1}, @var{table2}, @dots{} must be color-dictionary tables.  @code{color-name->color} searches for the
+canonical form of @var{name} in @var{table1}, @var{table2}, @dots{} in order; returning the
+color-string of the first matching record; #f otherwise.
+@end defun
+
+@defun color-dictionaries->lookup table1 table2 @dots{}
+
+
+@var{table1}, @var{table2}, @dots{} must be color-dictionary tables.  @code{color-dictionaries->lookup} returns a
+procedure which searches for the canonical form of its string argument
+in @var{table1}, @var{table2}, @dots{}; returning the color-string of the first matching
+record; and #f otherwise.
+@end defun
+
+@defun color-dictionary name rdb base-table-type
+
+
+@var{rdb} must be a string naming a relational database file; and the symbol
+@var{name} a table therein.  The database will be opened as
+@var{base-table-type}.  @code{color-dictionary} returns the read-only table @var{name} in database
+@var{name} if it exists; #f otherwise.
+
+
+@defunx color-dictionary name rdb
+
+@var{rdb} must be an open relational database or a string naming a relational
+database file; and the symbol @var{name} a table therein.  @code{color-dictionary} returns the
+read-only table @var{name} in database @var{name} if it exists; #f otherwise.
+@end defun
+
+@defun load-color-dictionary name rdb base-table-type
+
+
+@defunx load-color-dictionary name rdb
+
+@var{rdb} must be a string naming a relational database file; and the symbol
+@var{name} a table therein.  If the symbol @var{base-table-type} is provided, the database will
+be opened as @var{base-table-type}.  @code{load-color-dictionary} creates a top-level definition of the symbol @var{name}
+to a lookup procedure for the color dictionary @var{name} in @var{rdb}.
+
+The value returned by @code{load-color-dictionary} is unspecified.
+@end defun
diff --git a/colorspc.scm b/colorspc.scm
new file mode 100644
index 0000000..3a88767
--- /dev/null
+++ b/colorspc.scm
@@ -0,0 +1,536 @@
+;;; "colorspc.scm" color-space conversions
+;Copyright 2001, 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'logical)
+(require 'multiarg/and-)
+(require-if 'compiling 'sort)
+(require-if 'compiling 'ciexyz)
+;@
+(define (color:linear-transform matrix row)
+  (map (lambda (mrow) (apply + (map * mrow row)))
+       matrix))
+
+(define RGB709:into-matrix
+  '((  3.240479 -1.537150 -0.498535 )
+    ( -0.969256  1.875992  0.041556 )
+    (  0.055648 -0.204043  1.057311 )))
+
+;;; http://www.pima.net/standards/it10/PIMA7667/PIMA7667-2001.PDF gives
+;;; matrix identical to sRGB:from-matrix, but colors drift under
+;;; repeated conversions to and from CIEXYZ.  Instead use RGB709.
+
+(define RGB709:from-matrix
+  '((  0.412453  0.357580  0.180423 )
+    (  0.212671  0.715160  0.072169 )
+    (  0.019334  0.119193  0.950227 )))
+
+;; From http://www.cs.rit.edu/~ncs/color/t_convert.html
+;@
+(define (CIEXYZ->RGB709 XYZ)
+  (color:linear-transform RGB709:into-matrix XYZ))
+(define (RGB709->CIEXYZ rgb)
+  (color:linear-transform RGB709:from-matrix rgb))
+
+;;; From http://www.w3.org/Graphics/Color/sRGB.html
+
+(define sRGB-log
+  (lambda (sv)
+    (if (<= sv 0.00304)
+	(* 12.92 sv)
+	(+ -0.055 (* 1.055 (expt sv 10/24))))))
+(define sRGB-exp
+  (lambda (x)
+    (if (<= x 0.03928)
+	(/ x 12.92)
+	(expt (/ (+ 0.055 x) 1.055) 2.4))))
+
+;; Clipping as recommended by sRGB spec.
+;@
+(define (CIEXYZ->sRGB XYZ)
+  (map (lambda (sv)
+	 (inexact->exact (round (* 255 (sRGB-log (max 0 (min 1 sv)))))))
+       (color:linear-transform RGB709:into-matrix XYZ)))
+(define (sRGB->CIEXYZ sRGB)
+  (color:linear-transform
+   RGB709:from-matrix
+   (map sRGB-exp
+	(map (lambda (b8v) (/ b8v 255.0)) sRGB))))
+
+;;; sRGB values are sometimes written as 24-bit integers 0xRRGGBB
+;@
+(define (xRGB->sRGB xRGB)
+  (list (ash xRGB -16)
+	(logand (ash xRGB -8) 255)
+	(logand xRGB 255)))
+(define (sRGB->xRGB sRGB)
+  (apply + (map * sRGB '(#x10000 #x100 #x1))))
+;@
+(define (xRGB->CIEXYZ xRGB) (sRGB->CIEXYZ (xRGB->sRGB xRGB)))
+(define (CIEXYZ->xRGB xyz)   (sRGB->xRGB (CIEXYZ->sRGB xyz)))
+
+;;;  http://www.pima.net/standards/it10/PIMA7667/PIMA7667-2001.PDF
+;;;	    Photography � Electronic still picture imaging �
+;;;		 Extended sRGB color encoding � e-sRGB
+
+(define e-sRGB-log
+  (lambda (sv)
+    (cond ((< sv -0.0031308)
+	   (- 0.055 (* 1.055 (expt (- sv) 10/24))))
+	  ((<= sv 0.0031308)
+	   (* 12.92 sv))
+	  (else (+ -0.055 (* 1.055 (expt sv 10/24)))))))
+(define e-sRGB-exp
+  (lambda (x)
+    (cond ((< x -0.04045)
+	   (- (expt (/ (- 0.055 x) 1.055) 2.4)))
+	  ((<= x 0.04045)
+	   (/ x 12.92))
+	  (else (expt (/ (+ 0.055 x) 1.055) 2.4)))))
+;@
+(define (CIEXYZ->e-sRGB n XYZ)
+  (define two^n-9 (ash 1 (- n 9)))
+  (define offset (* 3 (ash 1 (- n 3))))
+  (map (lambda (x)
+	 (+ (inexact->exact (round (* x 255 two^n-9))) offset))
+       (map e-sRGB-log
+	    (color:linear-transform
+	     RGB709:into-matrix
+	     XYZ))))
+;@
+(define (e-sRGB->CIEXYZ n rgb)
+  (define two^n-9 (ash 1 (- n 9)))
+  (define offset (* 3 (ash 1 (- n 3))))
+  (color:linear-transform
+   RGB709:from-matrix
+   (map e-sRGB-exp
+	(map (lambda (b8v) (/ (- b8v offset) 255.0 two^n-9))
+	     rgb))))
+;@
+(define (sRGB->e-sRGB n sRGB)
+  (define two^n-9 (ash 1 (- n 9)))
+  (define offset (* 3 (ash 1 (- n 3))))
+  (map (lambda (x) (+ offset (* two^n-9 x))) sRGB))
+;@
+(define (e-sRGB->sRGB n rgb)
+  (define two^n-9 (ash 1 (- n 9)))
+  (define offset (* 3 (ash 1 (- n 3))))
+  (map (lambda (x) (/ (- x offset) two^n-9)) rgb))
+;@
+(define (e-sRGB->e-sRGB n rgb m)
+  (define shft (- m n))
+  (cond ((zero? shft) rgb)
+	(else (map (lambda (x) (ash x shft)) rgb))))
+
+;;; From http://www.cs.rit.edu/~ncs/color/t_convert.html
+
+;;; CIE 1976 L*a*b* is based directly on CIE XYZ and is an attampt to
+;;; linearize the perceptibility of color differences. The non-linear
+;;; relations for L*, a*, and b* are intended to mimic the logarithmic
+;;; response of the eye. Coloring information is referred to the color
+;;; of the white point of the system, subscript n.
+
+;;;; L* is CIE lightness
+;;;     L* = 116 * (Y/Yn)^1/3 - 16    for Y/Yn > 0.008856
+;;;     L* = 903.3 * Y/Yn             otherwise
+
+(define (CIE:Y/Yn->L* Y/Yn)
+  (if (> Y/Yn 0.008856)
+      (+ -16 (* 116 (expt Y/Yn 1/3)))
+      (* 903.3 Y/Yn)))
+(define (CIE:L*->Y/Yn L*)
+  (cond ((<= L* (* 903.3 0.008856))
+	 (/ L* 903.3))
+	((<= L* 100.)
+	 (expt (/ (+ L* 16) 116) 3))
+	(else 1)))
+
+;;; a* = 500 * ( f(X/Xn) - f(Y/Yn) )
+;;; b* = 200 * ( f(Y/Yn) - f(Z/Zn) )
+;;;     where f(t) = t^1/3              for t > 0.008856
+;;;           f(t) = 7.787 * t + 16/116 otherwise
+
+(define (ab-log t)
+  (if (> t 0.008856)
+      (expt t 1/3)
+      (+ 16/116 (* t 7.787))))
+(define (ab-exp f)
+  (define f3 (expt f 3))
+  (if (> f3 0.008856)
+      f3
+      (/ (- f 16/116) 7.787)))
+;@
+(define (CIEXYZ->L*a*b* XYZ . white-point)
+  (apply (lambda (X/Xn Y/Yn Z/Zn)
+	   (list (CIE:Y/Yn->L* Y/Yn)
+		 (* 500 (- (ab-log X/Xn) (ab-log Y/Yn)))
+		 (* 200 (- (ab-log Y/Yn) (ab-log Z/Zn)))))
+	 (map / XYZ (if (null? white-point)
+			CIEXYZ:D65
+			(car white-point)))))
+
+;;; Here Xn, Yn and Zn are the tristimulus values of the reference white.
+;@
+(define (L*a*b*->CIEXYZ L*a*b* . white-point)
+  (apply (lambda (Xn Yn Zn)
+	   (apply (lambda (L* a* b*)
+		    (let* ((Y/Yn (CIE:L*->Y/Yn L*))
+			   (fY/Yn (ab-log Y/Yn)))
+		      (list (* Xn (ab-exp (+ fY/Yn (/ a* 500))))
+			    (* Yn Y/Yn)
+			    (* Zn (ab-exp (+ fY/Yn (/ b* -200)))))))
+		  L*a*b*))
+	 (if (null? white-point)
+	     CIEXYZ:D65
+	     (car white-point))))
+
+;;; XYZ to CIELUV
+
+;;; CIE 1976 L*u*u* (CIELUV) is based directly on CIE XYZ and is another
+;;; attampt to linearize the perceptibility of color differences.  L* is
+;;; CIE lightness as for L*a*b* above.  The non-linear relations for u*
+;;; and v* are:
+
+;;;     u* =  13 L* ( u' - un' )
+;;;     v* =  13 L* ( v' - vn' )
+
+;;; The quantities un' and vn' refer to the reference white or the light
+;;; source; for the 2� observer and illuminant C, un' = 0.2009, vn' =
+;;; 0.4610. Equations for u' and v' are given below:
+
+;;;     u' = 4 X / (X + 15 Y + 3 Z)
+;;;     v' = 9 Y / (X + 15 Y + 3 Z)
+
+(define (XYZ->uv XYZ)
+  (apply (lambda (X Y Z)
+	   (define denom (+ X (* 15 Y) (* 3 Z)))
+	   (if (zero? denom)
+	       '(4. 9.)
+	       (list (/ (* 4 X) denom)
+		     (/ (* 9 Y) denom))))
+	 XYZ))
+;@
+(define (CIEXYZ->L*u*v* XYZ . white-point)
+  (set! white-point (if (null? white-point)
+			CIEXYZ:D65
+			(car white-point)))
+  (let* ((Y/Yn (/ (cadr XYZ) (cadr white-point)))
+	 (L* (CIE:Y/Yn->L* Y/Yn)))
+    (cons L* (map (lambda (q) (* 13 L* q))
+		  (map - (XYZ->uv XYZ) (XYZ->uv white-point))))))
+
+;;; CIELUV to XYZ
+
+;;; The transformation from CIELUV to XYZ is performed as following:
+
+;;;     u' = u / ( 13 L* ) + un
+;;;     v' = v / ( 13 L* ) + vn
+;;;     X = 9 Y u' / 4 v'
+;;;     Z = ( 12 Y - 3 Y u' - 20 Y v' ) / 4 v'
+;@
+(define (L*u*v*->CIEXYZ L*u*v* . white-point)
+  (set! white-point (if (null? white-point)
+			CIEXYZ:D65
+			(car white-point)))
+  (apply (lambda (un vn)
+	   (apply (lambda (L* u* v*)
+		    (if (not (positive? L*))
+			'(0. 0. 0.)
+			(let* ((up (+ (/ u* 13 L*) un))
+			       (vp (+ (/ v* 13 L*) vn))
+			       (Y (* (CIE:L*->Y/Yn L*) (cadr white-point))))
+			  (list (/ (* 9 Y up) 4 vp)
+				Y
+				(/ (* Y (+ 12 (* -3 up) (* -20 vp))) 4 vp)))))
+		  L*u*v*))
+	 (XYZ->uv white-point)))
+
+;;; http://www.inforamp.net/~poynton/PDFs/coloureq.pdf
+
+(define pi (* 4 (atan 1)))
+(define pi/180 (/ pi 180))
+;@
+(define (L*a*b*->L*C*h lab)
+  (define h (/ (atan (caddr lab) (cadr lab)) pi/180))
+  (list (car lab)
+	(sqrt (apply + (map * (cdr lab) (cdr lab))))
+	(if (negative? h) (+ 360 h) h)))
+;@
+(define (L*C*h->L*a*b* lch)
+  (apply (lambda (L* C* h)
+	   (set! h (* h pi/180))
+	   (list L*
+		 (* C* (cos h))
+		 (* C* (sin h))))
+	 lch))
+;@
+(define (L*a*b*:DE* lab1 lab2)
+  (sqrt (apply + (map (lambda (x) (* x x)) (map - lab1 lab2)))))
+
+;;; http://www.colorpro.com/info/data/cie94.html
+
+(define (color:process-params parametric-factors)
+  (define ans
+    (case (length parametric-factors)
+      ((0) #f)
+      ((1) (if (list? parametric-factors)
+	       (apply color:process-params parametric-factors)
+	       (append parametric-factors '(1 1))))
+      ((2) (append parametric-factors '(1)))
+      ((3) parametric-factors)
+      (else (slib:error 'parametric-factors 'too-many parametric-factors))))
+  (and ans
+       (for-each (lambda (obj)
+		   (if (not (number? obj))
+		       (slib:error 'parametric-factors 'not 'number? obj)))
+		 ans))
+  ans)
+;@
+(define (L*C*h:DE*94 lch1 lch2 . parametric-factors)
+  (define C* (sqrt (* (cadr lch1) (cadr lch2)))) ;Geometric mean
+  (sqrt (apply + (map /
+		      (map (lambda (x) (* x x)) (map - lch1 lch2))
+		      (list 1		; S_l
+			    (+ 1 (* .045 C*)) ; S_c
+			    (+ 1 (* .015 C*))) ; S_h
+		      (or (color:process-params parametric-factors)
+			  '(1 1 1))))))
+
+;;; CMC-DE is designed only for small color-differences.  But try to do
+;;; something reasonable for large differences.  Use bisector (h*) of
+;;; the hue angles if separated by less than 90.o; otherwise, pick h of
+;;; the color with larger C*.
+;@
+(define (CMC-DE lch1 lch2 . parametric-factors)
+  (apply (lambda (L* C* h_)		;Geometric means
+	   (let ((ang1 (* pi/180 (caddr lch1)))
+		 (ang2 (* pi/180 (caddr lch2))))
+	     (cond ((>= 90 (abs (/ (atan (sin (- ang1 ang2))
+					 (cos (- ang1 ang2)))
+				   pi/180)))
+		    (set! h_ (/ (atan (+ (sin ang1) (sin ang2))
+				      (+ (cos ang1) (cos ang2)))
+				pi/180)))
+		   ((>= (cadr lch1) (cadr lch2)) (caddr lch1))
+		   (else (caddr lch2))))
+	   (let* ((C*^4 (expt C* 4))
+		  (f    (sqrt (/ C*^4 (+ C*^4 1900))))
+		  (T    (if (and (> h_ 164) (< h_ 345))
+			    (+ 0.56 (abs (* 0.2 (cos (* (+ h_ 168) pi/180)))))
+			    (+ 0.36 (abs (* 0.4 (cos (* (+ h_ 35) pi/180)))))))
+		  (S_l  (if (< L* 16)
+			    0.511
+			    (/ (* 0.040975 L*) (+ 1 (* 0.01765 L*)))))
+		  (S_c  (+ (/ (* 0.0638 C*) (+ 1 (* 0.0131 C*))) 0.638))
+		  (S_h  (* S_c (+ (* (+ -1 T) f) 1))))
+	     (sqrt (apply
+		    + (map /
+			   (map (lambda (x) (* x x)) (map - lch1 lch2))
+			   (list S_l S_c S_h)
+			   (or (color:process-params parametric-factors)
+			       '(2 1 1)))))))
+	 (map sqrt (map * lch1 lch2))))
+;@
+(define (XYZ:normalize-colors lst)
+  (define sum (apply max (map (lambda (XYZ) (apply + XYZ)) lst)))
+  (map (lambda (XYZ) (map (lambda (x) (/ x sum)) XYZ)) lst))
+;@
+(define (XYZ:normalize XYZ)
+  (car (XYZ:normalize-colors (list XYZ))))
+
+;;; Chromaticity
+;@
+(define (XYZ->chromaticity XYZ)
+  (define sum (apply + XYZ))
+  (list (/ (car XYZ) sum) (/ (cadr XYZ) sum)))
+;@
+(define (chromaticity->CIEXYZ x y)
+  (list x y (- 1 x y)))
+(define (chromaticity->whitepoint x y)
+  (list (/ x y) 1 (/ (- 1 x y) y)))
+;@
+(define (XYZ->xyY XYZ)
+  (define sum (apply + XYZ))
+  (if (zero? sum)
+      '(0 0 0)
+      (list (/ (car XYZ) sum) (/ (cadr XYZ) sum) (cadr XYZ))))
+;@
+(define (xyY->XYZ xyY)
+  (define x (car xyY))
+  (define y (cadr xyY))
+  (if (zero? y)
+      '(0 0 0)
+      (let ((Y/y (/ (caddr xyY) y)))
+	(list (* Y/y x) (caddr xyY) (* Y/y (- 1 x y))))))
+;@
+(define (xyY:normalize-colors lst . n)
+  (define (nthcdr n lst) (if (zero? n) lst (nthcdr (+ -1 n) (cdr lst))))
+  (define Ys (map caddr lst))
+  (set! n (if (null? n) 1 (car n)))
+  (let ((max-Y (if (positive? n)
+		   (* n (apply max Ys))
+		   (let ()
+		     (require 'sort)
+		     (apply max (nthcdr (- n) (sort Ys >=)))))))
+    (map (lambda (xyY)
+	   (let ((x (max 0 (car xyY)))
+		 (y (max 0 (cadr xyY))))
+	     (define sum (max 1 (+ x y)))
+	     (list (/ x sum)
+		   (/ y sum)
+		   (max 0 (min 1 (/ (caddr xyY) max-Y))))))
+	 lst)))
+
+;;;  http://www.aim-dtp.net/aim/technology/cie_xyz/cie_xyz.htm:
+;;;  Illuminant D65                           0.312713 0.329016
+;; (define CIEXYZ:D65 (chromaticity->whitepoint 0.312713 0.329016))
+;; (define CIEXYZ:D65 (chromaticity->whitepoint 0.3127 0.3290))
+;@
+(define CIEXYZ:D50 (chromaticity->whitepoint 0.3457 0.3585))
+
+;;; With its 16-bit resolution, e-sRGB-16 is extremely sensitive to
+;;; whitepoint.  Even the 6 digits of precision specified above is
+;;; insufficient to make (color->e-srgb 16 d65) ==> (57216 57216 57216)
+;@
+(define CIEXYZ:D65 (e-sRGB->CIEXYZ 16 '(57216 57216 57216)))
+
+;;; http://www.efg2.com/Lab/Graphics/Colors/Chromaticity.htm CIE 1931:
+;@
+(define CIEXYZ:A (chromaticity->whitepoint 0.44757 0.40745)) ; 2856.K
+(define CIEXYZ:B (chromaticity->whitepoint 0.34842 0.35161)) ; 4874.K
+(define CIEXYZ:C (chromaticity->whitepoint 0.31006 0.31616)) ; 6774.K
+(define CIEXYZ:E (chromaticity->whitepoint 1/3 1/3)) ; 5400.K
+
+;;; Converting spectra
+(define cie:x-bar #f)
+(define cie:y-bar #f)
+(define cie:z-bar #f)
+;@
+(define (load-ciexyz . path)
+  (let ((path (if (null? path)
+		  (in-vicinity (library-vicinity) "cie1931.xyz")
+		  (car path))))
+    (set! cie:x-bar (make-vector 80))
+    (set! cie:y-bar (make-vector 80))
+    (set! cie:z-bar (make-vector 80))
+    (call-with-input-file path
+      (lambda (iprt)
+	(do ((wlen 380 (+ 5 wlen))
+	     (idx 0 (+ 1 idx)))
+	    ((>= wlen 780))
+	  (let ((rlen (read iprt)))
+	    (if (not (eqv? wlen rlen))
+		(slib:error path 'expected wlen 'not rlen))
+	    (vector-set! cie:x-bar idx (read iprt))
+	    (vector-set! cie:y-bar idx (read iprt))
+	    (vector-set! cie:z-bar idx (read iprt))))))))
+;@
+(define (wavelength->XYZ wl)
+  (if (not cie:y-bar) (require 'ciexyz))
+  (set! wl (- (/ wl 5.e-9) 380/5))
+  (if (<= 0 wl (+ -1 400/5))
+      (let* ((wlf (inexact->exact (floor wl)))
+	     (res (- wl wlf)))
+	(define (interpolate vect idx res)
+	  (+ (* res (vector-ref vect idx))
+	     (* (- 1 res) (vector-ref vect (+ 1 idx)))))
+	(list (interpolate cie:x-bar wlf res)
+	      (interpolate cie:y-bar wlf res)
+	      (interpolate cie:z-bar wlf res)))
+      (slib:error 'wavelength->XYZ 'out-of-range wl)))
+(define (wavelength->CIEXYZ wl)
+  (XYZ:normalize (wavelength->XYZ wl)))
+(define (wavelength->chromaticity wl)
+  (XYZ->chromaticity (wavelength->XYZ wl)))
+;@
+(define (spectrum->XYZ . args)
+  (define x 0)
+  (define y 0)
+  (define z 0)
+  (if (not cie:y-bar) (require 'ciexyz))
+  (case (length args)
+    ((1)
+     (set! args (car args))
+     (do ((wvln 380.e-9 (+ 5.e-9 wvln))
+	  (idx 0 (+ 1 idx)))
+	 ((>= idx 80) (map (lambda (x) (/ x 80)) (list x y z)))
+       (let ((inten (args wvln)))
+	 (set! x (+ x (* (vector-ref cie:x-bar idx) inten)))
+	 (set! y (+ y (* (vector-ref cie:y-bar idx) inten)))
+	 (set! z (+ z (* (vector-ref cie:z-bar idx) inten))))))
+    ((3)
+     (let* ((vect (if (list? (car args)) (list->vector (car args)) (car args)))
+	    (vlen (vector-length vect))
+	    (x1 (cadr args))
+	    (x2 (caddr args))
+	    (xinc (/ (- x2 x1) (+ -1 vlen)))
+	    (x->j (lambda (x) (inexact->exact (round (/ (- x x1) xinc)))))
+	    (x->k (lambda (x) (inexact->exact (round (/ (- x 380.e-9) 5.e-9)))))
+	    (j->x (lambda (j) (+ x1 (* j xinc))))
+	    (k->x (lambda (k) (+ 380.e-9 (* k 5.e-9))))
+	    (xlo (max (min x1 x2) 380.e-9))
+	    (xhi (min (max x1 x2) 780.e-9))
+	    (jhi (x->j xhi))
+	    (khi (x->k xhi))
+	    (jinc (if (negative? xinc) -1 1)))
+       (if (<= (abs xinc) 5.e-9)
+	   (do ((wvln (j->x (x->j xlo)) (+ wvln (abs xinc)))
+		(jdx (x->j xlo) (+ jdx jinc)))
+	       ((>= jdx jhi)
+		(let ((nsmps (abs (- jhi (x->j xlo)))))
+		  (map (lambda (x) (/ x nsmps)) (list x y z))))
+	     (let ((ciedex (min 79 (x->k wvln)))
+		   (inten (vector-ref vect jdx)))
+	       (set! x (+ x (* (vector-ref cie:x-bar ciedex) inten)))
+	       (set! y (+ y (* (vector-ref cie:y-bar ciedex) inten)))
+	       (set! z (+ z (* (vector-ref cie:z-bar ciedex) inten)))))
+	   (do ((wvln (k->x (x->k xlo)) (+ wvln 5.e-9))
+		(kdx (x->k xlo) (+ kdx 1)))
+	       ((>= kdx khi)
+		(let ((nsmps (abs (- khi (x->k xlo)))))
+		  (map (lambda (x) (/ x nsmps)) (list x y z))))
+	     (let ((inten (vector-ref vect (x->j wvln))))
+	       (set! x (+ x (* (vector-ref cie:x-bar kdx) inten)))
+	       (set! y (+ y (* (vector-ref cie:y-bar kdx) inten)))
+	       (set! z (+ z (* (vector-ref cie:z-bar kdx) inten))))))))
+    (else (slib:error 'spectrum->XYZ 'wna args))))
+(define (spectrum->CIEXYZ . args)
+  (XYZ:normalize (apply spectrum->XYZ args)))
+(define (spectrum->chromaticity . args)
+  (XYZ->chromaticity (apply spectrum->XYZ args)))
+;@
+(define blackbody-spectrum
+  (let* ((c 2.998e8)
+	 (h 6.626e-34)
+	 (h*c (* h c))
+	 (k 1.381e-23)
+	 (pi*2*h*c*c (* 2 pi h*c c)))
+    (lambda (temp . span)
+      (define h*c/kT (/ h*c k temp))
+      (define pi*2*h*c*c*span (* pi*2*h*c*c (if (null? span) 1.e-9 (car span))))
+      (lambda (x)
+	(/ pi*2*h*c*c*span
+	   (expt x 5)
+	   (- (exp (/ h*c/kT x)) 1))))))
+;@
+(define (temperature->XYZ temp)
+  (spectrum->XYZ (blackbody-spectrum temp 5.e-9)))
+(define (temperature->CIEXYZ temp)
+  (XYZ:normalize (temperature->XYZ temp)))
+(define (temperature->chromaticity temp)
+  (XYZ->chromaticity (temperature->XYZ temp)))
diff --git a/comlist.scm b/comlist.scm
index 008a2b0..2e3a6ef 100644
--- a/comlist.scm
+++ b/comlist.scm
@@ -1,5 +1,5 @@
 ;;"comlist.scm" Implementation of COMMON LISP list functions for Scheme
-; Copyright (C) 1991, 1993, 1995, 2001 Aubrey Jaffer.
+; Copyright (C) 1991, 1993, 1995, 2001, 2003 Aubrey Jaffer.
 ; Copyright (C) 2000 Colin Walters
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
@@ -9,7 +9,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -27,25 +27,32 @@
 ;;; Colin Walters <walters@cis.ohio-state.edu>
 ;;; AGJ restored order July 2001.
 
-;;;From: hugh@ear.mit.edu (Hugh Secker-Walker)
-(define (comlist:make-list k . init)
+;;;@ From: hugh@ear.mit.edu (Hugh Secker-Walker)
+(define (make-list k . init)
   (set! init (if (pair? init) (car init)))
   (do ((k k (+ -1 k))
        (result '() (cons init result)))
       ((<= k 0) result)))
-
-(define (comlist:copy-list lst) (append lst '()))
-
-(define (comlist:adjoin obj lst) (if (memv obj lst) lst (cons obj lst)))
-
-(define (comlist:union lst1 lst2)
-  (define ans (if (null? lst1) lst2 lst1))
-  (cond ((null? lst2) lst1)
-	(else (for-each (lambda (elt) (set! ans (comlist:adjoin elt ans)))
-			lst2)
-	      ans)))
-
-(define (comlist:intersection lst1 lst2)
+;@
+(define (copy-list lst) (append lst '()))
+;@
+(define (adjoin obj lst) (if (memv obj lst) lst (cons obj lst)))
+;@
+(define union
+  (letrec ((onion
+	    (lambda (lst1 lst2)
+	      (if (null? lst1)
+		  lst2
+		  (onion (cdr lst1) (comlist:adjoin (car lst1) lst2))))))
+    (lambda (lst1 lst2)
+      (cond ((null? lst1) lst2)
+	    ((null? lst2) lst1)
+	    ((null? (cdr lst1)) (comlist:adjoin (car lst1) lst2))
+	    ((null? (cdr lst2)) (comlist:adjoin (car lst2) lst1))
+	    ((< (length lst2) (length lst1)) (onion (reverse lst2) lst1))
+	    (else (onion (reverse lst1) lst2))))))
+;@
+(define (intersection lst1 lst2)
   (if (null? lst2)
       lst2
       (let build-intersection ((lst1 lst1)
@@ -55,8 +62,8 @@
 	       (build-intersection (cdr lst1) (cons (car lst1) result)))
 	      (else
 	       (build-intersection (cdr lst1) result))))))
-
-(define (comlist:set-difference lst1 lst2)
+;@
+(define (set-difference lst1 lst2)
   (if (null? lst2)
       lst1
       (let build-difference ((lst1 lst1)
@@ -64,25 +71,32 @@
 	(cond ((null? lst1) (reverse result))
 	      ((memv (car lst1) lst2) (build-difference (cdr lst1) result))
 	      (else (build-difference (cdr lst1) (cons (car lst1) result)))))))
-
-(define (comlist:position obj lst)
-  (letrec ((pos (lambda (n lst)
-		  (cond ((null? lst) #f)
-			((eqv? obj (car lst)) n)
-			(else (pos (+ 1 n) (cdr lst)))))))
-    (pos 0 lst)))
-
-(define (comlist:reduce-init pred? init lst)
+;@
+(define (subset? lst1 lst2)
+  (or (eq? lst1 lst2)
+      (let loop ((lst1 lst1))
+	(or (null? lst1)
+	    (and (memv (car lst1) lst2)
+		 (loop (cdr lst1)))))))
+;@
+(define (position obj lst)
+  (define pos (lambda (n lst)
+		(cond ((null? lst) #f)
+		      ((eqv? obj (car lst)) n)
+		      (else (pos (+ 1 n) (cdr lst))))))
+  (pos 0 lst))
+;@
+(define (reduce-init pred? init lst)
   (if (null? lst)
       init
       (comlist:reduce-init pred? (pred? init (car lst)) (cdr lst))))
-
-(define (comlist:reduce pred? lst)
+;@
+(define (reduce pred? lst)
   (cond ((null? lst) lst)
 	((null? (cdr lst)) (car lst))
 	(else (comlist:reduce-init pred? (car lst) (cdr lst)))))
-
-(define (comlist:some pred lst . rest)
+;@
+(define (some pred lst . rest)
   (cond ((null? rest)
 	 (let mapf ((lst lst))
 	   (and (not (null? lst))
@@ -91,8 +105,8 @@
 		(and (not (null? lst))
 		     (or (apply pred (car lst) (map car rest))
 			 (mapf (cdr lst) (map cdr rest))))))))
-
-(define (comlist:every pred lst . rest)
+;@
+(define (every pred lst . rest)
   (cond ((null? rest)
 	 (let mapf ((lst lst))
 	   (or (null? lst)
@@ -101,18 +115,18 @@
 		(or (null? lst)
 		    (and (apply pred (car lst) (map car rest))
 			 (mapf (cdr lst) (map cdr rest))))))))
-
-(define (comlist:notany pred . ls) (not (apply comlist:some pred ls)))
-
-(define (comlist:notevery pred . ls) (not (apply comlist:every pred ls)))
-
-(define (comlist:list-of?? predicate . bound)
+;@
+(define (notany pred . ls) (not (apply comlist:some pred ls)))
+;@
+(define (notevery pred . ls) (not (apply comlist:every pred ls)))
+;@
+(define (list-of?? predicate . bound)
   (define (errout) (apply slib:error 'list-of?? predicate bound))
   (case (length bound)
     ((0)
      (lambda (obj)
        (and (list? obj)
-	    (every predicate obj))))
+	    (comlist:every predicate obj))))
     ((1)
      (set! bound (car bound))
      (cond ((negative? bound)
@@ -120,12 +134,12 @@
 	    (lambda (obj)
 	      (and (list? obj)
 		   (<= bound (length obj))
-		   (every predicate obj))))
+		   (comlist:every predicate obj))))
 	   (else
 	    (lambda (obj)
 	      (and (list? obj)
 		   (<= (length obj) bound)
-		   (every predicate obj))))))
+		   (comlist:every predicate obj))))))
     ((2)
      (let ((low (car bound))
 	   (high (cadr bound)))
@@ -136,45 +150,45 @@
        (lambda (obj)
 	 (and (list? obj)
 	      (<= low (length obj) high)
-	      (every predicate obj)))))
+	      (comlist:every predicate obj)))))
     (else (errout))))
-
-(define (comlist:find-if pred? lst)
+;@
+(define (find-if pred? lst)
   (cond ((null? lst) #f)
 	((pred? (car lst)) (car lst))
 	(else (comlist:find-if pred? (cdr lst)))))
-
-(define (comlist:member-if pred? lst)
+;@
+(define (member-if pred? lst)
   (cond ((null? lst) #f)
 	((pred? (car lst)) lst)
 	(else (comlist:member-if pred? (cdr lst)))))
-
-(define (comlist:remove pred? lst)
+;@
+(define (remove obj lst)
   (define head (list '*head*))
   (let remove ((lst lst)
 	       (tail head))
     (cond ((null? lst))
-	  ((eqv? pred? (car lst)) (remove (cdr lst) tail))
+	  ((eqv? obj (car lst)) (remove (cdr lst) tail))
 	  (else
 	   (set-cdr! tail (list (car lst)))
 	   (remove (cdr lst) (cdr tail)))))
   (cdr head))
-
-(define (comlist:remove-if pred? lst)
+;@
+(define (remove-if pred? lst)
   (let remove-if ((lst lst)
 		  (result '()))
     (cond ((null? lst) (reverse result))
 	  ((pred? (car lst)) (remove-if (cdr lst) result))
 	  (else (remove-if (cdr lst) (cons (car lst) result))))))
-
-(define (comlist:remove-if-not pred? lst)
+;@
+(define (remove-if-not pred? lst)
   (let remove-if-not ((lst lst)
 		      (result '()))
     (cond ((null? lst) (reverse result))
 	  ((pred? (car lst)) (remove-if-not (cdr lst) (cons (car lst) result)))
 	  (else (remove-if-not (cdr lst) result)))))
-
-(define comlist:nconc
+;@
+(define nconc
   (if (provided? 'rev2-procedures) append!
       (lambda args
 	(cond ((null? args) '())
@@ -185,8 +199,8 @@
 			 (apply comlist:nconc (cdr args)))
 	       (car args))))))
 
-;;;From: hugh@ear.mit.edu (Hugh Secker-Walker)
-(define (comlist:nreverse rev-it)
+;;;@ From: hugh@ear.mit.edu (Hugh Secker-Walker)
+(define (nreverse rev-it)
 ;;; Reverse order of elements of LIST by mutating cdrs.
   (cond ((null? rev-it) rev-it)
 	((not (list? rev-it))
@@ -195,100 +209,85 @@
 		   (rev-cdr (cdr rev-it) (cdr rev-cdr))
 		   (rev-it rev-it rev-cdr))
 		  ((begin (set-cdr! rev-it reved) (null? rev-cdr)) rev-it)))))
-
-(define (comlist:last lst n)
+;@
+(define (last lst n)
   (comlist:nthcdr (- (length lst) n) lst))
-
-(define (comlist:butlast lst n)
-  (letrec
-      ((len (- (length lst) n))
-       (bl (lambda (lst n)
-	     (let build-until-zero ((lst lst)
-				    (n n)
-				    (result '()))
-	       (cond ((null? lst) (reverse result))
-		     ((positive? n)
-		      (build-until-zero
-		       (cdr lst) (- n 1) (cons (car lst) result)))
-		     (else (reverse result)))))))
-    (bl lst (if (negative? n)
-		(slib:error "negative argument to butlast" n)
-		len))))
-
-(define (comlist:nthcdr n lst)
+;@
+(define (butlast lst n)
+  (comlist:butnthcdr (- (length lst) n) lst))
+;@
+(define (nthcdr n lst)
   (if (zero? n) lst (comlist:nthcdr (+ -1 n) (cdr lst))))
-
-(define (comlist:butnthcdr n lst)
-  (letrec
-      ((bl (lambda (lst n)
-	     (let build-until-zero ((lst lst)
-				    (n n)
-				    (result '()))
-	       (cond ((null? lst) (reverse result))
-		     ((positive? n)
-		      (build-until-zero
-		       (cdr lst) (- n 1) (cons (car lst) result)))
-		     (else (reverse result)))))))
-    (bl lst (if (negative? n)
-		(slib:error "negative argument to butnthcdr" n)
-		n))))
+;@
+(define (butnthcdr k lst)
+  (cond ((negative? k) lst) ;(slib:error "negative argument to butnthcdr" k)
+					; SIMSYNCH FIFO8 uses negative k.
+	((or (zero? k) (null? lst)) '())
+	(else (let ((ans (list (car lst))))
+		(do ((lst (cdr lst) (cdr lst))
+		     (tail ans (cdr tail))
+		     (k (+ -2 k) (+ -1 k)))
+		    ((or (negative? k) (null? lst)) ans)
+		  (set-cdr! tail (list (car lst))))))))
 
 ;;;; CONDITIONALS
-
-(define (comlist:and? . args)
+;@
+(define (and? . args)
   (cond ((null? args) #t)
 	((car args) (apply comlist:and? (cdr args)))
 	(else #f)))
-
-(define (comlist:or? . args)
+;@
+(define (or? . args)
   (cond ((null? args) #f)
 	((car args) #t)
 	(else (apply comlist:or? (cdr args)))))
 
-;;; Checks to see if a list has any duplicate MEMBERs.
-(define (comlist:has-duplicates? lst)
+;;;@ Checks to see if a list has any duplicate MEMBERs.
+(define (has-duplicates? lst)
   (cond ((null? lst) #f)
 	((member (car lst) (cdr lst)) #t)
 	(else (comlist:has-duplicates? (cdr lst)))))
 
-;;; remove duplicates of MEMBERs of a list
-(define (comlist:remove-duplicates lst)
+;;;@ remove duplicates of MEMBERs of a list
+(define remove-duplicates
   (letrec ((rem-dup
 	    (lambda (lst nlst)
 	      (cond ((null? lst) (reverse nlst))
 		    ((member (car lst) nlst) (rem-dup (cdr lst) nlst))
 		    (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
-    (rem-dup lst '())))
-
-(define (comlist:list* obj1 . obj2)
-  (define (list*1 obj)
-    (if (null? (cdr obj))
-	(car obj)
-	(cons (car obj) (list*1 (cdr obj)))))
-  (if (null? obj2)
-      obj1
-      (cons obj1 (list*1 obj2))))
-
-(define (comlist:atom? obj)
+    (lambda (lst)
+      (rem-dup lst '()))))
+;@
+(define list*
+  (letrec ((list*1 (lambda (obj)
+		     (if (null? (cdr obj))
+			 (car obj)
+			 (cons (car obj) (list*1 (cdr obj)))))))
+    (lambda (obj1 . obj2)
+      (if (null? obj2)
+	  obj1
+	  (cons obj1 (list*1 obj2))))))
+;@
+(define (atom? obj)
   (not (pair? obj)))
-
-(define (comlist:delete obj lst)
+;@
+(define (delete obj lst)
   (let delete ((lst lst))
     (cond ((null? lst) '())
 	  ((equal? obj (car lst)) (delete (cdr lst)))
 	  (else
 	   (set-cdr! lst (delete (cdr lst)))
 	   lst))))
-
-(define (comlist:delete-if pred lst)
+;@
+(define (delete-if pred lst)
   (let delete-if ((lst lst))
     (cond ((null? lst) '())
 	  ((pred (car lst)) (delete-if (cdr lst)))
 	  (else
 	   (set-cdr! lst (delete-if (cdr lst)))
 	   lst))))
-
-(define (comlist:delete-if-not pred lst)
+;@
+(define (delete-if-not pred lst)
   (let delete-if ((lst lst))
     (cond ((null? lst) '())
 	  ((not (pred (car lst))) (delete-if (cdr lst)))
@@ -296,42 +295,42 @@
 	   (set-cdr! lst (delete-if (cdr lst)))
 	   lst))))
 
-;;; exports
-
-(define make-list comlist:make-list)
-(define copy-list comlist:copy-list)
-(define adjoin comlist:adjoin)
-(define union comlist:union)
-(define intersection comlist:intersection)
-(define set-difference comlist:set-difference)
-(define position comlist:position)
-(define reduce-init comlist:reduce-init)
-(define reduce comlist:reduce) ; reduce is also in collect.scm
-(define some comlist:some)
-(define every comlist:every)
-(define notevery comlist:notevery)
-(define notany comlist:notany)
-(define find-if comlist:find-if)
-(define member-if comlist:member-if)
-(define remove comlist:remove)
-(define remove-if comlist:remove-if)
-(define remove-if-not comlist:remove-if-not)
-(define nconc comlist:nconc)
-(define nreverse comlist:nreverse)
-(define last comlist:last)
-(define butlast comlist:butlast)
-(define nthcdr comlist:nthcdr)
-(define butnthcdr comlist:butnthcdr)
-(define and? comlist:and?)
-(define or? comlist:or?)
-(define has-duplicates? comlist:has-duplicates?)
-(define remove-duplicates comlist:remove-duplicates)
-
-(define delete-if-not comlist:delete-if-not)
-(define delete-if comlist:delete-if)
-(define delete comlist:delete)
-(define comlist:atom comlist:atom?)
-(define atom comlist:atom?)
-(define atom? comlist:atom?)
-(define list* comlist:list*)
-(define list-of?? comlist:list-of??)
+;;; internal versions safe from name collisions.
+
+;;(define comlist:make-list make-list)
+;;(define comlist:copy-list copy-list)
+(define comlist:adjoin adjoin)
+;;(define comlist:union union)
+;;(define comlist:intersection intersection)
+;;(define comlist:set-difference set-difference)
+;;(define comlist:subset? subset?)
+;;(define comlist:position position)
+(define comlist:reduce-init reduce-init)
+;;(define comlist:reduce reduce) ; reduce is also in collect.scm
+(define comlist:some some)
+(define comlist:every every)
+;;(define comlist:notevery notevery)
+;;(define comlist:notany notany)
+(define comlist:find-if find-if)
+(define comlist:member-if member-if)
+;;(define comlist:remove remove)
+;;(define comlist:remove-if remove-if)
+;;(define comlist:remove-if-not remove-if-not)
+(define comlist:nconc nconc)
+;;(define comlist:nreverse nreverse)
+;;(define comlist:last last)
+;;(define comlist:butlast butlast)
+(define comlist:nthcdr nthcdr)
+(define comlist:butnthcdr butnthcdr)
+(define comlist:and? and?)
+(define comlist:or? or?)
+(define comlist:has-duplicates? has-duplicates?)
+;;(define comlist:remove-duplicates remove-duplicates)
+;;(define comlist:delete-if-not delete-if-not)
+;;(define comlist:delete-if delete-if)
+;;(define comlist:delete delete)
+;;(define comlist:atom? atom?)
+;;(define atom atom?)
+;;(define comlist:atom atom?)
+;;(define comlist:list* list*)
+;;(define comlist:list-of?? list-of??)
diff --git a/comparse.scm b/comparse.scm
index 5a007b6..5dc1a50 100644
--- a/comparse.scm
+++ b/comparse.scm
@@ -1,5 +1,5 @@
 ;;; "comparse.scm" Break command line into arguments.
-;Copyright (C) 1995, 1997 Aubrey Jaffer
+;Copyright (C) 1995, 1997, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -24,6 +24,10 @@
 ;;; reading files of options -- therefore READ-OPTIONS-FILE.
 
 (require 'string-port)
+
+;;@code{(require 'read-command)}
+;;@ftindex read-command
+
 (define (read-command-from-port port nl-term?)
   (define argv '())
   (define obj "")
@@ -86,6 +90,64 @@
     (cond ((and (null? argv) (eof-object? c)) c)
 	  (else (reverse argv)))))
 
+;;@args port
+;;@args
+;;@code{read-command} converts a @dfn{command line} into a list of strings
+;;@cindex command line
+;;suitable for parsing by @code{getopt}.  The syntax of command lines
+;;supported resembles that of popular @dfn{shell}s.  @code{read-command}
+;;updates @var{port} to point to the first character past the command
+;;delimiter.
+;;
+;;If an end of file is encountered in the input before any characters are
+;;found that can begin an object or comment, then an end of file object is
+;;returned.
+;;
+;;The @var{port} argument may be omitted, in which case it defaults to the
+;;value returned by @code{current-input-port}.
+;;
+;;The fields into which the command line is split are delimited by
+;;whitespace as defined by @code{char-whitespace?}.  The end of a command
+;;is delimited by end-of-file or unescaped semicolon (@key{;}) or
+;;@key{newline}.  Any character can be literally included in a field by
+;;escaping it with a backslach (@key{\}).
+;;
+;;The initial character and types of fields recognized are:
+;;@table @asis
+;;@item @samp{\}
+;;The next character has is taken literally and not interpreted as a field
+;;delimiter.  If @key{\} is the last character before a @key{newline},
+;;that @key{newline} is just ignored.  Processing continues from the
+;;characters after the @key{newline} as though the backslash and
+;;@key{newline} were not there.
+;;@item @samp{"}
+;;The characters up to the next unescaped @key{"} are taken literally,
+;;according to [R4RS] rules for literal strings (@pxref{Strings, , ,r4rs,
+;;Revised(4) Scheme}).
+;;@item @samp{(}, @samp{%'}
+;;One scheme expression is @code{read} starting with this character.  The
+;;@code{read} expression is evaluated, converted to a string
+;;(using @code{display}), and replaces the expression in the returned
+;;field.
+;;@item @samp{;}
+;;Semicolon delimits a command.  Using semicolons more than one command
+;;can appear on a line.  Escaped semicolons and semicolons inside strings
+;;do not delimit commands.
+;;@end table
+;;
+;;@noindent
+;;The comment field differs from the previous fields in that it must be
+;;the first character of a command or appear after whitespace in order to
+;;be recognized.  @key{#} can be part of fields if these conditions are
+;;not met.  For instance, @code{ab#c} is just the field ab#c.
+;;
+;;@table @samp
+;;@item #
+;;Introduces a comment.  The comment continues to the end of the line on
+;;which the semicolon appears.  Comments are treated as whitespace by
+;;@code{read-dommand-line} and backslashes before @key{newline}s in
+;;comments are also ignored.
+;;@end table
 (define (read-command . port)
   (read-command-from-port (cond ((null? port) (current-input-port))
 				((= 1 (length port)) (car port))
@@ -94,6 +156,16 @@
 					     "Wrong Number of ARGs:" port)))
 			  #t))
 
+;;@body
+;;@code{read-options-file} converts an @dfn{options file} into a list of
+;;@cindex options file
+;;strings suitable for parsing by @code{getopt}.  The syntax of options
+;;files is the same as the syntax for command
+;;lines, except that @key{newline}s do not terminate reading (only @key{;}
+;;or end of file).
+;;
+;;If an end of file is encountered before any characters are found that
+;;can begin an object or comment, then an end of file object is returned.
 (define (read-options-file filename)
   (call-with-input-file filename
     (lambda (port) (read-command-from-port port #f))))
diff --git a/comparse.txi b/comparse.txi
new file mode 100644
index 0000000..3ebe785
--- /dev/null
+++ b/comparse.txi
@@ -0,0 +1,81 @@
+@code{(require 'read-command)}
+@ftindex read-command
+
+
+@defun read-command port
+
+
+@defunx read-command
+@code{read-command} converts a @dfn{command line} into a list of strings
+@cindex command line
+@cindex command line
+suitable for parsing by @code{getopt}.  The syntax of command lines
+supported resembles that of popular @dfn{shell}s.  @code{read-command}
+@cindex shell
+updates @var{port} to point to the first character past the command
+delimiter.
+
+If an end of file is encountered in the input before any characters are
+found that can begin an object or comment, then an end of file object is
+returned.
+
+The @var{port} argument may be omitted, in which case it defaults to the
+value returned by @code{current-input-port}.
+
+The fields into which the command line is split are delimited by
+whitespace as defined by @code{char-whitespace?}.  The end of a command
+is delimited by end-of-file or unescaped semicolon (@key{;}) or
+@key{newline}.  Any character can be literally included in a field by
+escaping it with a backslach (@key{\}).
+
+The initial character and types of fields recognized are:
+@table @asis
+@item @samp{\}
+The next character has is taken literally and not interpreted as a field
+delimiter.  If @key{\} is the last character before a @key{newline},
+that @key{newline} is just ignored.  Processing continues from the
+characters after the @key{newline} as though the backslash and
+@key{newline} were not there.
+@item @samp{"}
+The characters up to the next unescaped @key{"} are taken literally,
+according to [R4RS] rules for literal strings (@pxref{Strings, , ,r4rs,
+Revised(4) Scheme}).
+@item @samp{(}, @samp{%'}
+One scheme expression is @code{read} starting with this character.  The
+@code{read} expression is evaluated, converted to a string
+(using @code{display}), and replaces the expression in the returned
+field.
+@item @samp{;}
+Semicolon delimits a command.  Using semicolons more than one command
+can appear on a line.  Escaped semicolons and semicolons inside strings
+do not delimit commands.
+@end table
+
+@noindent
+The comment field differs from the previous fields in that it must be
+the first character of a command or appear after whitespace in order to
+be recognized.  @key{#} can be part of fields if these conditions are
+not met.  For instance, @code{ab#c} is just the field ab#c.
+
+@table @samp
+@item #
+Introduces a comment.  The comment continues to the end of the line on
+which the semicolon appears.  Comments are treated as whitespace by
+@code{read-dommand-line} and backslashes before @key{newline}s in
+comments are also ignored.
+@end table
+@end defun
+
+@defun read-options-file filename
+
+@code{read-options-file} converts an @dfn{options file} into a list of
+@cindex options file
+@cindex options file
+strings suitable for parsing by @code{getopt}.  The syntax of options
+files is the same as the syntax for command
+lines, except that @key{newline}s do not terminate reading (only @key{;}
+or end of file).
+
+If an end of file is encountered before any characters are found that
+can begin an object or comment, then an end of file object is returned.
+@end defun
diff --git a/crc.scm b/crc.scm
new file mode 100644
index 0000000..423622b
--- /dev/null
+++ b/crc.scm
@@ -0,0 +1,137 @@
+;;;; "crc.scm" Compute Cyclic Checksums
+;;; Copyright (C) 1995, 1996, 1997, 2001, 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'byte)
+(require 'logical)
+
+;;@ (define CRC-32-polynomial    "100000100100000010001110110110111") ; IEEE-802, FDDI
+(define CRC-32-polynomial    "100000100110000010001110110110111") ; IEEE-802, AAL5
+;@
+(define CRC-CCITT-polynomial "10001000000100001")	; X25
+;@
+(define CRC-16-polynomial    "11000000000000101")	; IBM Bisync, HDLC, SDLC, USB-Data
+
+;;@ (define CRC-12-polynomial    "1100000001101")
+(define CRC-12-polynomial    "1100000001111")
+
+;;@ (define CRC-10-polynomial   "11000110001")
+(define CRC-10-polynomial   "11000110011")
+;@
+(define CRC-08-polynomial    "100000111")
+;@
+(define ATM-HEC-polynomial   "100000111")
+;@
+(define DOWCRC-polynomial    "100110001")
+;@
+(define USB-Token-polynomial "100101")
+
+;;This procedure is careful not to use more than DEG bits in
+;;computing (- (expt 2 DEG) 1).  It returns #f if the integer would
+;;be larger than the implementation supports.
+(define (crc:make-mask deg)
+  (string->number (make-string deg #\1) 2))
+;@
+(define (crc:make-table str)
+  (define deg (+ -1 (string-length str)))
+  (define generator (string->number (substring str 1 (string-length str)) 2))
+  (define crctab (make-vector 256))
+  (if (not (eqv? #\1 (string-ref str 0)))
+      (slib:error 'crc:make-table 'first-digit-of-polynomial-must-be-1 str))
+  (if (< deg 8)
+      (slib:error 'crc:make-table 'degree-must-be>7 deg str))
+  (and
+   generator
+   (do ((i 0 (+ 1 i))
+	(deg-1-mask (crc:make-mask (+ -1 deg)))
+	(gen generator
+	     (if (logbit? (+ -1 deg) gen)
+		 (logxor (ash (logand deg-1-mask gen) 1) generator)
+		 (ash (logand deg-1-mask gen) 1)))
+	(gens '() (cons gen gens)))
+       ((>= i 8) (set! gens (reverse gens))
+	(do ((crc 0 0)
+	     (m 0 (+ 1 m)))
+	    ((> m 255) crctab)
+	  (for-each (lambda (gen i)
+		      (set! crc (if (logbit? i m) (logxor crc gen) crc)))
+		    gens '(0 1 2 3 4 5 6 7))
+	  (vector-set! crctab m crc))))))
+
+(define crc-32-table (crc:make-table CRC-32-polynomial))
+
+;;@ Computes the P1003.2/D11.2 (POSIX.2) 32-bit checksum.
+(define (cksum file)
+  (cond ((not crc-32-table) #f)
+	((input-port? file) (cksum-port file))
+	(else (call-with-input-file file cksum-port))))
+
+(define cksum-port
+  (let ((mask-24 (crc:make-mask 24))
+	(mask-32 (crc:make-mask 32)))
+    (lambda (port)
+      (define crc 0)
+      (define (accumulate-crc byt)
+	(set! crc
+	      (logxor (ash (logand mask-24 crc) 8)
+		      (vector-ref crc-32-table (logxor (ash crc -24) byt)))))
+      (do ((byt (read-byte port) (read-byte port))
+	   (byte-count 0 (+ 1 byte-count)))
+	  ((eof-object? byt)
+	   (do ((byte-count byte-count (ash byte-count -8)))
+	       ((zero? byte-count) (logxor mask-32 crc))
+	     (accumulate-crc (logand #xff byte-count))))
+	(accumulate-crc byt)))))
+;@
+(define (crc16 file)
+  (cond ((not crc-16-table) #f)
+	((input-port? file) (crc16-port file))
+	(else (call-with-input-file file crc16-port))))
+
+(define crc-16-table (crc:make-table CRC-16-polynomial))
+
+(define crc16-port
+  (let ((mask-8 (crc:make-mask 8))
+	(mask-16 (crc:make-mask 16)))
+    (lambda (port)
+      (define crc mask-16)
+      (define (accumulate-crc byt)
+	(set! crc
+	      (logxor (ash (logand mask-8 crc) 8)
+		      (vector-ref crc-16-table (logxor (ash crc -8) byt)))))
+      (do ((byt (read-byte port) (read-byte port)))
+	  ((eof-object? byt) (logxor mask-16 crc))
+	(accumulate-crc byt)))))
+;@
+(define (crc5 file)
+  (cond ((input-port? file) (crc5-port file))
+	(else (call-with-input-file file crc5-port))))
+
+(define (crc5-port port)
+  (define generator #b00101)
+  (define crc #b11111)
+  (do ((byt (read-byte port) (read-byte port)))
+      ((eof-object? byt) (logxor #b11111 crc))
+    (do ((data byt (ash data 1))
+	 (len (+ -1 8) (+ -1 len)))
+	((negative? len))
+      (set! crc
+	    (logand #b11111
+		    (if (eqv? (logbit? 7 data) (logbit? 4 crc))
+			(ash crc 1)
+			(logxor (ash crc 1) generator)))))))
diff --git a/cring.scm b/cring.scm
index dfbb027..97a637d 100644
--- a/cring.scm
+++ b/cring.scm
@@ -1,5 +1,5 @@
 ;;;"cring.scm" Extend Scheme numerics to any commutative ring.
-;Copyright (C) 1997, 1998 Aubrey Jaffer
+;Copyright (C) 1997, 1998, 2001 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -19,10 +19,21 @@
 
 (require 'common-list-functions)
 (require 'relational-database)
-(require 'database-utilities)
+(require 'databases)
 (require 'sort)
+(require-if '(not inexact) 'logical)	;for integer-expt
+(define number^ (if (provided? 'inexact) expt integer-expt))
+
+(define number* *)
+(define number+ +)
+(define number- -)
+(define number/ /)
+(define number0? zero?)
+(define (zero? x) (and (number? x) (number0? x)))
+;;(define (sign x) (if (positive? x) 1 (if (negative? x) -1 0)))
 
 (define cring:db (create-database #f 'alist-table))
+;@
 (define (make-ruleset . rules)
   (define name #f)
   (cond ((and (not (null? rules)) (symbol? (car rules)))
@@ -41,12 +52,13 @@
 	 (list (table 'get 'reduction)
 	       (table 'row:update)
 	       table))))
+;@
 (define *ruleset* (make-ruleset 'default))
 (define (cring:define-rule . args)
   (if *ruleset*
       ((cadr *ruleset*) args)
       (slib:warn "No ruleset in *ruleset*")))
-
+;@
 (define (combined-rulesets . rulesets)
   (define name #f)
   (cond ((symbol? (car rulesets))
@@ -59,6 +71,7 @@
 		     rulesets))))
 
 ;;; Distribute * over + (and -)
+;@
 (define distribute*
   (make-ruleset
    'distribute*
@@ -72,6 +85,7 @@
 	  (apply - (map (lambda (trm) (* trm exp2)) (cdr exp1)))))))
 
 ;;; Distribute / over + (and -)
+;@
 (define distribute/
   (make-ruleset
    'distribute/
@@ -103,15 +117,7 @@
 	(else (expression-< (cdr x) (cdr y)))))
 (define (expression-sort seq) (sort! seq expression-<))
 
-(define number* *)
-(define number+ +)
-(define number- -)
-(define number/ /)
-(define number^ integer-expt)
 (define is-term-op? (lambda (term op) (and (pair? term) (eq? op (car term)))))
-;;(define (sign x) (if (positive? x) 1 (if (negative? x) -1 0)))
-(define number0? zero?)
-(define (zero? x) (and (number? x) (number0? x)))
 
 ;; To convert to CR internal form, NUMBER-op all the `numbers' in the
 ;; argument list and remove them from the argument list.  Collect the
diff --git a/cvs.scm b/cvs.scm
new file mode 100644
index 0000000..f1c853c
--- /dev/null
+++ b/cvs.scm
@@ -0,0 +1,140 @@
+;;;;"cvs.scm" enumerate files under CVS control.
+;;; Copyright 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'scanf)
+(require 'line-i/o)
+(require 'string-search)
+
+;;@body Returns a list of the local pathnames (with prefix @1) of all
+;;CVS controlled files in @1 and in @1's subdirectories.
+(define (cvs-files directory/)
+  (cvs:entries directory/ #t))
+
+;;@body Returns a list of all of @1 and all @1's CVS controlled
+;;subdirectories.
+(define (cvs-directories directory/)
+  (and (file-exists? (in-vicinity directory/ "CVS/Entries"))
+       (cons directory/ (cvs:entries directory/ #f))))
+
+(define (cvs:entries directory do-files?)
+  (define files '())
+  (define cvse (in-vicinity directory "CVS/Entries"))
+  (define cvsel (in-vicinity directory "CVS/Entries.Log"))
+  (set! directory (substring directory
+			     (if (eqv? 0 (substring? "./" directory)) 2 0)
+			     (string-length directory)))
+  (if (file-exists? cvse)
+      (call-with-input-file cvse
+	(lambda (port)
+	  (do ((line (read-line port) (read-line port)))
+	      ((eof-object? line))
+	    (let ((fname #f))
+	      (cond ((eqv? 1 (sscanf line "/%[^/]" fname))
+		     (and do-files?
+			  (set! files
+				(cons (in-vicinity directory fname) files))))
+		    ((eqv? 1 (sscanf line "D/%[^/]" fname))
+		     (set! files
+			   (append (cvs:entries (sub-vicinity directory fname)
+						do-files?)
+				   (if do-files? '()
+				       (list (sub-vicinity directory fname)))
+				   files))))))))
+      (slib:warn 'cvs:entries 'missing cvse))
+  (set! files (reverse files))
+  (if (file-exists? cvsel)
+      (call-with-input-file cvsel
+	(lambda (port)
+	  (do ((line (read-line port) (read-line port)))
+	      ((eof-object? line) files)
+	    (let ((fname #f))
+	      (cond ((eqv? 1 (sscanf line "A D/%[^/]/" fname))
+		     (set! files
+			   (append files
+				   (if do-files? '()
+				       (list (sub-vicinity directory fname)))
+				   (cvs:entries (sub-vicinity directory fname)
+						do-files?)))))))))
+      files))
+
+;;@body Returns the (string) contents of @var{path/}CVS/Root;
+;;or @code{(getenv "CVSROOT")} if Root doesn't exist.
+(define (cvs-root path/)
+  (if (not (vicinity:suffix? (string-ref path/ (+ -1 (string-length path/)))))
+      (slib:error 'missing 'vicinity-suffix path/))
+  (let ((rootpath (string-append path/ "CVS/Root")))
+    (if (file-exists? rootpath)
+	(call-with-input-file rootpath read-line)
+	(getenv "CVSROOT"))))
+
+;;@body Returns the (string) contents of @var{directory/}CVS/Root appended
+;;with @var{directory/}CVS/Repository; or #f if @var{directory/}CVS/Repository
+;;doesn't exist.
+(define (cvs-repository directory/)
+  (let ((root (cvs-root directory/))
+	(repath (in-vicinity (sub-vicinity directory/ "CVS/") "Repository")))
+    (define root/idx (substring? "/" root))
+    (define rootlen (string-length root))
+    (and
+     root/idx
+     (file-exists? repath)
+     (let ((repos (call-with-input-file repath read-line)))
+       (define replen (and (string? repos) (string-length repos)))
+       (cond ((not (and replen (< 1 replen))) #f)
+	     ((not (char=? #\/ (string-ref repos 0)))
+	      (string-append root "/" repos))
+	     ((eqv? 0 (substring? (substring root root/idx rootlen) repos))
+	      (string-append
+	       root
+	       (substring repos (- rootlen root/idx) replen)))
+	     (else (slib:error 'mismatched root repos)))))))
+
+;;@body
+;;Writes @1 to file CVS/Root of @2 and all its subdirectories.
+(define (cvs-set-root! new-root directory/)
+  (define root (cvs-root directory/))
+  (define repos (cvs-repository directory/))
+  (if (not repos) (slib:error 'not 'cvs directory/))
+  (if (not (eqv? 0 (substring? root repos)))
+      (slib:error 'bad 'cvs root repos))
+  (call-with-output-file
+      (in-vicinity (sub-vicinity directory/ "CVS") "Root")
+    (lambda (port) (write-line new-root port)))
+  (call-with-output-file
+      (in-vicinity (sub-vicinity directory/ "CVS") "Repository")
+    (lambda (port)
+      (write-line
+       (substring repos (+ 1 (string-length root)) (string-length repos))
+       port))))
+
+;;@body
+;;Signals an error if CVS/Repository or CVS/Root files in @1 or any
+;;subdirectory do not match.
+(define (cvs-vet directory/)
+  (define diroot (cvs-root directory/))
+  (for-each
+   (lambda (path/)
+     (define path/CVS (sub-vicinity path/ "CVS/"))
+     (cond ((not (cvs-repository path/))
+	    (slib:error 'bad (in-vicinity path/CVS "Repository")))
+	   ((not (equal? diroot (cvs-root path/)))
+	    (slib:error 'mismatched 'root (in-vicinity path/CVS "Root")))))
+   (or (cvs-directories directory/) (slib:error 'not 'cvs directory/))))
+
+;;(define cvs-rsh (or (getenv "CVS_RSH") "rsh"))
diff --git a/cvs.txi b/cvs.txi
new file mode 100644
index 0000000..0ff1656
--- /dev/null
+++ b/cvs.txi
@@ -0,0 +1,32 @@
+
+@defun cvs-files directory/
+Returns a list of the local pathnames (with prefix @var{directory/}) of all
+CVS controlled files in @var{directory/} and in @var{directory/}'s subdirectories.
+@end defun
+
+@defun cvs-directories directory/
+Returns a list of all of @var{directory/} and all @var{directory/}'s CVS controlled
+subdirectories.
+@end defun
+
+@defun cvs-root path/
+Returns the (string) contents of @var{path/}CVS/Root;
+or @code{(getenv "CVSROOT")} if Root doesn't exist.
+@end defun
+
+@defun cvs-repository directory/
+Returns the (string) contents of @var{directory/}CVS/Root appended
+with @var{directory/}CVS/Repository; or #f if @var{directory/}CVS/Repository
+doesn't exist.
+@end defun
+
+@deffn {Procedure} cvs-set-root! new-root directory/
+
+Writes @var{new-root} to file CVS/Root of @var{directory/} and all its subdirectories.
+@end deffn
+
+@defun cvs-vet directory/
+
+Signals an error if CVS/Repository or CVS/Root files in @var{directory/} or any
+subdirectory do not match.
+@end defun
diff --git a/daylight.scm b/daylight.scm
new file mode 100644
index 0000000..6c989b2
--- /dev/null
+++ b/daylight.scm
@@ -0,0 +1,356 @@
+;;; "daylight.scm" Model of sun and sky colors.
+; Copyright 2001 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'color-space)
+
+(define pi (* 4 (atan 1)))
+(define pi/180 (/ pi 180))
+
+;;@code{(require 'daylight)}
+;;@ftindex daylight
+;;@ftindex sunlight
+;;@ftindex sun
+;;@ftindex sky
+;;
+;;@noindent
+;;This package calculates the colors of sky as detailed in:@*
+;;@uref{http://www.cs.utah.edu/vissim/papers/sunsky/sunsky.pdf}@*
+;;@cite{A Practical Analytic Model for Daylight}@*
+;;A. J. Preetham, Peter Shirley, Brian Smits
+
+;;@body
+;;
+;;Returns the solar-time in hours given the integer @1 in the range 1 to
+;;366, and the local time in hours.
+;;
+;;To be meticulous, subtract 4 minutes for each degree of longitude west
+;;of the standard meridian of your time zone.
+(define (solar-hour julian-day hour)
+  (+ hour
+     (* 0.170 (sin (* 4 pi (- julian-day 80) 1/373)))
+     (* -0.129 (sin (* 2 pi (- julian-day 8) 1/355)))))
+
+;;@body
+(define (solar-declination julian-day)
+  (/ (* 0.4093 (sin (* 2 pi (- julian-day 81) 1/368))) pi/180))
+
+;;@body Returns a list of @var{theta_s}, the solar angle from the
+;;zenith, and @var{phi_s}, the solar azimuth.  0 <= @var{theta_s}
+;;measured in degrees.  @var{phi_s} is measured in degrees from due
+;;south; west of south being positive.
+(define (solar-polar declination latitude solar-hour)
+  (define l (* pi/180 latitude))
+  (define d (* pi/180 declination))
+  (define pi*t/12 (* pi solar-hour 1/12))
+  (map (lambda (x) (/ x pi/180))
+       (list (- (/ pi 2) (asin (- (* (sin l) (sin d))
+				  (* (cos l) (cos d) (cos pi*t/12)))))
+	     (atan (* -1 (cos d) (sin pi*t/12))
+		   (- (* (cos l) (sin d))
+		      (* (sin l) (cos d) (cos pi*t/12)))))))
+
+;;@noindent
+;;In the following procedures, the number 0 <= @var{theta_s} <= 90 is
+;;the solar angle from the zenith in degrees.
+
+;;(plot (lambda (t) (+ -.5 (/ 9 (expt 1.55 t)))) 0 6)  ;tweaked
+
+;;@cindex turbidity
+;;@noindent
+;;Turbidity is a measure of the fraction of scattering due to haze as
+;;opposed to molecules.  This is a convenient quantity because it can be
+;;estimated based on visibility of distant objects.  This model fails
+;;for turbidity values less than 1.3.
+;;
+;;@example
+;;@group
+;;    _______________________________________________________________
+;;512|-:                                                             |
+;;   | * pure-air                                                    |
+;;256|-:**                                                           |
+;;   | : ** exceptionally-clear                                      |
+;;128|-:   *                                                         |
+;;   | :    **                                                       |
+;; 64|-:      *                                                      |
+;;   | :       ** very-clear                                         |
+;; 32|-:         **                                                  |
+;;   | :           **                                                |
+;; 16|-:             *** clear                                       |
+;;   | :               ****                                          |
+;;  8|-:                  ****                                       |
+;;   | :                     **** light-haze                         |
+;;  4|-:                         ****                                |
+;;   | :                             ******                          |
+;;  2|-:                                  ******** haze         thin-|
+;;   | :                                          ***********    fog |
+;;  1|-:----------------------------------------------------*******--|
+;;   |_:____.____:____.____:____.____:____.____:____.____:____.____:_|
+;;     1         2         4         8        16        32        64
+;;              Meterorological range (km) versus Turbidity
+;;@end group
+;;@end example
+
+(define sol-spec
+  '#(16559.0
+     16233.7
+     21127.5
+     25888.2
+     25829.1
+     24232.3
+     26760.5
+     29658.3
+     30545.4
+     30057.5
+     30663.7
+     28830.4
+     28712.1
+     27825.0
+     27100.6
+     27233.6
+     26361.3
+     25503.8
+     25060.2
+     25311.6
+     25355.9
+     25134.2
+     24631.5
+     24173.2
+     23685.3
+     23212.1
+     22827.7
+     22339.8
+     21970.2
+     21526.7
+     21097.9
+     20728.3
+     20240.4
+     19870.8
+     19427.2
+     19072.4
+     18628.9
+     18259.2
+     17960				;guesses for the rest
+     17730
+     17570))
+
+(define k_o-spec
+  '#(0.003
+     0.006
+     0.009
+     0.014
+     0.021
+     0.03
+     0.04
+     0.048
+     0.063
+     0.075
+     0.085
+     0.103
+     0.12
+     0.12
+     0.115
+     0.125
+     0.12
+     0.105
+     0.09
+     0.079
+     0.067
+     0.057
+     0.048
+     0.036
+     0.028
+     0.023
+     0.018
+     0.014
+     0.011
+     0.01
+     0.009
+     0.007
+     0.004
+     0))
+
+;;@body Returns a vector of 41 values, the spectrum of sunlight from
+;;380.nm to 790.nm for a given @1 and @2.
+(define (sunlight-spectrum turbidity theta_s)
+  (define (solCurve wl) (vector-ref sol-spec (quotient (- wl 380) 10)))
+  (define (k_oCurve wl) (if (>= wl 450)
+			    (vector-ref k_o-spec (quotient (- wl 450) 10))
+			    0))
+  (define (k_gCurve wl) (case wl
+			  ((760) 3.0)
+			  ((770) 0.21)
+			  (else 0)))
+  (define (k_waCurve wl) (case wl
+			   ((690) 0.016)
+			   ((700) 0.024)
+			   ((710) 0.0125)
+			   ((720) 1)
+			   ((730) 0.87)
+			   ((740) 0.061)
+			   ((750) 0.001)
+			   ((760) 1.e-05)
+			   ((770) 1.e-05)
+			   ((780) 0.0006)
+			   (else 0)))
+
+  (define data (make-vector (+ 1 (quotient (- 780 380) 10)) 0.0))
+  ;;alpha - ratio of small to large particle sizes. (0:4,usually 1.3)
+  (define alpha 1.3)
+  ;;beta - amount of aerosols present
+  (define beta (- (* 0.04608365822050 turbidity) 0.04586025928522))
+  ;;lOzone - amount of ozone in cm(NTP)
+  (define lOzone .35)
+  ;;w - precipitable water vapor in centimeters (standard = 2)
+  (define w 2.0)
+  ;;m - Relative Optical Mass
+  (define m (/ (+ (cos (* pi/180 theta_s))
+		  (* 0.15 (expt (- 93.885 theta_s) -1.253)))))
+  (and
+   (not (negative? (- 93.885 theta_s)))
+   ;; Compute specturm of sunlight
+   (do ((wl 780 (+ -5 wl)))
+       ((< wl 380) data)
+     (let* (;;Rayleigh Scattering
+	    ;; paper and program disagree!!  Looks like font-size typo in paper.
+	    ;;(tauR (exp (* -0.008735 (expt (/ wl 1000) (* -4.08 m))))) ;sunsky.pdf
+	    (tauR (exp (* -0.008735 m (expt (/ wl 1000) -4.08)))) ;RiSunConstants.C
+	    ;;Aerosal (water + dust) attenuation
+	    ;; paper and program disagree!!  Looks like font-size typo in paper.
+	    ;;(tauA (exp (* -1 beta (expt (/ wl 1000) (* -1 m alpha)))))
+	    (tauA (exp (* -1 m beta (expt (/ wl 1000) (- alpha)))))
+	    ;;Attenuation due to ozone absorption
+	    (tauO (exp (* -1 m (k_oCurve wl) lOzone)))
+	    ;;Attenuation due to mixed gases absorption
+	    (tauG (exp (* -1.41 m (k_gCurve wl)
+			  (expt (+ 1 (* 118.93 m (k_gCurve wl))) -0.45))))
+	    ;;Attenuation due to water vapor absorbtion
+	    (tauWA (exp (* -0.2385 m w (k_waCurve wl)
+			   (expt (+ 1 (* 20.07 m w (k_waCurve wl))) -0.45)))))
+       (vector-set! data (quotient (- wl 380) 10)
+		    (* (solCurve wl) tauR tauA tauO tauG tauWA))))))
+
+;;@body Returns (unnormalized) XYZ values for color of sunlight for a
+;;given @1 and @2.
+(define (sunlight-XYZ turbidity theta_s)
+  (define spectrum (sunlight-spectrum turbidity theta_s))
+  (and spectrum (spectrum->XYZ spectrum 380.e-9 780.e-9)))
+
+;;@body Given @1 and @2, @0 returns the CIEXYZ triple for color of
+;;sunlight scaled to be just inside the RGB709 gamut.
+(define (sunlight-CIEXYZ turbidity theta_s)
+  (define spectrum (sunlight-spectrum turbidity theta_s))
+  (and spectrum (spectrum->CIEXYZ spectrum 380.e-9 780.e-9)))
+
+;; Arguments and result in radians
+(define (angle-between theta phi theta_s phi_s)
+  (define cospsi (+ (* (sin theta) (sin theta_s) (cos (- phi phi_s)))
+		    (* (cos theta) (cos theta_s))))
+  (cond ((> cospsi 1) 0)
+	((< cospsi -1) pi)
+	(else (acos cospsi))))
+
+;;@body Returns the xyY (chromaticity and luminance) at the zenith.  The
+;;Luminance has units kcd/m^2.
+(define (zenith-xyY turbidity theta_s)
+  (let* ((ths (* theta_s pi/180))
+	 (thetas (do ((th 1 (* ths th))
+		      (lst '() (cons th lst))
+		      (cnt 3 (+ -1 cnt)))
+		     ((negative? cnt) lst)))
+	 (turbds (do ((tr 1 (* turbidity tr))
+		      (lst '() (cons tr lst))
+		      (cnt 2 (+ -1 cnt)))
+		     ((negative? cnt) lst))))
+    (append (map (lambda (row) (apply + (map * row turbds)))
+		 (map color:linear-transform
+		      '(((+0.00165 -0.00374 +0.00208 +0      )
+			 (-0.02902 +0.06377 -0.03202 +0.00394)
+			 (+0.11693 -0.21196 +0.06052 +0.25885))
+			((+0.00275 -0.00610 +0.00316 +0      )
+			 (-0.04214 +0.08970 -0.04153 +0.00515)
+			 (+0.15346 -0.26756 +0.06669 +0.26688)))
+		      (list thetas thetas)))
+	    (list (+ (* (tan (* (+ 4/9 (/ turbidity -120)) (+ pi (* -2 ths))))
+			(- (* 4.0453 turbidity) 4.9710))
+		     (* -0.2155 turbidity)
+		     2.4192)))))
+
+;;@body @1 is a positive real number expressing the amount of light
+;;scattering.  The real number @2 is the solar angle from the zenith in
+;;degrees.
+;;
+;;@0 returns a function of one angle @var{theta}, the angle from the
+;;zenith of the viewing direction (in degrees); and returning the xyY
+;;value for light coming from that elevation of the sky.
+(define (overcast-sky-color-xyY turbidity theta_s)
+  (define xyY_z (zenith-xyY turbidity theta_s))
+  (lambda (theta . phi)
+    (list (car xyY_z) (cadr xyY_z)
+	  (* 1/3 (caddr xyY_z) (+ 1 (* 2 (cos (* pi/180 theta))))))))
+
+;;@body @1 is a positive real number expressing the amount of light
+;;scattering.  The real number @2 is the solar angle from the zenith in
+;;degrees.  The real number @3 is the solar angle from south.
+;;
+;;@0 returns a function of two angles, @var{theta} and @var{phi} which
+;;specify the angles from the zenith and south meridian of the viewing
+;;direction (in degrees); returning the xyY value for light coming from
+;;that direction of the sky.
+;;
+;;@code{sky-color-xyY} calls @code{overcast-sky-color-xyY} for
+;;@1 <= 20; otherwise the @0 function.
+(define (clear-sky-color-xyY turbidity theta_s phi_s)
+  (define xyY_z (zenith-xyY turbidity theta_s))
+  (define th_s (* pi/180 theta_s))
+  (define ph_s (* pi/180 phi_s))
+  (define (F~ A B C D E)
+    (lambda (th gm)
+      (* (+ 1 (* A (exp (/ B (cos th)))))
+	 (+ 1 (* C (exp (* D gm))) (* E (expt (cos gm) 2))))))
+  (let* ((tb1 (list turbidity 1))
+	 (Fs (map (lambda (mat) (apply F~ (color:linear-transform mat tb1)))
+		  '((( 0.17872 -1.46303)
+		     (-0.35540 +0.42749)
+		     (-0.02266 +5.32505)
+		     ( 0.12064 -2.57705)
+		     (-0.06696 +0.37027))
+		    ((-0.01925 -0.25922)
+		     (-0.06651 +0.00081)
+		     (-0.00041 +0.21247)
+		     (-0.06409 -0.89887)
+		     (-0.00325 +0.04517))
+		    ((-0.01669 -0.26078)
+		     (-0.09495 +0.00921)
+		     (-0.00792 +0.21023)
+		     (-0.04405 -1.65369)
+		     (-0.01092 +0.05291)))))
+	 (F_0s (map (lambda (F) (F 0 th_s)) Fs)))
+    (lambda (theta phi)
+      (let* ((th (* pi/180 theta))
+	     (ph (* pi/180 phi))
+	     (gm (angle-between th_s ph_s th ph)))
+	;;(print th ph '=> gm)
+	(map (lambda (x F F_0) (* x (/ (F th gm) F_0)))
+	     xyY_z
+	     Fs
+	     F_0s)))))
+(define (sky-color-xyY turbidity theta_s phi_s)
+  (if (> turbidity 20)
+      (overcast-sky-color-xyY turbidity theta_s)
+      (clear-sky-color-xyY turbidity theta_s phi_s)))
diff --git a/daylight.txi b/daylight.txi
new file mode 100644
index 0000000..fa24afc
--- /dev/null
+++ b/daylight.txi
@@ -0,0 +1,117 @@
+@code{(require 'daylight)}
+@ftindex daylight
+@ftindex sunlight
+@ftindex sun
+@ftindex sky
+
+@noindent
+This package calculates the colors of sky as detailed in:@*
+@uref{http://www.cs.utah.edu/vissim/papers/sunsky/sunsky.pdf}@*
+@cite{A Practical Analytic Model for Daylight}@*
+A. J. Preetham, Peter Shirley, Brian Smits
+
+
+@defun solar-hour julian-day hour
+
+
+Returns the solar-time in hours given the integer @var{julian-day} in the range 1 to
+366, and the local time in hours.
+
+To be meticulous, subtract 4 minutes for each degree of longitude west
+of the standard meridian of your time zone.
+@end defun
+
+@defun solar-declination julian-day
+
+@end defun
+
+@defun solar-polar declination latitude solar-hour
+Returns a list of @var{theta_s}, the solar angle from the
+zenith, and @var{phi_s}, the solar azimuth.  0 <= @var{theta_s}
+measured in degrees.  @var{phi_s} is measured in degrees from due
+south; west of south being positive.
+@end defun
+@noindent
+In the following procedures, the number 0 <= @var{theta_s} <= 90 is
+the solar angle from the zenith in degrees.
+
+@cindex turbidity
+@noindent
+Turbidity is a measure of the fraction of scattering due to haze as
+opposed to molecules.  This is a convenient quantity because it can be
+estimated based on visibility of distant objects.  This model fails
+for turbidity values less than 1.3.
+
+@example
+@group
+    _______________________________________________________________
+512|-:                                                             |
+   | * pure-air                                                    |
+256|-:**                                                           |
+   | : ** exceptionally-clear                                      |
+128|-:   *                                                         |
+   | :    **                                                       |
+ 64|-:      *                                                      |
+   | :       ** very-clear                                         |
+ 32|-:         **                                                  |
+   | :           **                                                |
+ 16|-:             *** clear                                       |
+   | :               ****                                          |
+  8|-:                  ****                                       |
+   | :                     **** light-haze                         |
+  4|-:                         ****                                |
+   | :                             ******                          |
+  2|-:                                  ******** haze         thin-|
+   | :                                          ***********    fog |
+  1|-:----------------------------------------------------*******--|
+   |_:____.____:____.____:____.____:____.____:____.____:____.____:_|
+     1         2         4         8        16        32        64
+              Meterorological range (km) versus Turbidity
+@end group
+@end example
+
+
+@defun sunlight-spectrum turbidity theta_s
+Returns a vector of 41 values, the spectrum of sunlight from
+380.nm to 790.nm for a given @var{turbidity} and @var{theta_s}.
+@end defun
+
+@defun sunlight-xyz turbidity theta_s
+Returns (unnormalized) XYZ values for color of sunlight for a
+given @var{turbidity} and @var{theta_s}.
+@end defun
+
+@defun sunlight-ciexyz turbidity theta_s
+Given @var{turbidity} and @var{theta_s}, @code{sunlight-ciexyz} returns the CIEXYZ triple for color of
+sunlight scaled to be just inside the RGB709 gamut.
+@end defun
+
+@defun zenith-xyy turbidity theta_s
+Returns the xyY (chromaticity and luminance) at the zenith.  The
+Luminance has units kcd/m^2.
+@end defun
+
+@defun overcast-sky-color-xyy turbidity theta_s
+@var{turbidity} is a positive real number expressing the amount of light
+scattering.  The real number @var{theta_s} is the solar angle from the zenith in
+degrees.
+
+@code{overcast-sky-color-xyy} returns a function of one angle @var{theta}, the angle from the
+zenith of the viewing direction (in degrees); and returning the xyY
+value for light coming from that elevation of the sky.
+@end defun
+
+@defun clear-sky-color-xyy turbidity theta_s phi_s
+@defunx sky-color-xyy turbidity theta_s phi_s
+@var{turbidity} is a positive real number expressing the amount of light
+scattering.  The real number @var{theta_s} is the solar angle from the zenith in
+degrees.  The real number @var{phi_s} is the solar angle from south.
+
+@code{clear-sky-color-xyy} returns a function of two angles, @var{theta} and @var{phi} which
+specify the angles from the zenith and south meridian of the viewing
+direction (in degrees); returning the xyY value for light coming from
+that direction of the sky.
+
+@code{sky-color-xyY} calls @code{overcast-sky-color-xyY} for
+@var{turbidity} <= 20; otherwise the @code{clear-sky-color-xyy} function.
+@end defun
diff --git a/db2html.scm b/db2html.scm
index 3462966..df34389 100644
--- a/db2html.scm
+++ b/db2html.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -18,11 +18,20 @@
 ;each case.
 
 (require 'uri)
+(require 'printf)
 (require 'html-form)
-(require 'net-clients)
+(require 'directory)
+(require 'databases)
+(require 'string-case)
 (require 'string-search)
+(require 'common-list-functions)
+(require-if 'compiling 'pretty-print)
+(require-if 'compiling 'database-commands)
+(require 'hash)
+(define (crc:hash-obj obj) (number->string (hash obj most-positive-fixnum) 16))
 
 ;;@code{(require 'db->html)}
+;;@ftindex db->html
 
 ;;@body
 (define (html:table options . rows)
@@ -224,11 +233,11 @@
 ;;@args table-name null-keys update
 ;;@args table-name null-keys
 ;;
-;;Returns procedure (of @var{db}) which returns procedure to modify row
-;;of @1.  @2 is the list of @dfn{null} keys which indicate that the row
-;;is to be deleted.  Optional arguments @3, @4, and @5 default to the
-;;@code{row:update}, @code{row:delete}, and @code{row:retrieve} of @1 in
-;;@var{db}.
+;;Returns procedure (of @var{db}) which returns procedure to modify
+;;row of @1.  @2 is the list of @dfn{null} keys indicating the row is
+;;to be deleted when any matches its corresponding primary key.
+;;Optional arguments @3, @4, and @5 default to the @code{row:update},
+;;@code{row:delete}, and @code{row:retrieve} of @1 in @var{db}.
 (define (command:modify-table table-name null-keys . args)
   (define argc (length args))
   (lambda (rdb)
@@ -251,7 +260,7 @@
 			(table:update new-row)
 			((rdb 'sync-database)) #t)
 		       (else '("Row changed by other user"))))
-		((equal? null-keys new-pkeys) ;blanked keys
+		((command:null-key? null-keys new-pkeys) ;blanked keys
 		 (cond ((not row) #t)
 		       ((equal? (crc:hash-obj row) *row-hash*)
 			;;(slib:warn (sprintf #f "Removing key: %#a => %#a" new-pkeys ))
@@ -268,6 +277,26 @@
 				 (apply table:delete pkeys))
 			     ((rdb 'sync-database)) #t)))))))))
 
+(define (command:null-key? null-keys new-pkeys)
+  (define sts #f)
+  (for-each (lambda (nuk nep) (if (equal? nuk nep) (set! sts #t)))
+	    null-keys
+	    new-pkeys)
+  sts)
+
+(define (make-defaulter arity type)
+  `(lambda (pl)
+     ',(case arity
+	 ((optional nary) '())
+	 ((boolean) #f)
+	 ((single nary1)
+	  (case type
+	    ((string) '(""))
+	    ((symbol) '(nil))
+	    ((number) '(0))
+	    (else '(#f))))
+	 (else (slib:error 'make-defaulter 'unknown 'arity arity)))))
+
 ;;@body Given @2 in @1, creates parameter and @code{*command*} tables
 ;;for editing one row of @2 at a time.  @0 returns a procedure taking a
 ;;row argument which returns the HTML string for editing that row.
@@ -286,6 +315,7 @@
 ;;@end table
 (define (command:make-editable-table rdb table-name . args)
   (define table ((rdb 'open-table) table-name #t))
+  (require 'database-commands)
   (let ((pkl (table 'primary-limit))
 	(columns (table 'column-names))
 	(domains (table 'column-domains))
@@ -313,7 +343,8 @@
     (define foreign-choice-lists
       (map (lambda (domain-name)
 	     (define tab-name (ftn domain-name))
-	     (if tab-name (get-foreign-choices (rdb-open tab-name #f)) '()))
+	     (if tab-name (get-foreign-choices
+			   ((rdb 'open-table) tab-name #f)) '()))
 	   domains))
     (define-tables rdb
       `(,(symbol-append table-name '- 'params)
@@ -323,7 +354,7 @@
 	 ,@field-specs))
       `(,(symbol-append table-name '- 'pname)
 	((name string))
-	((parameter-index uint))	;should be address-params
+	((parameter-index ordinal))	;should be address-params
 	(("*keys*" 1)
 	 ("*row-hash*" 2)
 	 ,@(map (lambda (idx column) (list (symbol->string column) idx))
@@ -335,7 +366,10 @@
 	  ,(symbol-append table-name '- 'pname)
 	  (command:modify-table ',table-name
 				',(map (lambda (fs)
-					 (caadr (caddar (cddddr fs))))
+					 (define dfl
+					   ((slib:eval (car (cddddr fs)))
+					    '()))
+					 (if (pair? dfl) (car dfl) dfl))
 				       (butnthcdr pkl field-specs))
 				,@args)
 	  ,(string-append "Modify " (symbol->string table-name))))))
@@ -424,16 +458,17 @@
 ;;top level page with the catalog of tables (captioned @4) is written
 ;;to a file named @3.
 (define (db->html-files db dir index-filename caption)
-  (call-with-output-file (in-vicinity (if dir (sub-vicinity "" dir) "")
-				      index-filename)
+  (set! dir (if dir (sub-vicinity "" dir) ""))
+  (call-with-output-file (in-vicinity dir index-filename)
     (lambda (port)
       (display (catalog->page db caption) port)))
-  ((((db 'open-table) '*catalog-data* #f) 'for-each-row)
-   (lambda (row)
-     (call-with-output-file
-	 (in-vicinity (sub-vicinity "" dir) (table-name->filename (car row)))
-       (lambda (port)
-	 (display (table->linked-page db (car row) index-filename) port))))))
+  (let ((catdat ((db 'open-table) '*catalog-data* #f)))
+    ((or (catdat 'for-each-row-in-order) (catdat 'for-each-row))
+     (lambda (row)
+       (call-with-output-file
+	   (in-vicinity dir (table-name->filename (car row)))
+	 (lambda (port)
+	   (display (table->linked-page db (car row) index-filename) port)))))))
 
 ;;@args db dir index-filename
 ;;@args db dir
@@ -457,7 +492,7 @@
 ;;@args db dir index-filename
 ;;@args db dir
 ;;@0 is just like @code{db->html-directory}, but calls
-;;@code{browse-url-netscape} with the uri for the top page after the
+;;@code{browse-url} with the uri for the top page after the
 ;;pages are created.
 (define (db->netscape . args)
-  (browse-url-netscape (apply db->html-directory args)))
+  (browse-url (apply db->html-directory args)))
diff --git a/db2html.txi b/db2html.txi
index 0acdd46..3b47f31 100644
--- a/db2html.txi
+++ b/db2html.txi
@@ -1,4 +1,5 @@
 @code{(require 'db->html)}
+@ftindex db->html
 
 
 @defun html:table options row @dots{}
@@ -104,12 +105,12 @@ database is performed.
 
 @defunx command:modify-table table-name null-keys
 
-Returns procedure (of @var{db}) which returns procedure to modify row
-of @var{table-name}.  @var{null-keys} is the list of @dfn{null} keys which indicate that the row
+Returns procedure (of @var{db}) which returns procedure to modify
+row of @var{table-name}.  @var{null-keys} is the list of @dfn{null} keys indicating the row is
 @cindex null
-is to be deleted.  Optional arguments @var{update}, @var{delete}, and @var{retrieve} default to the
-@code{row:update}, @code{row:delete}, and @code{row:retrieve} of @var{table-name} in
-@var{db}.
+to be deleted when any matches its corresponding primary key.
+Optional arguments @var{update}, @var{delete}, and @var{retrieve} default to the @code{row:update},
+@code{row:delete}, and @code{row:retrieve} of @var{table-name} in @var{db}.
 @end defun
 
 @defun command:make-editable-table rdb table-name arg @dots{}
@@ -180,6 +181,6 @@ returned.
 
 @defunx db->netscape db dir
 @code{db->netscape} is just like @code{db->html-directory}, but calls
-@code{browse-url-netscape} with the uri for the top page after the
+@code{browse-url} with the uri for the top page after the
 pages are created.
 @end defun
diff --git a/dbcom.scm b/dbcom.scm
new file mode 100644
index 0000000..428e3db
--- /dev/null
+++ b/dbcom.scm
@@ -0,0 +1,215 @@
+;;; "dbcom.scm" embed commands in relational-database
+; Copyright 1994, 1995, 1997, 2000, 2001 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'common-list-functions)	;for position
+(require 'relational-database)
+(require 'databases)
+;@
+(define (wrap-command-interface rdb)
+  (let* ((rdms:commands ((rdb 'open-table) '*commands* #f))
+	 (command:get (and rdms:commands (rdms:commands 'get 'procedure))))
+    (and command:get
+	 (letrec ((wdb (lambda (command)
+			 (let ((com (command:get command)))
+			   (if com ((slib:eval com) wdb) (rdb command))))))
+	   (let ((init (wdb '*initialize*)))
+	     (if (procedure? init) init wdb))))))
+;@
+(define (open-command-database! path . arg)
+  (define bt (apply open-database! path arg))
+  (and bt (wrap-command-interface bt)))
+;@
+(define (open-command-database path . arg)
+  (define bt (apply open-database path arg))
+  (and bt (wrap-command-interface bt)))
+;@
+(define (add-command-tables rdb)
+  (define-tables
+    rdb
+    '(type
+      ((name symbol))
+      ()
+      ((atom)
+       (symbol)
+       (string)
+       (number)
+       (money)
+       (date-time)
+       (boolean)
+       (foreign-key)
+       (expression)
+       (virtual)))
+    '(parameter-arity
+      ((name symbol))
+      ((predicate? expression)
+       (procedure expression))
+      ((single (lambda (a) (and (pair? a) (null? (cdr a)))) car)
+       (optional
+	(lambda (lambda (a) (or (null? a) (and (pair? a) (null? (cdr a))))))
+	identity)
+       (boolean
+	(lambda (a) (or (null? a)
+			(and (pair? a) (null? (cdr a)) (boolean? (car a)))))
+	(lambda (a) (if (null? a) #f (car a))))
+       (nary (lambda (a) #t) identity)
+       (nary1 (lambda (a) (not (null? a))) identity))))
+  (for-each (((rdb 'open-table) '*domains-data* #t) 'row:insert)
+	    '((parameter-list *catalog-data* #f symbol 1)
+	      (parameter-name-translation *catalog-data* #f symbol 1)
+	      (parameter-arity parameter-arity #f symbol 1)
+	      (table *catalog-data* #f atom 1)))
+  (define-tables
+    rdb
+    '(*parameter-columns*
+      *columns*
+      *columns*
+      ((1 #t index #f ordinal)
+       (2 #f name #f symbol)
+       (3 #f arity #f parameter-arity)
+       (4 #f domain #f domain)
+       (5 #f defaulter #f expression)
+       (6 #f expander #f expression)
+       (7 #f documentation #f string)))
+    '(no-parameters
+      *parameter-columns*
+      *parameter-columns*
+      ())
+    '(no-parameter-names
+      ((name string))
+      ((parameter-index ordinal))
+      ())
+    '(add-domain-params
+      *parameter-columns*
+      *parameter-columns*
+      ((1 domain-name single atom #f #f "new domain name")
+       (2 foreign-table optional table #f #f
+	  "if present, domain-name must be existing key into this table")
+       (3 domain-integrity-rule optional expression #f #f
+	  "returns #t if single argument is good")
+       (4 type-id single type #f #f "base type of new domain")
+       (5 type-param optional expression #f #f
+	  "which (key) field of the foreign-table")
+       ))
+    '(add-domain-pnames
+      ((name string))
+      ((parameter-index ordinal))	;should be add-domain-params
+      (
+       ("n" 1) ("name" 1)
+       ("f" 2) ("foreign (key) table" 2)
+       ("r" 3) ("domain integrity rule" 3)
+       ("t" 4) ("type" 4)
+       ("p" 5) ("type param" 5)
+       ))
+    '(del-domain-params
+      *parameter-columns*
+      *parameter-columns*
+      ((1 domain-name single domain #f #f "domain name")))
+    '(del-domain-pnames
+      ((name string))
+      ((parameter-index ordinal))	;should be del-domain-params
+      (("n" 1) ("name" 1)))
+    '(*commands*
+      ((name symbol))
+      ((parameters parameter-list)
+       (parameter-names parameter-name-translation)
+       (procedure expression)
+       (documentation string))
+      ((domain-checker
+	no-parameters
+	no-parameter-names
+	dbcom:check-domain
+	"return procedure to check given domain name")
+
+       (add-domain
+	add-domain-params
+	add-domain-pnames
+	(lambda (rdb)
+	  (((rdb 'open-table) '*domains-data* #t) 'row:update))
+	"add a new domain")
+
+       (delete-domain
+	del-domain-params
+	del-domain-pnames
+	(lambda (rdb)
+	  (((rdb 'open-table) '*domains-data* #t) 'row:remove))
+	"delete a domain"))))
+  (let* ((tab ((rdb 'open-table) '*domains-data* #t))
+	 (row ((tab 'row:retrieve) 'type)))
+    ((tab 'row:update) (cons 'type (cdr row))))
+  (wrap-command-interface rdb))
+;@
+(define (define-*commands* rdb . cmd-defs)
+  (define defcmd (((rdb 'open-table) '*commands* #t) 'row:update))
+  (for-each (lambda (def)
+	      (define procname (caar def))
+	      (define args (cdar def))
+	      (define body (cdr def))
+	      (let ((comment (and (string? (car body)) (car body))))
+		(define nbody (if comment (cdr body) body))
+		(defcmd (list procname
+			      'no-parameters
+			      'no-parameter-names
+			      `(lambda ,args ,@nbody)
+			      (or comment "")))))
+	    cmd-defs))
+
+;; Actually put into command table by add-command-tables
+(define (dbcom:check-domain rdb)
+  (let* ((ro:domains ((rdb 'open-table) '*domains-data* #f))
+	 (ro:get-dir (ro:domains 'get 'domain-integrity-rule))
+	 (ro:for-tab (ro:domains 'get 'foreign-table)))
+    (lambda (domain)
+      (let ((fkname (ro:for-tab domain))
+	    (dir (slib:eval (ro:get-dir domain))))
+	(if fkname (let* ((fktab ((rdb 'open-table) fkname #f))
+			  (p? (fktab 'get 1)))
+		     (if dir (lambda (e) (and (dir e) (p? e))) p?))
+	    dir)))))
+;@
+(define (make-command-server rdb command-table)
+  (let* ((comtab ((rdb 'open-table) command-table #f))
+	 (names (comtab 'column-names))
+	 (row-ref (lambda (row name) (list-ref row (position name names))))
+	 (comgetrow (comtab 'row:retrieve)))
+    (lambda (comname command-callback)
+      (cond ((not comname) (set! comname '*default*)))
+      (cond ((not (comgetrow comname))
+	     (slib:error 'command 'not 'known: comname)))
+      (let* ((command:row (comgetrow comname))
+	     (parameter-table
+	      ((rdb 'open-table) (row-ref command:row 'parameters) #f))
+	     (parameter-names
+	      ((rdb 'open-table) (row-ref command:row 'parameter-names) #f))
+	     (comval ((slib:eval (row-ref command:row 'procedure)) rdb))
+	     (options ((parameter-table 'get* 'name)))
+	     (positions ((parameter-table 'get* 'index)))
+	     (arities ((parameter-table 'get* 'arity)))
+	     (defaulters (map slib:eval ((parameter-table 'get* 'defaulter))))
+	     (domains ((parameter-table 'get* 'domain)))
+	     (types (map (((rdb 'open-table) '*domains-data* #f) 'get 'type-id)
+			 domains))
+	     (dirs (map (or (rdb 'domain-checker) (lambda (domain)
+						    (lambda (domain) #t)))
+			domains))
+	     (aliases
+	      (map list ((parameter-names 'get* 'name))
+		   (map (parameter-table 'get 'name)
+			((parameter-names 'get* 'parameter-index))))))
+	(command-callback comname comval options positions
+			  arities types defaulters dirs aliases)))))
diff --git a/dbinterp.scm b/dbinterp.scm
new file mode 100644
index 0000000..8ccb1df
--- /dev/null
+++ b/dbinterp.scm
@@ -0,0 +1,34 @@
+;;; "dbinterp.scm" Interpolate function from database table.
+;Copyright 2003 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;@ This procedure works only for tables with a single primary key.
+(define (interpolate-from-table table column)
+  (define get (table 'get column))
+  (define prev (table 'isam-prev))
+  (define next (table 'isam-next))
+  (lambda (x)
+    (let ((nxt (next x)))
+      (if nxt (set! nxt (car nxt)))
+      (let ((prv (prev (or nxt x))))
+	(if prv (set! prv (car prv)))
+	(cond ((not nxt) (get prv))
+	      ((not prv) (get nxt))
+	      (else (/ (+ (* (- x prv) (get nxt))
+			  (* (- nxt x) (get prv)))
+		       (- nxt prv))))))))
diff --git a/dbrowse.scm b/dbrowse.scm
index e186492..9401c6d 100644
--- a/dbrowse.scm
+++ b/dbrowse.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -17,11 +17,11 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
-(require 'database-utilities)
+(require 'databases)
 (require 'printf)
 
 (define browse:db #f)
-
+;@
 (define (browse . args)
   (define table-name #f)
   (cond ((null? args))
@@ -48,8 +48,8 @@
 
 (define (browse:display-dir table-name table)
   (printf "%s Tables:\\n" table-name)
-  ((table 'for-each-row)
-   (lambda (row) (printf "\\t%s\\n" (car row)))))
+  ((or (table 'for-each-row-in-order) (table 'for-each-row))
+   (lambda (row) (printf "\\t%a\\n" (car row)))))
 
 (define (browse:display-table table-name table)
   (let* ((width 18)
@@ -73,7 +73,7 @@
     (newline)
     (for-each (lambda (type)
 		(case type
-		  ((integer number uint base-id)
+		  ((integer number ordinal base-id uint)
 		   (set! form (string-append form dw-integer)))
 		  ((boolean domain expression atom)
 		   (set! form (string-append form dwp-any)))
@@ -87,6 +87,6 @@
     (for-each (lambda (domain) (printf underline))
 	      (table 'column-domains))
     (newline)
-    ((table 'for-each-row)
+    ((or (table 'for-each-row-in-order) (table 'for-each-row))
      (lambda (row)
        (apply printf form row)))))
diff --git a/dbsyn.scm b/dbsyn.scm
new file mode 100644
index 0000000..1bc1319
--- /dev/null
+++ b/dbsyn.scm
@@ -0,0 +1,54 @@
+;;;; "dbsyn.scm" -- Syntactic extensions for RDMS (within-database)
+;;; Copyright (C) 2002 Ivan Shmakov <ivan@theory.dcn-asu.ru>
+;;
+;; Permission to copy this software, to modify it, to redistribute it,
+;; to distribute modified versions, and to use it for any purpose is
+;; granted, subject to the following restrictions and understandings.
+;;
+;; 1.  Any copy made of this software must include this copyright notice
+;; in full.
+;;
+;; 2.  I have made no warranty or representation that the operation of
+;; this software will be error-free, and I am under no obligation to
+;; provide any services, by way of maintenance, update, or otherwise.
+;;
+;; 3.  In conjunction with products arising from the use of this
+;; material, there shall be no use of my name in any advertising,
+;; promotional, or sales literature without prior written consent in
+;; each case.
+
+;;; History:
+
+;; 2002-08-01: I've tired of tracking database description elements
+;; (such as `(define-tables ...)'); so I decided to use `etags'.  But
+;; its hard (if possible) to create regexp to match against RDMS' table
+;; specs.  So I wrote `within-database' syntax extension and now I can
+;; simply use something like:
+
+;; $ etags -l scheme \
+;;         -r '/ *(define-\(command\|table\) (\([^; \t]+\)/\2/' \
+;;         source1.scm ...
+
+;; ... and get TAGS table with all of my database commands and tables.
+
+(require 'relational-database)
+(require 'database-commands)
+(require 'databases)
+;@
+(define-syntax within-database
+  (syntax-rules (define-table define-command)
+
+    ((within-database database)
+     database)
+
+    ((within-database database
+                      (define-table (name primary columns) row ...)
+                      rest ...)
+     (begin (define-tables database '(name primary columns (row ...)))
+            (within-database database rest ...)))
+
+    ((within-database database
+                      (define-command template arg-1 arg-2 ...)
+                      rest ...)
+     (begin (define-*commands* database '(template arg-1 arg-2 ...))
+            (within-database database rest ...)))))
diff --git a/dbutil.scm b/dbutil.scm
index 248ec1d..5e5c86d 100644
--- a/dbutil.scm
+++ b/dbutil.scm
@@ -1,5 +1,5 @@
 ;;; "dbutil.scm" relational-database-utilities
-; Copyright 1994, 1995, 1997, 2000, 2001 Aubrey Jaffer
+; Copyright 1994, 1995, 1997, 2000, 2001, 2002 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -17,226 +17,418 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
+(require 'common-list-functions)	;for nthcdr and butnthcdr
 (require 'relational-database)
-(require 'common-list-functions)
-
-(define (db:base-type path)
-  'alist-table)				; currently the only one.
-
-(define (dbutil:wrap-command-interface rdb)
-  (and rdb
-       (let* ((rdms:commands ((rdb 'open-table) '*commands* #f))
-	      (command:get
-	       (and rdms:commands (rdms:commands 'get 'procedure))))
-	 (and command:get
-	      (letrec ((wdb (lambda (command)
-			      (let ((com (command:get command)))
-				(cond (com ((slib:eval com) wdb))
-				      (else (rdb command)))))))
-		(let ((init (wdb '*initialize*)))
-		  (if (procedure? init) init wdb)))))))
-
-(define (dbutil:open-database! path . arg)
-  (let ((type (if (null? arg) (db:base-type path) (car arg))))
-    (require type)
-    (dbutil:wrap-command-interface
-     (((make-relational-system (slib:eval type)) 'open-database)
-      path #t))))
-
-(define (dbutil:open-database path . arg)
-  (let ((type (if (null? arg) (db:base-type path) (car arg))))
-    (require type)
-    (dbutil:wrap-command-interface
-     (((make-relational-system (slib:eval type)) 'open-database)
-      path #f))))
-
-(define (dbutil:check-domain rdb)
-  (let* ((ro:domains ((rdb 'open-table) '*domains-data* #f))
-	 (ro:get-dir (ro:domains 'get 'domain-integrity-rule))
-	 (ro:for-tab (ro:domains 'get 'foreign-table)))
-    (lambda (domain)
-      (let ((fkname (ro:for-tab domain))
-	    (dir (slib:eval (ro:get-dir domain))))
-	(if fkname (let* ((fktab ((rdb 'open-table) fkname #f))
-			  (p? (fktab 'get 1)))
-		     (if dir (lambda (e) (and (dir e) (p? e))) p?))
-	    dir)))))
-
-(define (dbutil:create-database path type)
+(require 'dynamic-wind)
+(require 'transact)
+(require-if 'compiling 'printf)		;used only by mdbm:report
+(require-if 'compiling 'alist-table)
+
+;;@code{(require 'databases)}
+;;@ftindex databases
+;;
+;;@noindent
+;;This enhancement wraps a utility layer on @code{relational-database}
+;;which provides:
+;;
+;;@itemize @bullet
+;;@item
+;;Identification of open databases by filename.
+;;@item
+;;Automatic sharing of open (immutable) databases.
+;;@item
+;;Automatic loading of base-table package when creating a database.
+;;@item
+;;Detection and automatic loading of the appropriate base-table package
+;;when opening a database.
+;;@item
+;;Table and data definition from Scheme lists.
+;;@end itemize
+
+;;;Each entry in mdbm:*databases* is a list of:
+
+;;;  *  database (procedure)
+;;;  *  number of opens (integer)
+;;;  *  type (symbol)
+;;;  *  lock-certificate
+
+;;;Because of WRITE-DATABASE, database filenames can change, so we must
+;;;have a global lock.
+(define mdbm:*databases* (make-exchanger '()))
+(define (mdbm:return-dbs dbs)
+  (if (mdbm:*databases* dbs)
+      (slib:error 'mdbm:*databases* 'double 'set!)))
+
+(define (mdbm:find-db? rdb dbs)
+  (and dbs
+       (do ((dbs dbs (cdr dbs)))
+	   ((or (null? dbs)
+		(equal? ((caar dbs) 'filename)
+			(if (procedure? rdb) (rdb 'filename) rdb)))
+	    (and (not (null? dbs))
+		 (if (and (procedure? rdb)
+			  (not (eq? ((caar dbs) 'filename) (rdb 'filename))))
+		     (slib:error ((caar dbs) 'filename) 'open 'twice)
+		     (car dbs)))))))
+
+(define (mdbm:remove-entry dbs entry)
+  (cond ((null? dbs) (slib:error 'mdbm:remove-entry 'not 'found entry))
+	((eq? entry (car dbs)) (cdr dbs))
+	(else (cons (car dbs) (mdbm:remove-entry (cdr dbs) entry)))))
+
+;;@subsubheading Database Sharing
+
+;;@noindent
+;;@dfn{Auto-sharing} refers to a call to the procedure
+;;@code{open-database} returning an already open database (procedure),
+;;rather than opening the database file a second time.
+;;
+;;@quotation
+;;@emph{Note:} Databases returned by @code{open-database} do not include
+;;wrappers applied by packages like @ref{Embedded Commands}.  But
+;;wrapped databases do work as arguments to these functions.
+;;@end quotation
+;;
+;;@noindent
+;;When a database is created, it is mutable by the creator and not
+;;auto-sharable.  A database opened mutably is also not auto-sharable.
+;;But any number of readers can (open) share a non-mutable database file.
+
+;;@noindent
+;;This next set of procedures mirror the whole-database methods in
+;;@ref{Database Operations}.  Except for @code{create-database}, each
+;;procedure will accept either a filename or database procedure for its
+;;first argument.
+
+(define (mdbm:try-opens filename mutable?)
+  (define (try base)
+    (let ((rdb (base 'open-database)))
+      (and rdb (rdb filename mutable?))))
+  (define certificate (and mutable? (file-lock! filename)))
+  (define (loop bti)
+    (define rdb (try (cadar bti)))
+    (cond ((procedure? rdb) (list rdb 1 (caar bti) certificate))
+	  ((null? (cdr bti)) #f)
+	  (else (loop (cdr bti)))))
+  (if (null? *base-table-implementations*) (require 'alist-table))
+  (cond ((and (not (and mutable? (not certificate)))
+	      (loop *base-table-implementations*)))
+	((memq 'alist-table *base-table-implementations*) #f)
+	((let ()
+	   (require 'alist-table)
+	   (loop (list (car *base-table-implementations*)))))
+	(else #f)))
+
+(define (mdbm:open-type filename type mutable?)
+  (require type)
+  (let ((certificate (and mutable? (file-lock! filename))))
+    (and (not (and mutable? (not certificate)))
+	 (let* ((sys (cadr (assq type *base-table-implementations*)))
+		(open (and sys (sys 'open-database)))
+		(ndb (and open (open filename mutable?))))
+	   (and ndb (list ndb 1 type certificate))))))
+
+;;@args filename base-table-type
+;;@1 should be a string naming a file; or @code{#f}.  @2 must be a
+;;symbol naming a feature which can be passed to @code{require}.  @0
+;;returns a new, open relational database (with base-table type @2)
+;;associated with @1, or a new ephemeral database if @1 is @code{#f}.
+;;
+;;@code{create-database} is the only run-time use of require in SLIB
+;;which crosses module boundaries.  When @2 is @code{require}d by @0; it
+;;adds an association of @2 with its @dfn{relational-system} procedure
+;;to @var{mdbm:*databases*}.
+;;
+;;alist-table is the default base-table type:
+;;
+;;@example
+;;(require 'databases)
+;;(define my-rdb (create-database "my.db" 'alist-table))
+;;@end example
+(define (create-database filename type)
   (require type)
-  (let ((rdb (((make-relational-system (slib:eval type)) 'create-database)
-	      path)))
-    (dbutil:define-tables
-     rdb
-     '(type
-       ((name symbol))
-       ()
-       ((atom)
-	(symbol)
-	(string)
-	(number)
-	(money)
-	(date-time)
-	(boolean)
-	(foreign-key)
-	(expression)
-	(virtual)))
-     '(parameter-arity
-       ((name symbol))
-       ((predicate? expression)
-	(procedure expression))
-       ((single (lambda (a) (and (pair? a) (null? (cdr a)))) car)
-	(optional
-	 (lambda (lambda (a) (or (null? a) (and (pair? a) (null? (cdr a))))))
-	 identity)
-	(boolean
-	 (lambda (a) (or (null? a)
-			 (and (pair? a) (null? (cdr a)) (boolean? (car a)))))
-	 (lambda (a) (if (null? a) #f (car a))))
-	(nary (lambda (a) #t) identity)
-	(nary1 (lambda (a) (not (null? a))) identity))))
-    (for-each (((rdb 'open-table) '*domains-data* #t) 'row:insert)
-	      '((parameter-list *catalog-data* #f symbol 1)
-		(parameter-name-translation *catalog-data* #f symbol 1)
-		(parameter-arity parameter-arity #f symbol 1)
-		(table *catalog-data* #f atom 1)))
-    (dbutil:define-tables
-     rdb
-     '(*parameter-columns*
-       *columns*
-       *columns*
-       ((1 #t index #f uint)
-	(2 #f name #f symbol)
-	(3 #f arity #f parameter-arity)
-	(4 #f domain #f domain)
-	(5 #f defaulter #f expression)
-	(6 #f expander #f expression)
-	(7 #f documentation #f string)))
-     '(no-parameters
-       *parameter-columns*
-       *parameter-columns*
-       ())
-     '(no-parameter-names
-       ((name string))
-       ((parameter-index uint))
-       ())
-     '(add-domain-params
-       *parameter-columns*
-       *parameter-columns*
-       ((1 domain-name single atom #f #f "new domain name")
-	(2 foreign-table optional table #f #f
-	   "if present, domain-name must be existing key into this table")
-	(3 domain-integrity-rule optional expression #f #f
-	   "returns #t if single argument is good")
-	(4 type-id single type #f #f "base type of new domain")
-	(5 type-param optional expression #f #f
-	   "which (key) field of the foreign-table")
-	))
-     '(add-domain-pnames
-       ((name string))
-       ((parameter-index uint))		;should be add-domain-params
-       (
-	("n" 1) ("name" 1)
-	("f" 2) ("foreign (key) table" 2)
-	("r" 3) ("domain integrity rule" 3)
-	("t" 4) ("type" 4)
-	("p" 5) ("type param" 5)
-	))
-     '(del-domain-params
-       *parameter-columns*
-       *parameter-columns*
-       ((1 domain-name single domain #f #f "domain name")))
-     '(del-domain-pnames
-       ((name string))
-       ((parameter-index uint))		;should be del-domain-params
-       (("n" 1) ("name" 1)))
-     '(*commands*
-       ((name symbol))
-       ((parameters parameter-list)
-	(parameter-names parameter-name-translation)
-	(procedure expression)
-	(documentation string))
-       ((domain-checker
-	 no-parameters
-	 no-parameter-names
-	 dbutil:check-domain
-	 "return procedure to check given domain name")
-
-	(add-domain
-	 add-domain-params
-	 add-domain-pnames
-	 (lambda (rdb)
-	   (((rdb 'open-table) '*domains-data* #t) 'row:update))
-	 "add a new domain")
-
-	(delete-domain
-	 del-domain-params
-	 del-domain-pnames
-	 (lambda (rdb)
-	   (((rdb 'open-table) '*domains-data* #t) 'row:remove))
-	 "delete a domain"))))
-    (let* ((tab ((rdb 'open-table) '*domains-data* #t))
-	   (row ((tab 'row:retrieve) 'type)))
-      (set-car! (cdr row) 'type)
-      ((tab 'row:update) row))
-    (dbutil:wrap-command-interface rdb)))
-
-(define (make-defaulter arity type)
-  `(lambda (pl)
-     ',(case arity
-	 ((optional nary) '())
-	 ((boolean) #f)
-	 ((single nary1)
-	  (case type
-	    ((string) '(""))
-	    ((symbol) '(nil))
-	    ((number) '(0))
-	    (else '(#f))))
-	 (else (slib:error 'make-defaulter 'unknown 'arity arity)))))
-
-(define (get-foreign-choices tab)
-  (define dlst ((tab 'get* 1)))
-  (do ((dlst dlst (cdr dlst))
-       (vlst (if (memq 'visible-name (tab 'column-names))
-		 ((tab 'get* 'visible-name))
-		 dlst)
-	     (cdr vlst))
-       (out '() (if (member (car dlst) (cdr dlst))
-		    out
-		    (cons (list (car dlst) (car vlst)) out))))
-      ((null? dlst) out)))
-
-(define (make-command-server rdb command-table)
-  (let* ((comtab ((rdb 'open-table) command-table #f))
-	 (names (comtab 'column-names))
-	 (row-ref (lambda (row name) (list-ref row (position name names))))
-	 (comgetrow (comtab 'row:retrieve)))
-    (lambda (comname command-callback)
-      (cond ((not comname) (set! comname '*default*)))
-      (cond ((not (comgetrow comname))
-	     (slib:error 'command 'not 'known: comname)))
-      (let* ((command:row (comgetrow comname))
-	     (parameter-table
-	      ((rdb 'open-table) (row-ref command:row 'parameters) #f))
-	     (parameter-names
-	      ((rdb 'open-table) (row-ref command:row 'parameter-names) #f))
-	     (comval ((slib:eval (row-ref command:row 'procedure)) rdb))
-	     (options ((parameter-table 'get* 'name)))
-	     (positions ((parameter-table 'get* 'index)))
-	     (arities ((parameter-table 'get* 'arity)))
-	     (defaulters (map slib:eval ((parameter-table 'get* 'defaulter))))
-	     (domains ((parameter-table 'get* 'domain)))
-	     (types (map (((rdb 'open-table) '*domains-data* #f) 'get 'type-id)
-			 domains))
-	     (dirs (map (rdb 'domain-checker) domains))
-	     (aliases
-	      (map list ((parameter-names 'get* 'name))
-		   (map (parameter-table 'get 'name)
-			((parameter-names 'get* 'parameter-index))))))
-	(command-callback comname comval options positions
-			  arities types defaulters dirs aliases)))))
-
-(define (dbutil:define-tables rdb . spec-list)
+  (let ((dbs #f)
+	(certificate (and filename (file-lock! filename))))
+    (and
+     (or certificate (not filename))
+     (dynamic-wind
+	 (lambda () (set! dbs (mdbm:*databases* #f)))
+	 (lambda ()
+	   (define entry (mdbm:find-db? filename dbs))
+	   (cond (entry (slib:warn 'close ((car entry) 'filename)
+				   'before 'create-database) #f)
+		 (else
+		  (let ((pair (assq type *base-table-implementations*)))
+		    (define ndb (and pair (((cadr pair) 'create-database)
+					   filename)))
+		    (if (and ndb dbs)
+			(set! dbs (cons (list ndb 1 type certificate) dbs)))
+		    ndb))))
+	 (lambda () (and dbs (mdbm:return-dbs dbs)))))))
+
+;;@noindent
+;;Only @code{alist-table} and base-table modules which have been
+;;@code{require}d will dispatch correctly from the
+;;@code{open-database} procedures.  Therefore, either pass two
+;;arguments to @code{open-database}, or require the base-table of your
+;;database file uses before calling @code{open-database} with one
+;;argument.
+
+;;@args rdb base-table-type
+;;Returns @emph{mutable} open relational database or #f.
+(define (open-database! filename . type)
+  (set! type (and (not (null? type)) (car type)))
+  (let ((dbs #f))
+    (dynamic-wind
+	(lambda () (set! dbs (mdbm:*databases* #f)))
+	(lambda ()
+	  (cond ((and (procedure? filename) (not (filename 'delete-table)))
+		 (slib:warn (filename 'filename) 'not 'mutable) #f)
+		((mdbm:find-db? filename dbs)
+		 (cond ((procedure? filename) filename)
+		       (else (slib:warn filename 'already 'open) #f)))
+		(else (let ((entry (if type
+				       (mdbm:open-type filename type #t)
+				       (mdbm:try-opens filename #t))))
+			(cond (entry (and dbs (set! dbs (cons entry dbs)))
+				     (car entry))
+			      (else #f))))))
+	(lambda () (and dbs (mdbm:return-dbs dbs))))))
+
+;;@args rdb base-table-type
+;;Returns an open relational database associated with @1.  The
+;;database will be opened with base-table type @2).
+;;
+;;@args rdb
+;;Returns an open relational database associated with @1.
+;;@0 will attempt to deduce the correct base-table-type.
+(define (open-database rdb . type)
+  (set! type (and (not (null? type)) (car type)))
+  (let ((dbs #f))
+    (dynamic-wind
+	(lambda () (set! dbs (mdbm:*databases* #f)))
+	(lambda ()
+	  (define entry (mdbm:find-db? rdb dbs))
+	  (and entry (set! rdb (car entry)))
+	  (cond ((and entry type (not (eqv? (caddr entry) type)))
+		 (slib:warn (rdb 'filename) 'type type '<> (caddr entry)) #f)
+		((and (procedure? rdb) (rdb 'delete-table))
+		 (slib:warn (rdb 'filename) 'mutable) #f)
+		(entry (set-car! (cdr entry) (+ 1 (cadr entry))) rdb)
+		(else
+		 (set! entry
+		       (cond ((procedure? rdb) (list rdb 1 type #f))
+			     (type (mdbm:open-type rdb type #f))
+			     (else (mdbm:try-opens rdb #f))))
+		 (cond (entry (and dbs (set! dbs (cons entry dbs)))
+			      (car entry))
+		       (else #f)))))
+	(lambda () (and dbs (mdbm:return-dbs dbs))))))
+
+;;@body
+;;Writes the mutable relational-database @1 to @2.
+(define (write-database rdb filename)
+  (let ((dbs #f))
+    (dynamic-wind
+	(lambda () (set! dbs (mdbm:*databases* #f)))
+	(lambda ()
+	  (define entry (mdbm:find-db? rdb dbs))
+	  (and entry (set! rdb (car entry)))
+	  (cond ((and (not entry) (procedure? rdb))
+		 (set! entry (list rdb 1 #f (file-lock! filename)))
+		 (and dbs (set! dbs (cons entry dbs)))))
+	  (cond ((not entry) #f)
+		((and (not (equal? filename (rdb 'filename)))
+		      (mdbm:find-db? filename dbs))
+		 (slib:warn filename 'already 'open) #f)
+		(else (let ((dbwrite (rdb 'write-database)))
+			(and dbwrite (dbwrite filename))))))
+	(lambda () (and dbs (mdbm:return-dbs dbs))))))
+
+;;@args rdb
+;;Writes the mutable relational-database @1 to the filename it was
+;;opened with.
+(define (sync-database rdb)
+  (let ((dbs #f))
+    (dynamic-wind
+	(lambda () (set! dbs (mdbm:*databases* #f)))
+	(lambda ()
+	  (define entry (mdbm:find-db? rdb dbs))
+	  (and entry (set! rdb (car entry)))
+	  (cond ((and (not entry) (procedure? rdb))
+		 (set! entry (list rdb 1 #f (file-lock! (rdb 'filename))))
+		 (and dbs (set! dbs (cons entry dbs)))))
+	  (cond (entry (let ((db-op (rdb 'sync-database)))
+			 (and db-op (db-op))))
+		(else #f)))
+	(lambda () (and dbs (mdbm:return-dbs dbs))))))
+
+;;@args rdb
+;;Syncs @1 and makes it immutable.
+(define (solidify-database rdb)		;
+  (let ((dbs #f))
+    (dynamic-wind
+	(lambda () (set! dbs (mdbm:*databases* #f)))
+	(lambda ()
+	  (define entry (mdbm:find-db? rdb dbs))
+	  (define certificate #f)
+	  (cond (entry (set! rdb (car entry))
+		       (set! certificate (cadddr entry)))
+		((procedure? rdb)
+		 (set! entry (list rdb 1 #f (file-lock! (rdb 'filename))))
+		 (and dbs (set! dbs (cons entry dbs)))
+		 (set! certificate (cadddr entry))))
+	  (cond ((or (not certificate) (not (procedure? rdb))) #f)
+		(else
+		 (let* ((filename (rdb 'filename))
+			(dbsolid (rdb 'solidify-database))
+			(ret (and dbsolid (dbsolid))))
+		   (if (file-unlock! filename certificate)
+		       (set-car! (cdddr entry) #f)
+		       (slib:warn 'file-unlock! filename certificate 'failed))
+		   ret))))
+	(lambda () (and dbs (mdbm:return-dbs dbs))))))
+
+;;@body
+;;@1 will only be closed when the count of @code{open-database} - @0
+;;calls for @1 (and its filename) is 0.  @0 returns #t if successful;
+;;and #f otherwise.
+(define (close-database rdb)
+  (let ((dbs #f))
+    (dynamic-wind
+	(lambda () (set! dbs (mdbm:*databases* #f)))
+	(lambda ()
+	  (define entry (mdbm:find-db? rdb dbs))
+	  (define certificate #f)
+	  (and entry (set! rdb (car entry)))
+	  (and (procedure? rdb)
+	       (set! certificate (or (and entry (cadddr entry))
+				     (and (rdb 'filename)
+					  (file-lock! (rdb 'filename))))))
+	  (cond ((and entry (not (eqv? 1 (cadr entry))))
+		 (set-car! (cdr entry) (+ -1 (cadr entry)))
+		 #f)
+		((or (not certificate) (not (procedure? rdb)))
+		 #f)
+		(else
+		 (let* ((filename (rdb 'filename))
+			(dbclose (rdb 'close-database))
+			(ret (and dbclose (dbclose))))
+		   (if (not (file-unlock! filename certificate))
+		       (slib:warn 'file-unlock! filename certificate 'failed))
+		   (cond ((not dbclose) (slib:warn 'database? rdb))
+			 ((not entry))
+			 (dbs (set! dbs (mdbm:remove-entry dbs entry))))
+		   ret))))
+	(lambda () (and dbs (mdbm:return-dbs dbs))))))
+
+;;@body
+;;Prints a table of open database files.  The columns are the
+;;base-table type, number of opens, @samp{!} for mutable, the
+;;filename, and the lock certificate (if locked).
+(define (mdbm:report)
+  (require 'printf)
+  (let ((dbs #f))
+    (dynamic-wind
+	(lambda () (set! dbs (mdbm:*databases* #f)))
+	(lambda ()
+	  (cond (dbs (for-each (lambda (entry)
+				 (printf "%15s %03d %1s %s %s\\n"
+					 (or (caddr entry) "?")
+					 (cadr entry)
+					 (if ((car entry) 'delete-table) '! "")
+					 (or ((car entry) 'filename) '-)
+					 (or (cadddr entry) "")))
+			       dbs))
+		(else (printf "%s lock broken.\\n" 'mdbm:*databases*))))
+	(lambda () (and dbs (mdbm:return-dbs dbs))))))
+;;@example
+;;(mdbm:report)
+;;@print{}
+;;  alist-table 003   /usr/local/lib/slib/clrnamdb.scm
+;;  alist-table 001 ! sdram.db jaffer@@aubrey.jaffer.3166:1038628199
+;;@end example
+
+
+;;@subsubheading Opening Tables
+
+;;@body
+;;@1 must be a relational database and @2 a symbol.
+;;
+;;@0 returns a "methods" procedure for an existing relational table in
+;;@1 if it exists and can be opened for reading, otherwise returns
+;;@code{#f}.
+(define (open-table rdb table-name)
+  ((rdb 'open-table) table-name #f))
+
+;;@body
+;;@1 must be a relational database and @2 a symbol.
+;;
+;;@0 returns a "methods" procedure for an existing relational table in
+;;@1 if it exists and can be opened in mutable mode, otherwise returns
+;;@code{#f}.
+(define (open-table! rdb table-name)
+  ((rdb 'open-table) table-name #t))
+
+
+;;@subsubheading Defining Tables
+
+;;@body
+;;Adds the domain rows @2 @dots{} to the @samp{*domains-data*} table
+;;in @1.  The format of the row is given in @ref{Catalog
+;;Representation}.
+;;
+;;@example
+;;(define-domains rdb '(permittivity #f complex? c64 #f))
+;;@end example
+(define (define-domains rdb . row5)
+  (define add-domain (((rdb 'open-table) '*domains-data* #t) 'row:update))
+  (for-each add-domain row5))
+
+;;@body
+;;Use @code{define-domains} instead.
+(define (add-domain rdb row5)
+  ((((rdb 'open-table) '*domains-data* #t) 'row:update)
+   row5))
+
+;;@args rdb spec-0 @dots{}
+;;Adds tables as specified in @var{spec-0} @dots{} to the open
+;;relational-database @1.  Each @var{spec} has the form:
+;;
+;;@lisp
+;;(@r{<name>} @r{<descriptor-name>} @r{<descriptor-name>} @r{<rows>})
+;;@end lisp
+;;or
+;;@lisp
+;;(@r{<name>} @r{<primary-key-fields>} @r{<other-fields>} @r{<rows>})
+;;@end lisp
+;;
+;;where @r{<name>} is the table name, @r{<descriptor-name>} is the symbol
+;;name of a descriptor table, @r{<primary-key-fields>} and
+;;@r{<other-fields>} describe the primary keys and other fields
+;;respectively, and @r{<rows>} is a list of data rows to be added to the
+;;table.
+;;
+;;@r{<primary-key-fields>} and @r{<other-fields>} are lists of field
+;;descriptors of the form:
+;;
+;;@lisp
+;;(@r{<column-name>} @r{<domain>})
+;;@end lisp
+;;or
+;;@lisp
+;;(@r{<column-name>} @r{<domain>} @r{<column-integrity-rule>})
+;;@end lisp
+;;
+;;where @r{<column-name>} is the column name, @r{<domain>} is the domain
+;;of the column, and @r{<column-integrity-rule>} is an expression whose
+;;value is a procedure of one argument (which returns @code{#f} to signal
+;;an error).
+;;
+;;If @r{<domain>} is not a defined domain name and it matches the name of
+;;this table or an already defined (in one of @var{spec-0} @dots{}) single
+;;key field table, a foreign-key domain will be created for it.
+(define (define-tables rdb . spec-list)
   (define new-tables '())
   (define dom:typ (((rdb 'open-table) '*domains-data* #f) 'get 4))
   (define create-table (rdb 'create-table))
@@ -245,26 +437,25 @@
   (define (check-domain dname)
     (cond ((dom:typ dname))
 	  ((member dname new-tables)
-	   (let* ((ftab (open-table
-			 (string->symbol
-			  (string-append "desc:" (symbol->string dname)))
-			 #f)))
+	   (let ((ftab (open-table
+			(string->symbol
+			 (string-append "desc:" (symbol->string dname)))
+			#f)))
 	     ((((rdb 'open-table) '*domains-data* #t) 'row:insert)
 	      (list dname dname #f
 		    (dom:typ ((ftab 'get 'domain-name) 1)) 1))))))
   (define (define-table name prikeys slots data)
     (cond
      ((table-exists? name)
-      (let* ((tab (open-table name #t))
-	     (row:update (tab 'row:update)))
-	(for-each row:update data)))
+      (let ((tab (open-table name #t)))
+	((tab 'row:update*) data)
+	((tab 'close-table))))
      ((and (symbol? prikeys) (eq? prikeys slots))
       (cond ((not (table-exists? slots))
 	     (slib:error "Table doesn't exist:" slots)))
       (set! new-tables (cons name new-tables))
-      (let* ((tab (create-table name slots))
-	     (row:insert (tab 'row:insert)))
-	(for-each row:insert data)
+      (let ((tab (create-table name slots)))
+	((tab 'row:insert*) data)
 	((tab 'close-table))))
      (else
       (let* ((descname
@@ -289,12 +480,22 @@
 		  slots)
 	((tab 'close-table))
 	(set! tab (create-table name descname))
-	(set! row:insert (tab 'row:insert))
-	(for-each row:insert data)
+	((tab 'row:insert*) data)
 	((tab 'close-table))))))
   (for-each (lambda (spec) (apply define-table spec)) spec-list))
 
-(define (dbutil:list-table-definition rdb table-name)
+
+;;@subsubheading Listing Tables
+
+;;@body
+;;If symbol @2 exists in the open relational-database
+;;@1, then returns a list of the table-name, its primary key names
+;;and domains, its other key names and domains, and the table's records
+;;(as lists).  Otherwise, returns #f.
+;;
+;;The list returned by @0, when passed as an
+;;argument to @code{define-tables}, will recreate the table.
+(define (list-table-definition rdb table-name)
   (cond (((rdb 'table-exists?) table-name)
 	 (let* ((table ((rdb 'open-table) table-name #f))
 		(prilimit (table 'primary-limit))
@@ -306,9 +507,4 @@
 		 (nthcdr prilimit coldefs)
 		 ((table 'row:retrieve*)))))
 	(else #f)))
-
-(define create-database dbutil:create-database)
-(define open-database! dbutil:open-database!)
-(define open-database dbutil:open-database)
-(define define-tables dbutil:define-tables)
-(define list-table-definition dbutil:list-table-definition)
+;;(trace-all "/home/jaffer/slib/dbutil.scm") (untrace define-tables)
diff --git a/dbutil.txi b/dbutil.txi
new file mode 100644
index 0000000..cc198f3
--- /dev/null
+++ b/dbutil.txi
@@ -0,0 +1,219 @@
+@code{(require 'databases)}
+@ftindex databases
+
+@noindent
+This enhancement wraps a utility layer on @code{relational-database}
+which provides:
+
+@itemize @bullet
+@item
+Identification of open databases by filename.
+@item
+Automatic sharing of open (immutable) databases.
+@item
+Automatic loading of base-table package when creating a database.
+@item
+Detection and automatic loading of the appropriate base-table package
+when opening a database.
+@item
+Table and data definition from Scheme lists.
+@end itemize
+
+@subsubheading Database Sharing
+
+@noindent
+@dfn{Auto-sharing} refers to a call to the procedure
+@cindex Auto-sharing
+@code{open-database} returning an already open database (procedure),
+rather than opening the database file a second time.
+
+@quotation
+@emph{Note:} Databases returned by @code{open-database} do not include
+wrappers applied by packages like @ref{Embedded Commands}.  But
+wrapped databases do work as arguments to these functions.
+@end quotation
+
+@noindent
+When a database is created, it is mutable by the creator and not
+auto-sharable.  A database opened mutably is also not auto-sharable.
+But any number of readers can (open) share a non-mutable database file.
+
+@noindent
+This next set of procedures mirror the whole-database methods in
+@ref{Database Operations}.  Except for @code{create-database}, each
+procedure will accept either a filename or database procedure for its
+first argument.
+
+
+@defun create-database filename base-table-type
+
+@var{filename} should be a string naming a file; or @code{#f}.  @var{base-table-type} must be a
+symbol naming a feature which can be passed to @code{require}.  @code{create-database}
+returns a new, open relational database (with base-table type @var{base-table-type})
+associated with @var{filename}, or a new ephemeral database if @var{filename} is @code{#f}.
+
+@code{create-database} is the only run-time use of require in SLIB
+which crosses module boundaries.  When @var{base-table-type} is @code{require}d by @code{create-database}; it
+adds an association of @var{base-table-type} with its @dfn{relational-system} procedure
+@cindex relational-system
+to @var{mdbm:*databases*}.
+
+alist-table is the default base-table type:
+
+@example
+(require 'databases)
+(define my-rdb (create-database "my.db" 'alist-table))
+@end example
+@end defun
+@noindent
+Only @code{alist-table} and base-table modules which have been
+@code{require}d will dispatch correctly from the
+@code{open-database} procedures.  Therefore, either pass two
+arguments to @code{open-database}, or require the base-table of your
+database file uses before calling @code{open-database} with one
+argument.
+
+
+@deffn {Procedure} open-database! rdb base-table-type
+
+Returns @emph{mutable} open relational database or #f.
+@end deffn
+
+@defun open-database rdb base-table-type
+
+Returns an open relational database associated with @var{rdb}.  The
+database will be opened with base-table type @var{base-table-type}).
+
+
+@defunx open-database rdb
+Returns an open relational database associated with @var{rdb}.
+@code{open-database} will attempt to deduce the correct base-table-type.
+@end defun
+
+@defun write-database rdb filename
+
+Writes the mutable relational-database @var{rdb} to @var{filename}.
+@end defun
+
+@defun sync-database rdb
+
+Writes the mutable relational-database @var{rdb} to the filename it was
+opened with.
+@end defun
+
+@defun solidify-database rdb
+
+Syncs @var{rdb} and makes it immutable.
+@end defun
+
+@defun close-database rdb
+
+@var{rdb} will only be closed when the count of @code{open-database} - @code{close-database}
+calls for @var{rdb} (and its filename) is 0.  @code{close-database} returns #t if successful;
+and #f otherwise.
+@end defun
+
+@defun mdbm:report
+
+Prints a table of open database files.  The columns are the
+base-table type, number of opens, @samp{!} for mutable, the
+filename, and the lock certificate (if locked).
+@end defun
+@example
+(mdbm:report)
+@print{}
+  alist-table 003   /usr/local/lib/slib/clrnamdb.scm
+  alist-table 001 ! sdram.db jaffer@@aubrey.jaffer.3166:1038628199
+@end example
+
+@subsubheading Opening Tables
+
+
+@defun open-table rdb table-name
+
+@var{rdb} must be a relational database and @var{table-name} a symbol.
+
+@code{open-table} returns a "methods" procedure for an existing relational table in
+@var{rdb} if it exists and can be opened for reading, otherwise returns
+@code{#f}.
+@end defun
+
+@deffn {Procedure} open-table! rdb table-name
+
+@var{rdb} must be a relational database and @var{table-name} a symbol.
+
+@code{open-table!} returns a "methods" procedure for an existing relational table in
+@var{rdb} if it exists and can be opened in mutable mode, otherwise returns
+@code{#f}.
+@end deffn
+@subsubheading Defining Tables
+
+
+@defun define-domains rdb row5 @dots{}
+
+Adds the domain rows @var{row5} @dots{} to the @samp{*domains-data*} table
+in @var{rdb}.  The format of the row is given in @ref{Catalog
+Representation}.
+
+@example
+(define-domains rdb '(permittivity #f complex? c64 #f))
+@end example
+@end defun
+
+@defun add-domain rdb row5
+
+Use @code{define-domains} instead.
+@end defun
+
+@defun define-tables rdb spec-0 @dots{}
+
+Adds tables as specified in @var{spec-0} @dots{} to the open
+relational-database @var{rdb}.  Each @var{spec} has the form:
+
+@lisp
+(@r{<name>} @r{<descriptor-name>} @r{<descriptor-name>} @r{<rows>})
+@end lisp
+or
+@lisp
+(@r{<name>} @r{<primary-key-fields>} @r{<other-fields>} @r{<rows>})
+@end lisp
+
+where @r{<name>} is the table name, @r{<descriptor-name>} is the symbol
+name of a descriptor table, @r{<primary-key-fields>} and
+@r{<other-fields>} describe the primary keys and other fields
+respectively, and @r{<rows>} is a list of data rows to be added to the
+table.
+
+@r{<primary-key-fields>} and @r{<other-fields>} are lists of field
+descriptors of the form:
+
+@lisp
+(@r{<column-name>} @r{<domain>})
+@end lisp
+or
+@lisp
+(@r{<column-name>} @r{<domain>} @r{<column-integrity-rule>})
+@end lisp
+
+where @r{<column-name>} is the column name, @r{<domain>} is the domain
+of the column, and @r{<column-integrity-rule>} is an expression whose
+value is a procedure of one argument (which returns @code{#f} to signal
+an error).
+
+If @r{<domain>} is not a defined domain name and it matches the name of
+this table or an already defined (in one of @var{spec-0} @dots{}) single
+key field table, a foreign-key domain will be created for it.
+@end defun
+@subsubheading Listing Tables
+
+
+@defun list-table-definition rdb table-name
+
+If symbol @var{table-name} exists in the open relational-database
+@var{rdb}, then returns a list of the table-name, its primary key names
+and domains, its other key names and domains, and the table's records
+(as lists).  Otherwise, returns #f.
+
+The list returned by @code{list-table-definition}, when passed as an
+argument to @code{define-tables}, will recreate the table.
+@end defun
diff --git a/debian/changelog b/debian/changelog
index 411c3c4..99d04fa 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,73 @@
+slib (3a1-4.2) unstable; urgency=low
+
+  * Non-maintainer upload.
+  * Add guile.init.local for use within the build dir, since otherwise we
+    have an (earlier unnoticed) circular build-dep due to a difference
+    between scm and guile.
+
+ -- Steve Langasek <vorlon@debian.org>  Mon, 10 Jan 2005 08:53:33 +0000
+
+slib (3a1-4.1) unstable; urgency=low
+
+  * Non-maintainer upload.
+  * Build-depend on guile-1.6 instead of scm, since the new version of
+    scm is wedged in unstable (closes: #281809).
+
+ -- Steve Langasek <vorlon@debian.org>  Sat,  8 Jan 2005 17:56:08 -0800
+
+slib (3a1-4) unstable; urgency=low
+
+  * Also check for expected creation on slibcat. (Closes: #240096)
+
+ -- James LewisMoss <dres@debian.org>  Sun, 28 Mar 2004 17:29:19 -0500
+
+slib (3a1-3) unstable; urgency=low
+
+  * Also check for /usr/share/guile/1.6/slib before installing for guile
+    1.6. (Closes: #239267)
+
+ -- James LewisMoss <dres@debian.org>  Mon, 22 Mar 2004 20:53:40 -0500
+
+slib (3a1-2) unstable; urgency=low
+
+  * Add format.scm back into slib until gnucash stops using it.
+  * Call guile-1.6 new-catalog (Closes: #238231)
+
+ -- James LewisMoss <dres@debian.org>  Sat, 20 Mar 2004 16:51:07 -0500
+
+slib (3a1-1) unstable; urgency=low
+
+  * New upstream release
+  * Remove Info section from doc-base file (Closes: #186950)
+  * Remove period from end of description (linda, lintian)
+  * html gen fixed upstream (Closes: #111778)
+
+ -- James LewisMoss <dres@debian.org>  Sun, 14 Mar 2004 11:56:11 -0500
+
+slib (2d4-2) unstable; urgency=low
+
+  * Fix url for upstream source (Closes: #144981)
+  * Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
+  * Add build depends.
+
+ -- James LewisMoss <dres@debian.org>  Thu, 23 May 2002 13:33:33 -0400
+
+slib (2d4-1) unstable; urgency=low
+
+  * New upstream.
+
+ -- James LewisMoss <dres@debian.org>  Fri, 17 May 2002 11:23:06 -0400
+
+slib (2d3-1) unstable; urgency=low
+
+  * New upstream.
+  * Remove texi2html call in debian/rules.  Now done upstream.  Add make
+    html instead.
+  * Changes to rules and doc-base to conform to upstream html gen
+  * Clean up upstream makefile to make sure it cleans up after itself.
+
+ -- James LewisMoss <dres@debian.org>  Sat,  6 Apr 2002 16:27:35 -0500
+
 slib (2d2-1) unstable; urgency=low
 
   * New upstream version
@@ -52,7 +122,7 @@ slib (2c7-1) unstable; urgency=low
 slib (2c6-2) unstable; urgency=low
 
   * Remove the slib$(VERSION).info file.  Cut the diff back down to
-    size. 
+    size.
 
  -- James LewisMoss <dres@debian.org>  Sat, 13 Nov 1999 14:10:38 -0500
 
@@ -95,7 +165,7 @@ slib (2c5-3) unstable; urgency=low
 slib (2c5-2) unstable; urgency=low
 
   * Link mklibcat.scm to mklibcat.  Fixes a problem with using slib with
-    guile. 
+    guile.
 
  -- James LewisMoss <dres@debian.org>  Sun,  7 Mar 1999 21:51:35 -0500
 
@@ -159,5 +229,3 @@ slib (2a6-1) unstable; urgency=low
   * First Debian release.
 
  -- Karl Sackett <krs@debian.org>  Mon, 16 Dec 1996 09:23:46 -0600
-
-
diff --git a/debian/control b/debian/control
index d4392b7..084f82f 100644
--- a/debian/control
+++ b/debian/control
@@ -2,13 +2,14 @@ Source: slib
 Section: devel
 Priority: optional
 Maintainer: James LewisMoss <dres@debian.org>
-Standards-Version: 3.0.0
+Build-Depends-Indep: guile-1.6, texi2html, texinfo
+Standards-Version: 3.1.0
 
 Package: slib
 Section: devel
 Priority: optional
 Architecture: all
-Description: Portable Scheme library.
+Description: Portable Scheme library
  SLIB is a portable scheme library meant to provide compatibility and
  utility functions for all standard scheme implementations.  SLIB
  includes initialization files for Chez, ELK 2.1, GAMBIT, MacScheme,
diff --git a/debian/copyright b/debian/copyright
index 2a18aa9..0445f9e 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -1,9 +1,10 @@
 This is the Debian GNU/Linux prepackaged version of slib.
 
-This package was put together by Rob Browning <rlb@cs.utexas.edu>
-from sources obtained from:
+This package was put together by Rob Browning <rlb@cs.utexas.edu> and
+continued by James LewisMoss <dres@debian.org> from sources obtained
+from:
 
-	ftp://swiss-ftp.ai.mit.edu/archive/scm/slib2d1.zip
+	http://swissnet.ai.mit.edu/ftpdir/scm/slib2d4.zip
 
 For more information see:
 
diff --git a/debian/doc-base b/debian/doc-base
index 72e6327..dc4d265 100644
--- a/debian/doc-base
+++ b/debian/doc-base
@@ -5,11 +5,6 @@ Abstract: This manual describes the facilities and functions
  provided by the slib scheme library.
 Section: Apps/Programming
 
-Format: Info
-Section: The Algorithmic Language Scheme
-Index: /usr/share/info/slib.info.gz
-Files: /usr/share/info/slib.info.gz
-
 Format: HTML
-Index: /usr/share/doc/slib/slib.html
-Files: /usr/share/doc/slib/slib.html
+Index: /usr/share/doc/slib/slib_toc.html
+Files: /usr/share/doc/slib/slib_*.html
diff --git a/debian/postinst b/debian/postinst
index 847a44a..88aa502 100644
--- a/debian/postinst
+++ b/debian/postinst
@@ -15,10 +15,12 @@ if [ -x /usr/sbin/guile1.4-slibconfig ] ; then
     /usr/sbin/guile1.4-slibconfig
 fi
 
-if [ "$1" = "configure" ]; then
-	if [ -d /usr/doc -a ! -e /usr/doc/slib -a -d /usr/share/doc/slib ]; then
-		ln -sf ../share/doc/slib /usr/doc/slib
-	fi
+if [ -x /usr/bin/guile-1.6 -a -e /usr/share/guile/1.6/slib ] ; then
+    rm -f /usr/share/guile/1.6/slibcat
+    /usr/bin/guile-1.6 -c "(use-modules (ice-9 slib)) (require 'new-catalog)"
+    if [ -e /usr/share/guile/1.6/slibcat ] ; then
+      chmod 644 /usr/share/guile/1.6/slibcat
+    fi
 fi
 
 # doc base support
diff --git a/debian/rules b/debian/rules
index f690acd..ed0da6b 100755
--- a/debian/rules
+++ b/debian/rules
@@ -1,6 +1,9 @@
 #! /usr/bin/make -f
 # -*-Makefile-*-
 
+SCHEME_LIBRARY_PATH=./
+export SCHEME_LIBRARY_PATH
+
 CC =gcc
 CFLAGS =-O2 -g -Wall
 LDFLAGS =
@@ -17,12 +20,11 @@ INSTALL_MAN =$(INSTALL) -m 444 -o root -g root
 build:
 	$(checkdir)
 	make
-	texi2html -monolithic slib.texi
+	make html
 	touch build
 
 clean:
 	$(checkdir)
-	-rm slib.html
 	-rm slib.info*
 	make clean
 	-rm -f build
@@ -60,7 +62,7 @@ binary-indep: checkroot build
 	gzip -9v debian/tmp/usr/share/doc/slib/README
 	$(INSTALL_DATA) FAQ debian/tmp/usr/share/doc/slib
 	gzip -9v debian/tmp/usr/share/doc/slib/FAQ
-	$(INSTALL_DATA) slib.html debian/tmp/usr/share/doc/slib
+	$(INSTALL_DATA) slib_html/*.html debian/tmp/usr/share/doc/slib
 
 	$(INSTALL_DIR) debian/tmp/usr/share/slib/init
 	$(INSTALL_DATA) *.init debian/tmp/usr/share/slib/init
diff --git a/debug.scm b/debug.scm
index 0a913b4..73acc0b 100644
--- a/debug.scm
+++ b/debug.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -62,7 +62,7 @@
 	    (let ((sym (get-defined-symbol (cadr form))))
 	      (cond ((procedure? (slib:eval sym))
 		     (proc sym)))))))))
-
+;@
 (define (trace-all file . ...)
   (for-each
    (lambda (file)
@@ -87,7 +87,7 @@
       (lambda (sym)
 	(slib:eval `(set! ,sym (trace:trace-procedure 'stack ,sym ',sym))))))
    (cons file ...)))
-
+;@
 (define (break-all file . ...)
   (for-each
    (lambda (file)
diff --git a/defmacex.scm b/defmacex.scm
index 5863c94..71d7b6c 100644
--- a/defmacex.scm
+++ b/defmacex.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -38,7 +38,7 @@
 		    (else (map1 (lambda (e) (iqq e depth)) e)))
 		  e))))
     (iqq e depth)))
-
+;@
 (define (defmacro:expand* e)
   (if (pair? e)
       (let* ((c (macroexpand-1 e)))
diff --git a/determ.scm b/determ.scm
index 4b53e5f..1078750 100644
--- a/determ.scm
+++ b/determ.scm
@@ -1,14 +1,147 @@
-;"determ.scm" Determinant
+;;; "determ.scm" Matrix Algebra
+;Copyright 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
 
-(define (determinant m)
+(require 'array)
+
+;;@code{(require 'determinant)}
+;;@ftindex determinant
+
+;;@noindent
+;;A Matrix can be either a list of lists (rows) or an array.
+;;As with linear-algebra texts, this package uses 1-based coordinates.
+
+;;; Internal conversion routines
+(define (matrix2array matrix prototype)
+  (let* ((shp (list (list 1 (length matrix))
+		    (list 1 (length (car matrix)))))
+	 (mat (apply create-array '#() shp)))
+    (do ((idx 1 (+ 1 idx))
+	 (rows matrix (cdr rows)))
+	((> idx (cadar shp)) rows)
+      (do ((jdx 1 (+ 1 jdx))
+	   (row (car rows) (cdr row)))
+	  ((> jdx (cadadr shp)))
+	(array-set! mat (car row) idx jdx)))
+    mat))  
+(define (matrix2lists matrix)
+  (let ((shp (array-shape matrix)))
+    (do ((idx (cadar shp) (+ -1 idx))
+	 (rows '() 
+	       (cons (do ((jdx (cadadr shp) (+ -1 jdx))
+			  (row '() (cons (array-ref matrix idx jdx) row)))
+			 ((< jdx (caadr shp)) row))
+		     rows)))
+	((< idx (caar shp)) rows))))
+(define (coerce-like-arg matrix arg)
+  (cond ((array? arg) (matrix2array matrix arg))
+	(else matrix)))
+
+;;@body
+;;Returns the list-of-lists form of @1.
+(define (matrix->lists matrix)
+  (cond ((array? matrix)
+	 (if (not (eqv? 2 (array-rank matrix)))
+	     (slib:error 'not 'matrix matrix))
+	 (matrix2lists matrix))
+	((and (pair? matrix) (list? (car matrix))) matrix)
+	((vector? matrix) (list (vector->list matrix)))
+	(else (slib:error 'not 'matrix matrix))))
+
+;;@body
+;;Returns the (ones-based) array form of @1.
+(define (matrix->array matrix)
+  (cond ((array? matrix)
+	 (if (not (eqv? 2 (array-rank matrix)))
+	     (slib:error 'not 'matrix matrix))
+	 matrix)
+	((and (pair? matrix) (list? (car matrix)))
+	 (matrix2array matrix '#()))
+	((vector? matrix) matrix)
+	(else (slib:error 'not 'matrix matrix))))
+
+(define (matrix:cofactor matrix i j)
+  (define mat (matrix->lists matrix))
   (define (butnth n lst)
-    (if (zero? n) (cdr lst) (cons (car lst) (butnth (+ -1 n) (cdr lst)))))
-  (define (minor m i j)
-    (map (lambda (x) (butnth j x)) (butnth i m)))
-  (define (cofactor m i j)
-    (* (if (odd? (+ i j)) -1 1) (determinant (minor m i j))))
-  (define n (length m))
-  (if (eqv? 1 n) (caar m)
-      (do ((j (+ -1 n) (+ -1 j))
-	   (ans 0 (+ ans (* (list-ref (car m) j) (cofactor m 0 j)))))
-	  ((negative? j) ans))))
+    (if (<= n 1) (cdr lst) (cons (car lst) (butnth (+ -1 n) (cdr lst)))))
+  (define (minor matrix i j)
+    (map (lambda (x) (butnth j x)) (butnth i mat)))
+  (coerce-like-arg
+   (* (if (odd? (+ i j)) -1 1) (determinant (minor mat i j)))
+   matrix))
+
+;;@body
+;;@1 must be a square matrix.
+;;@0 returns the determinant of @1.
+;;
+;;@example
+;;(require 'determinant)
+;;(determinant '((1 2) (3 4))) @result{} -2
+;;(determinant '((1 2 3) (4 5 6) (7 8 9))) @result{} 0
+;;@end example
+(define (determinant matrix)
+  (define mat (matrix->lists matrix))
+  (let ((n (length mat)))
+    (if (eqv? 1 n) (caar mat)
+	(do ((j n (+ -1 j))
+	     (ans 0 (+ ans (* (list-ref (car mat) (+ -1 j))
+			      (matrix:cofactor mat 1 j)))))
+	    ((<= j 0) ans)))))
+
+;;@body
+;;Returns a copy of @1 flipped over the diagonal containing the 1,1
+;;element.
+(define (transpose matrix)
+  (if (number? matrix)
+      matrix
+      (let ((mat (matrix->lists matrix)))
+	(coerce-like-arg (apply map list mat)
+			  matrix))))
+
+;;@body
+;;Returns the product of matrices @1 and @2.
+(define (matrix:product m1 m2)
+  (define mat1 (matrix->lists m1))
+  (define mat2 (matrix->lists m2))
+  (define (dot-product v1 v2) (apply + (map * v1 v2)))
+  (coerce-like-arg
+   (map (lambda (arow)
+	  (apply map
+		 (lambda bcol (dot-product bcol arow))
+		 mat2))
+	mat1)
+   m1))
+
+;;@body
+;;@1 must be a square matrix.
+;;If @1 is singlar, then @0 returns #f; otherwise @0 returns the
+;;@code{matrix:product} inverse of @1.
+(define (matrix:inverse matrix)
+  (let* ((mat (matrix->lists matrix))
+	 (det (determinant mat))
+	 (rank (length mat)))
+    (and (not (zero? det))
+	 (do ((i rank (+ -1 i))
+	      (inv '() (cons
+			(do ((j rank (+ -1 j))
+			     (row '()
+				  (cons (/ (matrix:cofactor mat j i) det) row)))
+			    ((<= j 0) row))
+			inv)))
+	     ((<= i 0)
+	      (coerce-like-arg inv matrix))))))
diff --git a/determ.txi b/determ.txi
new file mode 100644
index 0000000..30eef3d
--- /dev/null
+++ b/determ.txi
@@ -0,0 +1,47 @@
+@code{(require 'determinant)}
+@ftindex determinant
+
+@noindent
+A Matrix can be either a list of lists (rows) or an array.
+As with linear-algebra texts, this package uses 1-based coordinates.
+
+
+@defun matrix->lists matrix
+
+Returns the list-of-lists form of @var{matrix}.
+@end defun
+
+@defun matrix->array matrix
+
+Returns the (ones-based) array form of @var{matrix}.
+@end defun
+
+@defun determinant matrix
+
+@var{matrix} must be a square matrix.
+@code{determinant} returns the determinant of @var{matrix}.
+
+@example
+(require 'determinant)
+(determinant '((1 2) (3 4))) @result{} -2
+(determinant '((1 2 3) (4 5 6) (7 8 9))) @result{} 0
+@end example
+@end defun
+
+@defun transpose matrix
+
+Returns a copy of @var{matrix} flipped over the diagonal containing the 1,1
+element.
+@end defun
+
+@defun matrix:product m1 m2
+
+Returns the product of matrices @var{m1} and @var{m2}.
+@end defun
+
+@defun matrix:inverse matrix
+
+@var{matrix} must be a square matrix.
+If @var{matrix} is singlar, then @code{matrix:inverse} returns #f; otherwise @code{matrix:inverse} returns the
+@code{matrix:product} inverse of @var{matrix}.
+@end defun
diff --git a/differ.scm b/differ.scm
index 53e0eaf..23b0e91 100644
--- a/differ.scm
+++ b/differ.scm
@@ -1,5 +1,5 @@
 ;;;; "differ.scm" O(NP) Sequence Comparison Algorithm.
-;;; Copyright (C) 2001 Aubrey Jaffer
+;;; Copyright (C) 2001, 2002, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -18,7 +18,7 @@
 ;each case.
 
 ;;@noindent
-;;This package implements the algorithm:
+;;@code{diff:edit-length} implements the algorithm:
 ;;
 ;;@ifinfo
 ;;@example
@@ -37,186 +37,403 @@
 ;;@end ifset
 ;;
 ;;@noindent
-;;If the items being sequenced are text lines, then the computed
-;;edit-list is equivalent to the output of the @dfn{diff} utility
-;;program.  If the items being sequenced are words, then it is like the
-;;lesser known @dfn{spiff} program.
-;;
-;;@noindent
 ;;The values returned by @code{diff:edit-length} can be used to gauge
 ;;the degree of match between two sequences.
 ;;
 ;;@noindent
-;;I believe that this algorithm is currently the fastest for these
-;;tasks, but genome sequencing applications fuel extensive research in
-;;this area.
+;;Surprisingly, "An O(NP) Sequence Comparison Algorithm" does not
+;;derive the edit sequence; only the sequence length.  Developing this
+;;linear-space sub-quadratic-time algorithm for computing the edit
+;;sequence required hundreds of hours of work.  I have submitted a
+;;paper describing the algorithm to the Journal of Computational
+;;Biology.
+;;
+;;@noindent
+;;If the items being sequenced are text lines, then the computed
+;;edit-list is equivalent to the output of the @dfn{diff} utility
+;;program.  If the items being sequenced are words, then it is like the
+;;lesser known @dfn{spiff} program.
 
 (require 'array)
+(require 'sort)
 
-(define (fp:compare fp Delta snake len2)
+;;; p-lim is half the number of gratuitous edits for strings of given
+;;; lengths.
+;;; When passed #f CC, fp:compare returns edit-distance if successful;
+;;; #f otherwise (p > p-lim).  When passed CC, fp:compare returns #f.
+(define (fp:compare fp CC A M B N =? p-lim)
+  (define Delta (- N M))
+  ;;(if (negative? Delta) (slib:error 'fp:compare (fp:subarray A 0 M) '> (fp:subarray B 0 N)))
+  ;;(set! compares (+ 1 compares))  ;(print 'fp:compare M N p-lim)
   (let loop ((p 0))
     (do ((k (- p) (+ 1 k)))
-	((> k (+ -1 Delta)))
-      (array-set! fp (snake k (max (+ 1 (array-ref fp (+ -1 k)))
-				   (array-ref fp (+ 1 k))))
-		  k))
+	((>= k Delta))
+      (fp:run fp k A M B N =? CC p))
     (do ((k (+ Delta p) (+ -1 k)))
-	((< k (+ 1 Delta)))
-      (array-set! fp (snake k (max (+ 1 (array-ref fp (+ -1 k)))
-				   (array-ref fp (+ 1 k))))
-		  k))
-    (array-set! fp (snake Delta (max (+ 1 (array-ref fp (+ -1 Delta)))
-				     (array-ref fp (+ 1 Delta))))
-		Delta)
-    (if (= (array-ref fp Delta) len2)
-	(+ Delta (* 2 p))
-	(loop (+ 1 p)))))
-
-(define (fp->edits fp Delta)
-  (let loop ((idx (+ -1 Delta))
-	     (ddx (+ 1 Delta))
-	     (edits '()))
-    (define ivl (array-ref fp idx))
-    (define dvl (array-ref fp ddx))
-    (if (not (= -1 dvl)) (set! dvl (- dvl ddx)))
-    ;;(print idx '-> ivl ddx '-> dvl)
-    (cond ((= ivl -1) edits)
-	  ((= dvl -1) (loop (+ -1 idx) ddx (cons (list ivl 'insert) edits)))
-	  ((> dvl ivl) (loop idx (+ 1 ddx) (cons (list dvl 'delete) edits)))
-	  (else       (loop (+ -1 idx) ddx (cons (list ivl 'insert) edits))))))
-
-(define (fp->lcs fp Delta array1 len)
-  (define len1 (car (array-dimensions array1)))
-  (define lcs (make-array #f len))
-  (define (subarray-copy! array1 start1 end1 array2 start2)
-    (do ((i start1 (+ i 1))
-	 (j start2 (+ j 1))
-	 (l (- end1 start1) (- l 1)))
-	((<= l 0))
-      (array-set! array2 (array-ref array1 i) j)))
-  (let loop ((ddx (+ 1 Delta))
-	     (pos len1)
-	     (dpos len))
-    (let* ((dvl (array-ref fp ddx))
-	   (sublen (- pos (- dvl ddx -1))))
-      (cond ((= dvl -1)
-	     (subarray-copy! array1 0 pos lcs 0)
-	     lcs)
+	((<= k Delta))
+      (fp:run fp k A M B N =? CC p))
+    (let ((fpval (fp:run fp Delta A M B N =? CC p)))
+      ;; At this point, the cost to (fpval-Delta, fpval) is Delta + 2*p
+      (cond ((and (not CC) (<= N fpval)) (+ Delta (* 2 p)))
+	    ((and (not (negative? p-lim)) (>= p p-lim)) #f)
+	    (else (loop (+ 1 p)))))))
+
+;;; Traces runs of matches until they end; then set fp[k]=y.
+;;; If CC is supplied, set each CC[y] = min(CC[y], cost) for run.
+;;; Returns furthest y reached.
+(define (fp:run fp k A M B N =? CC p)
+  (define y (max (+ 1 (array-ref fp (+ -1 k))) (array-ref fp (+ 1 k))))
+  (define cost (+ k p p))
+  (let snloop ((x (- y k))
+	       (y y))
+    (and CC (<= y N)
+	 (let ((xcst (- M x)))
+	   (cond ((negative? xcst))
+		 (else (array-set! CC
+				   (min (+ xcst cost) (array-ref CC y))
+				   y)))))
+    ;;(set! tick (+ 1 tick))
+    (cond ((and (< x M) (< y N)
+		(=? (array-ref A x) (array-ref B y)))
+	   (snloop (+ 1 x) (+ 1 y)))
+	  (else (array-set! fp y k)
+		y))))
+
+;;; Check that only 1 and -1 steps between adjacent CC entries.
+;;(define (fp:step-check A M B N CC)
+;;  (do ((cdx (+ -1 N) (+ -1 cdx)))
+;;      ((negative? cdx))
+;;    (case (- (array-ref CC cdx) (array-ref CC (+ 1 cdx)))
+;;      ((1 -1) #t)
+;;      (else (cond ((> 30 (car (array-dimensions CC)))
+;;		   (display "A: ") (print A)
+;;		   (display "B: ") (print B)))
+;;	    (slib:warn
+;;	     "CC" (append (list (max 0 (+ -5 cdx)) ': (min (+ 1 N) (+ 5 cdx))
+;;				'of)
+;;			  (array-dimensions CC))
+;;	     (fp:subarray CC (max 0 (+ -5 cdx)) (min (+ 1 N) (+ 5 cdx))))))))
+
+;;; Correct cost jumps left by fp:compare [which visits only a few (x,y)].
+;;(define (smooth-costs CC N)
+;;  (do ((cdx (+ -1 N) (+ -1 cdx)))	; smooth from end
+;;      ((negative? cdx))
+;;    (array-set! CC (min (array-ref CC cdx) (+ 1 (array-ref CC (+ 1 cdx))))
+;;		cdx))
+;;  (do ((cdx 1 (+ 1 cdx)))		; smooth toward end
+;;      ((> cdx N))
+;;    (array-set! CC (min (array-ref CC cdx) (+ 1 (array-ref CC (+ -1 cdx))))
+;;		cdx))
+;;  CC)
+
+(define (diff:mid-split M N RR CC cost)
+  (define b-splt N)			;Default
+  (define bestrun 0)
+  (define thisrun 0)
+  ;; RR is not longer than CC.  So do for each element of RR.
+  (let loop ((cdx (+ 1 (quotient N 2)))
+	     (rdx (quotient N 2)))
+    ;;(if (negative? rdx) (slib:error 'negative? 'rdx))
+    (cond ((eqv? cost (+ (array-ref CC rdx) (array-ref RR (- N rdx)))) rdx)
+	  ((eqv? cost (+ (array-ref CC cdx) (array-ref RR (- N cdx)))) cdx)
+	  (else (loop (+ 1 cdx) (+ -1 rdx))))))
+
+;;; Return 0-based shared array.
+;;; Reverse RA if END < START.
+(define (fp:subarray RA start end)
+  (define n-len (abs (- end start)))
+  (if (< end start)
+      (make-shared-array RA (lambda (idx) (list (- start 1 idx))) n-len)
+      (make-shared-array RA (lambda (idx) (list (+ start idx))) n-len)))
+
+(define (fp:init! fp fill mindx maxdx)
+  (do ((idx maxdx (+ -1 idx)))
+      ((< idx mindx))
+    (array-set! fp fill idx)))
+
+;;; Split A[start-a..end-a] (shorter array) into smaller and smaller chunks.
+;;; EDX is index into EDITS.
+;;; EPO is insert/delete polarity (+1 or -1)
+(define (diff:divide-and-conquer fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim)
+  (define mid-a (quotient (+ start-a end-a) 2))
+  (define len-b (- end-b start-b))
+  (define len-a (- end-a start-a))
+  (let ((tcst (+ p-lim p-lim (- len-b len-a))))
+    (define CC (fp:subarray CCRR 0 (+ len-b 1)))
+    (define RR (fp:subarray CCRR (+ len-b 1) (* 2 (+ len-b 1))))
+    (define M2 (- end-a mid-a))
+    (define M1 (- mid-a start-a))
+    (fp:init! CC (+ len-a len-b) 0 len-b)
+    (fp:init! fp -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M1)))
+    (fp:compare fp CC
+		(fp:subarray A start-a mid-a) M1
+		(fp:subarray B start-b end-b) len-b =? (min p-lim len-a))
+    (fp:init! RR (+ len-a len-b) 0 len-b)
+    (fp:init! fp -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M2)))
+    (fp:compare fp RR
+		(fp:subarray A end-a mid-a)   M2
+		(fp:subarray B end-b start-b) len-b =? (min p-lim len-a))
+    ;;(smooth-costs CC len-b) (smooth-costs RR len-b)
+    (let ((b-splt (diff:mid-split len-a len-b RR CC tcst)))
+      (define est-c (array-ref CC b-splt))
+      (define est-r (array-ref RR (- len-b b-splt)))
+      ;;(set! splts (cons (/ b-splt (max .1 len-b)) splts))
+      ;;(display "A: ") (array-for-each display (fp:subarray A start-a mid-a)) (display " + ") (array-for-each display (fp:subarray A mid-a end-a)) (newline)
+      ;;(display "B: ") (array-for-each display (fp:subarray B start-b end-b)) (newline)
+      ;;(print 'cc cc) (print 'rr (fp:subarray RR (+ 1 len-b) 0))
+      ;;(print (make-string (+ 7 (* 2 b-splt)) #\-) '^  (list b-splt))
+      (check-cost! 'CC est-c
+		  (diff2et fp CCRR
+			   A start-a mid-a
+			   B start-b (+ start-b b-splt)
+			   edits edx epo =?
+			   (quotient (- est-c (- b-splt (- mid-a start-a)))
+				     2)))
+      (check-cost! 'RR est-r
+		  (diff2et fp CCRR
+			   A mid-a end-a
+			   B (+ start-b b-splt) end-b
+			   edits (+ est-c edx) epo =?
+			   (quotient (- est-r (- (- len-b b-splt)
+						 (- end-a mid-a)))
+				     2)))
+      (+ est-c est-r))))
+
+;;; Trim; then diff sub-arrays; either one longer.  Returns edit-length
+(define (diff2et fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim)
+  ;;  (if (< (- end-a start-a) p-lim) (slib:warn 'diff2et 'len-a (- end-a start-a) 'len-b (- end-b start-b) 'p-lim p-lim))
+  (do ((bdx (+ -1 end-b) (+ -1 bdx))
+       (adx (+ -1 end-a) (+ -1 adx)))
+      ((not (and (<= start-b bdx)
+		 (<= start-a adx)
+		 (=? (array-ref A adx) (array-ref B bdx))))
+       (do ((bsx start-b (+ 1 bsx))
+	    (asx start-a (+ 1 asx)))
+	   ((not (and (< bsx bdx)
+		      (< asx adx)
+		      (=? (array-ref A asx) (array-ref B bsx))))
+	    ;;(print 'trim-et (- asx start-a) '+ (- end-a adx))
+	    (let ((delta (- (- bdx bsx) (- adx asx))))
+	      (if (negative? delta)
+		  (diff2ez fp CCRR B bsx (+ 1 bdx) A asx (+ 1 adx)
+			   edits edx (- epo) =? (+ delta p-lim))
+		  (diff2ez fp CCRR A asx (+ 1 adx) B bsx (+ 1 bdx)
+			   edits edx epo =? p-lim))))
+	 ;;(set! tick (+ 1 tick))
+	 ))
+    ;;(set! tick (+ 1 tick))
+    ))
+
+;;; Diff sub-arrays, A not longer than B.  Returns edit-length
+(define (diff2ez fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim)
+  (define len-a (- end-a start-a))
+  (define len-b (- end-b start-b))
+  ;;(if (> len-a len-b) (slib:error 'diff2ez len-a '> len-b))
+  (cond ((zero? p-lim)			; B inserts only
+	 (if (= len-b len-a)
+	     0				; A = B; no edits
+	     (let loop ((adx start-a)
+			(bdx start-b)
+			(edx edx))
+	       (cond ((>= bdx end-b) (- len-b len-a))
+		     ((>= adx end-a)
+		      (do ((idx bdx (+ 1 idx))
+			   (edx edx (+ 1 edx)))
+			  ((>= idx end-b) (- len-b len-a))
+			(array-set! edits (* epo (+ 1 idx)) edx)))
+		     ((=? (array-ref A adx) (array-ref B bdx))
+		      ;;(set! tick (+ 1 tick))
+		      (loop (+ 1 adx) (+ 1 bdx) edx))
+		     (else (array-set! edits (* epo (+ 1 bdx)) edx)
+			   ;;(set! tick (+ 1 tick))
+			   (loop adx (+ 1 bdx) (+ 1 edx)))))))
+	((<= len-a p-lim)		; delete all A; insert all B
+	 ;;(if (< len-a p-lim) (slib:error 'diff2ez len-a len-b 'p-lim p-lim))
+	 (do ((idx start-a (+ 1 idx))
+	      (edx edx (+ 1 edx)))
+	     ((>= idx end-a)
+	      (do ((jdx start-b (+ 1 jdx))
+		   (edx edx (+ 1 edx)))
+		  ((>= jdx end-b))
+		(array-set! edits (* epo (+ 1 jdx)) edx)))
+	   (array-set! edits (* epo (- -1 idx)) edx))
+	 (+ len-a len-b))
+	(else (diff:divide-and-conquer
+	       fp CCRR A start-a end-a B start-b end-b
+	       edits edx epo =? p-lim))))
+
+;;;Return new vector of edits in correct sequence
+(define (diff:order-edits edits cost sign)
+  (if (negative? sign)
+      (do ((idx (+ -1 cost) (+ -1 idx)))
+	  ((negative? idx))
+	(array-set! edits (- (array-ref edits idx)) idx)))
+  (if (zero? cost)
+      edits
+      (let ((sedits (sort! edits <))
+	    (nedits (create-array (As32) cost)))
+	;; Find -/+ boundary
+	(define len-a (max 0 (- (array-ref sedits 0))))
+	(define len-b (array-ref sedits (+ -1 cost)))
+	(do ((idx 0 (+ 1 idx)))
+	    ((or (>= idx cost) (positive? (array-ref sedits idx)))
+	     (let loop ((ddx (+ -1 idx))
+			(idx idx)
+			(ndx 0)
+			(adx 0)
+			(bdx 0))
+	       (define del (if (negative? ddx) 0 (array-ref sedits ddx)))
+	       (define ins (if (>= idx cost) 0 (array-ref sedits idx)))
+	       (cond ((and (>= bdx len-b) (>= adx len-a)) nedits)
+		     ((and (negative? del) (>= adx (- -1 del))
+			   (positive? ins) (>= bdx (+ -1 ins)))
+		      (array-set! nedits del ndx)
+		      (array-set! nedits ins (+ 1 ndx))
+		      (loop (+ -1 ddx) (+ 1 idx) (+ 2 ndx)
+			    (+ 1 adx) (+ 1 bdx)))
+		     ((and (negative? del) (>= adx (- -1 del)))
+		      (array-set! nedits del ndx)
+		      (loop (+ -1 ddx) idx (+ 1 ndx) (+ 1 adx) bdx))
+		     ((and (positive? ins) (>= bdx (+ -1 ins)))
+		      (array-set! nedits ins ndx)
+		      (loop ddx (+ 1 idx)  (+ 1 ndx) adx (+ 1 bdx)))
+		     (else
+		      (loop ddx idx ndx (+ 1 adx) (+ 1 bdx))))))))))
+
+;;; len-a < len-b
+(define (edits2lcs lcs edits cost A len-a len-b)
+  (let loop ((edx 0)
+	     (sdx 0)
+	     (adx 0))
+    (let ((edit (if (< edx cost)
+		    (array-ref edits edx)
+		    0)))
+      (cond ((>= adx len-a) lcs)
+	    ((positive? edit)
+	     (loop (+ 1 edx) sdx adx))
+	    ((zero? edit)
+	     (array-set! lcs (array-ref A adx) sdx)
+	     (loop edx (+ 1 sdx) (+ 1 adx)))
+	    ((>= adx (- -1 edit))
+	     (loop (+ 1 edx) sdx (+ 1 adx)))
 	    (else
-	     (subarray-copy! array1 (- dvl ddx -1) pos lcs (- dpos sublen))
-	     (loop (+ 1 ddx) (- dvl ddx) (- dpos sublen)))))))
+	     (array-set! lcs (array-ref A adx) sdx)
+	     (loop edx (+ 1 sdx) (+ 1 adx)))))))
+
+;; A not longer than B (M <= N)
+(define (diff2edits A M B N =? p-lim)
+  (define maxdx (if (negative? p-lim) (+ 2 N) (+ 1 p-lim (- N M))))
+  (define mindx (if (negative? p-lim) (- (+ 1 M)) (- (+ 1 p-lim))))
+  ;;(if (> M N) (slib:error 'diff2edits M '> N))
+  (let ((fp (create-array (As32) (list mindx maxdx)))
+	(CCRR (create-array (As32) (* 2 (+ N 1)))))
+    (fp:init! fp -1 mindx maxdx)
+    (let ((est (fp:compare fp #f A M B N =? p-lim)))
+      (and est
+	   (let ((edits (create-array (As32) est)))
+	     (check-cost! 'diff2edits
+			 est
+			 (diff2et fp CCRR A 0 M B 0 N edits 0 1 =?
+				  (quotient (- est (- N M)) 2)))
+	     edits)))))
 
+;; A not longer than B (M <= N)
+(define (diff2editlen A M B N =? p-lim)
+  (define maxdx (if (negative? p-lim) (+ 1 N) (+ 1 p-lim (- N M))))
+  (define mindx (if (negative? p-lim) (- (+ 1 M)) (- (+ 1 p-lim))))
+  (let ((fp (create-array (As32) (list mindx maxdx))))
+    (fp:init! fp -1 mindx maxdx)
+    (fp:compare fp #f A M B N =? p-lim)))
+
+(define (check-cost! name est cost)
+  (if (not (eqv? est cost))
+      (slib:warn "%s: cost check failed %d != %d\\n" name est cost)))
+
+;;@args array1 array2 =? p-lim
 ;;@args array1 array2 =?
-;;@args array1 array2
 ;;@1 and @2 are one-dimensional arrays.  The procedure @3 is used
-;;to compare sequence tokens for equality.  @3 defaults to @code{eqv?}.
+;;to compare sequence tokens for equality.
+;;
+;;The non-negative integer @4, if provided, is maximum number of
+;;deletions of the shorter sequence to allow.  @0 will return @code{#f}
+;;if more deletions would be necessary.
+;;
 ;;@0 returns a one-dimensional array of length @code{(quotient (- (+
-;;len1 len2) (fp:edit-length @1 @2)) 2)} holding the longest sequence
+;;len1 len2) (diff:edit-length @1 @2)) 2)} holding the longest sequence
 ;;common to both @var{array}s.
-(define (diff:longest-common-subsequence array1 array2 . =?)
-  (define len1 (car (array-dimensions array1)))
-  (define len2 (car (array-dimensions array2)))
-  (define (snake k y)
-    (let snloop ((x (- y k))
-		 (y y))
-      (if (and (< x len1) (< y len2) (=? (array-ref array1 x)
-					 (array-ref array2 y)))
-	  (snloop (+ 1 x) (+ 1 y))
-	  y)))
-  (set! =? (if (null? =?) eqv? (car =?)))
-  (if (> len1 len2)
-      (diff:longest-common-subsequence array2 array1)
-      (let ((Delta (- len2 len1))
-	    (fp (make-array -1 (list (- (+ 1 len1)) (+ 1 len2)))))
-	(fp->lcs fp Delta array1
-		 (quotient (- (+ len1 len2) (fp:compare fp Delta snake len2))
-			   2)))))
+(define (diff:longest-common-subsequence A B =? . p-lim)
+  (define len-a (car (array-dimensions a)))
+  (define len-b (car (array-dimensions b)))
+  (set! p-lim (if (null? p-lim) -1 (car p-lim)))
+  (let ((edits (if (< len-b len-a)
+		   (diff2edits B len-b A len-a =? p-lim)
+		   (diff2edits A len-a B len-b =? p-lim))))
+    (and edits
+	 (let* ((cost (car (array-dimensions edits)))
+		(sedit (diff:order-edits edits cost (if (< len-b len-a) -1 1)))
+		(lcs (create-array A (/ (- (+ len-b len-a) cost) 2))))
+	   (if (< len-b len-a)
+	       (edits2lcs lcs sedit cost B len-b len-a)
+	       (edits2lcs lcs sedit cost A len-a len-b))))))
 
+;;@args array1 array2 =? p-lim
 ;;@args array1 array2 =?
-;;@args array1 array2
 ;;@1 and @2 are one-dimensional arrays.  The procedure @3 is used
-;;to compare sequence tokens for equality.  @3 defaults to @code{eqv?}.
-;;@0 returns a list of length @code{(fp:edit-length @1 @2)} composed of
-;;a shortest sequence of edits transformaing @1 to @2.
+;;to compare sequence tokens for equality.
 ;;
-;;Each edit is a list of an integer and a symbol:
+;;The non-negative integer @4, if provided, is maximum number of
+;;deletions of the shorter sequence to allow.  @0 will return @code{#f}
+;;if more deletions would be necessary.
+;;
+;;@0 returns a vector of length @code{(diff:edit-length @1 @2)} composed
+;;of a shortest sequence of edits transformaing @1 to @2.
+;;
+;;Each edit is an integer:
 ;;@table @asis
-;;@item (@var{j} insert)
-;;Inserts @code{(array-ref @1 @var{j})} into the sequence.
-;;@item (@var{k} delete)
-;;Deletes @code{(array-ref @2 @var{k})} from the sequence.
+;;@item @var{k} > 0
+;;Inserts @code{(array-ref @1 (+ -1 @var{j}))} into the sequence.
+;;@item @var{k} < 0
+;;Deletes @code{(array-ref @2 (- -1 @var{k}))} from the sequence.
 ;;@end table
-(define (diff:edits array1 array2 . =?)
-  (define len1 (car (array-dimensions array1)))
-  (define len2 (car (array-dimensions array2)))
-  (define (snake k y)
-    (let snloop ((x (- y k))
-		 (y y))
-      (if (and (< x len1) (< y len2) (=? (array-ref array1 x)
-					 (array-ref array2 y)))
-	  (snloop (+ 1 x) (+ 1 y)) y)))
-  (set! =? (if (null? =?) eqv? (car =?)))
-  (if (> len1 len2)
-      (diff:reverse-edits (diff:edits array2 array1))
-      (let ((Delta (- len2 len1))
-	    (fp (make-array -1 (list (- (+ 1 len1)) (+ 1 len2)))))
-	(fp:compare fp Delta snake len2)
-	;;(do ((idx (- -1 len1) (+ 1 idx))) ((>= idx (+ 1 len2)) (newline)) (printf "%3d" idx))
-	;;(do ((idx (- -1 len1) (+ 1 idx))) ((>= idx (+ 1 len2)) (newline)) (printf "%3d" (array-ref fp idx)))
-	(fp->edits fp Delta))))
-
-(define (diff:reverse-edits edits)
-  (map (lambda (edit)
-	 (list (car edit)
-	       (case (cadr edit)
-		 ((delete) 'insert)
-		 ((insert) 'delete))))
-       edits))
+(define (diff:edits A B =? . p-lim)
+  (define len-a (car (array-dimensions a)))
+  (define len-b (car (array-dimensions b)))
+  (set! p-lim (if (null? p-lim) -1 (car p-lim)))
+  (let ((edits (if (< len-b len-a)
+		   (diff2edits B len-b A len-a =? p-lim)
+		   (diff2edits A len-a B len-b =? p-lim))))
+    (and edits (diff:order-edits edits (car (array-dimensions edits))
+				 (if (< len-b len-a) -1 1)))))
 
+;;@args array1 array2 =? p-lim
 ;;@args array1 array2 =?
-;;@args array1 array2
 ;;@1 and @2 are one-dimensional arrays.  The procedure @3 is used
-;;to compare sequence tokens for equality.  @3 defaults to @code{eqv?}.
+;;to compare sequence tokens for equality.
+;;
+;;The non-negative integer @4, if provided, is maximum number of
+;;deletions of the shorter sequence to allow.  @0 will return @code{#f}
+;;if more deletions would be necessary.
+;;
 ;;@0 returns the length of the shortest sequence of edits transformaing
 ;;@1 to @2.
-(define (diff:edit-length array1 array2 . =?)
-  (define len1 (car (array-dimensions array1)))
-  (define len2 (car (array-dimensions array2)))
-  (define (snake k y)
-    (let snloop ((x (- y k))
-		 (y y))
-      (if (and (< x len1) (< y len2) (=? (array-ref array1 x)
-					 (array-ref array2 y)))
-	  (snloop (+ 1 x) (+ 1 y))
-	  y)))
-  (set! =? (if (null? =?) eqv? (car =?)))
-  (if (> len1 len2)
-      (diff:edit-length array2 array1)
-      (let ((Delta (- len2 len1))
-	    (fp (make-array -1 (list (- (+ 1 len1)) (+ 1 len2)))))
-	(fp:compare fp Delta snake len2))))
+(define (diff:edit-length A B =? . p-lim)
+  (define M (car (array-dimensions a)))
+  (define N (car (array-dimensions b)))
+  (set! p-lim (if (null? p-lim) -1 (car p-lim)))
+  (if (< N M)
+      (diff2editlen B N A M =? p-lim)
+      (diff2editlen A M B N =? p-lim)))
 
 ;;@example
-;;(diff:longest-common-subsequence '#(f g h i e j c k l m)
-;;                                 '#(f g e h i j k p q r l m))
-;;                                 @result{} #(f g h i j k l m)
+;;(diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm" eqv?)
+;;@result{} "fghijklm"
 ;;
-;;(diff:edit-length '#(f g h i e j c k l m)
-;;                  '#(f g e h i j k p q r l m))
+;;(diff:edit-length "fghiejcklm" "fgehijkpqrlm" eqv?)
 ;;@result{} 6
 ;;
-;;(pretty-print (diff:edits '#(f g h i e j c k l m)
-;;                          '#(f g e h i j k p q r l m)))
-;;@print{}
-;;((3 insert)                           ; e
-;; (4 delete)                           ; c
-;; (6 delete)                           ; h
-;; (7 insert)                           ; p
-;; (8 insert)                           ; q
-;; (9 insert))                          ; r
+;;(diff:edits "fghiejcklm" "fgehijkpqrlm" eqv?)
+;;@result{} #As32(3 -5 -7 8 9 10)
+;;       ; e  c  h p q  r
 ;;@end example
 
-;; 12 - 10 = 2
-;; -11-10 -9 -8 -7 -6 -5 -4 -3 -2 -1  0  1  2  3  4  5  6  7  8  9 10 11 12
-;;  -1 -1 -1 -1 -1 -1 -1 -1 -1  3  7  8  9 12  9  8 -1 -1 -1 -1 -1 -1 -1 -1
-;; edit-distance = 6
+;;(trace-all "/home/jaffer/slib/differ.scm")(set! *qp-width* 333)(untrace fp:run fp:subarray)
diff --git a/differ.txi b/differ.txi
index f7b1f75..c46fc2a 100644
--- a/differ.txi
+++ b/differ.txi
@@ -1,5 +1,5 @@
 @noindent
-This package implements the algorithm:
+@code{diff:edit-length} implements the algorithm:
 
 @ifinfo
 @example
@@ -18,6 +18,18 @@ Information Processing Letters 35, 6 (1990), 317-323.
 @end ifset
 
 @noindent
+The values returned by @code{diff:edit-length} can be used to gauge
+the degree of match between two sequences.
+
+@noindent
+Surprisingly, "An O(NP) Sequence Comparison Algorithm" does not
+derive the edit sequence; only the sequence length.  Developing this
+linear-space sub-quadratic-time algorithm for computing the edit
+sequence required hundreds of hours of work.  I have submitted a
+paper describing the algorithm to the Journal of Computational
+Biology.
+
+@noindent
 If the items being sequenced are text lines, then the computed
 edit-list is equivalent to the output of the @dfn{diff} utility
 @cindex diff
@@ -25,71 +37,69 @@ program.  If the items being sequenced are words, then it is like the
 lesser known @dfn{spiff} program.
 @cindex spiff
 
-@noindent
-The values returned by @code{diff:edit-length} can be used to gauge
-the degree of match between two sequences.
 
-@noindent
-I believe that this algorithm is currently the fastest for these
-tasks, but genome sequencing applications fuel extensive research in
-this area.
+@defun diff:longest-common-subsequence array1 array2 =? p-lim
 
 
-@defun diff:longest-common-subsequence array1 array2 =?
+@defunx diff:longest-common-subsequence array1 array2 =?
+@var{array1} and @var{array2} are one-dimensional arrays.  The procedure @var{=?} is used
+to compare sequence tokens for equality.
 
+The non-negative integer @var{p-lim}, if provided, is maximum number of
+deletions of the shorter sequence to allow.  @code{diff:longest-common-subsequence} will return @code{#f}
+if more deletions would be necessary.
 
-@defunx diff:longest-common-subsequence array1 array2
-@var{array1} and @var{array2} are one-dimensional arrays.  The procedure @var{=?} is used
-to compare sequence tokens for equality.  @var{=?} defaults to @code{eqv?}.
 @code{diff:longest-common-subsequence} returns a one-dimensional array of length @code{(quotient (- (+
-len1 len2) (fp:edit-length @var{array1} @var{array2})) 2)} holding the longest sequence
+len1 len2) (diff:edit-length @var{array1} @var{array2})) 2)} holding the longest sequence
 common to both @var{array}s.
 @end defun
 
-@defun diff:edits array1 array2 =?
+@defun diff:edits array1 array2 =? p-lim
 
 
-@defunx diff:edits array1 array2
+@defunx diff:edits array1 array2 =?
 @var{array1} and @var{array2} are one-dimensional arrays.  The procedure @var{=?} is used
-to compare sequence tokens for equality.  @var{=?} defaults to @code{eqv?}.
-@code{diff:edits} returns a list of length @code{(fp:edit-length @var{array1} @var{array2})} composed of
-a shortest sequence of edits transformaing @var{array1} to @var{array2}.
+to compare sequence tokens for equality.
 
-Each edit is a list of an integer and a symbol:
+The non-negative integer @var{p-lim}, if provided, is maximum number of
+deletions of the shorter sequence to allow.  @code{diff:edits} will return @code{#f}
+if more deletions would be necessary.
+
+@code{diff:edits} returns a vector of length @code{(diff:edit-length @var{array1} @var{array2})} composed
+of a shortest sequence of edits transformaing @var{array1} to @var{array2}.
+
+Each edit is an integer:
 @table @asis
-@item (@var{j} insert)
-Inserts @code{(array-ref @var{array1} @var{j})} into the sequence.
-@item (@var{k} delete)
-Deletes @code{(array-ref @var{array2} @var{k})} from the sequence.
+@item @var{k} > 0
+Inserts @code{(array-ref @var{array1} (+ -1 @var{j}))} into the sequence.
+@item @var{k} < 0
+Deletes @code{(array-ref @var{array2} (- -1 @var{k}))} from the sequence.
 @end table
 @end defun
 
-@defun diff:edit-length array1 array2 =?
+@defun diff:edit-length array1 array2 =? p-lim
 
 
-@defunx diff:edit-length array1 array2
+@defunx diff:edit-length array1 array2 =?
 @var{array1} and @var{array2} are one-dimensional arrays.  The procedure @var{=?} is used
-to compare sequence tokens for equality.  @var{=?} defaults to @code{eqv?}.
+to compare sequence tokens for equality.
+
+The non-negative integer @var{p-lim}, if provided, is maximum number of
+deletions of the shorter sequence to allow.  @code{diff:edit-length} will return @code{#f}
+if more deletions would be necessary.
+
 @code{diff:edit-length} returns the length of the shortest sequence of edits transformaing
 @var{array1} to @var{array2}.
 @end defun
 @example
-(diff:longest-common-subsequence '#(f g h i e j c k l m)
-                                 '#(f g e h i j k p q r l m))
-                                 @result{} #(f g h i j k l m)
+(diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm" eqv?)
+@result{} "fghijklm"
 
-(diff:edit-length '#(f g h i e j c k l m)
-                  '#(f g e h i j k p q r l m))
+(diff:edit-length "fghiejcklm" "fgehijkpqrlm" eqv?)
 @result{} 6
 
-(pretty-print (diff:edits '#(f g h i e j c k l m)
-                          '#(f g e h i j k p q r l m)))
-@print{}
-((3 insert)                           ; e
- (4 delete)                           ; c
- (6 delete)                           ; h
- (7 insert)                           ; p
- (8 insert)                           ; q
- (9 insert))                          ; r
+(diff:edits "fghiejcklm" "fgehijkpqrlm" eqv?)
+@result{} #As32(3 -5 -7 8 9 10)
+       ; e  c  h p q  r
 @end example
 
diff --git a/dirs.scm b/dirs.scm
new file mode 100644
index 0000000..0592021
--- /dev/null
+++ b/dirs.scm
@@ -0,0 +1,98 @@
+;;; "dirs.scm" Directories.
+; Copyright 1998, 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'filename)
+(require 'line-i/o)
+(require 'system)
+(require 'glob)
+
+;;@code{(require 'directory)}
+;;@ftindex directory
+
+;;@args
+;;@0 returns a string containing the absolute file
+;;name representing the current working directory.  If this string
+;;cannot be obtained, #f is returned.
+;;
+;;If @0 cannot be supported by the platform, then #f is returned.
+(define current-directory
+  (case (software-type)
+    ;;((AMIGA)				)
+    ;;((MACOS THINKC)			)
+    ((MS-DOS WINDOWS ATARIST OS/2) (lambda () (system->line "cd")))
+    ;;((NOSVE)				)
+    ((UNIX COHERENT PLAN9) (lambda () (system->line "pwd")))
+    ;;((VMS)				)
+    (else #f)))
+
+;;@body
+;;Creates a sub-directory @1 of the current-directory.  If
+;;successful, @0 returns #t; otherwise #f.
+(define (make-directory name)
+  (eqv? 0 (system (string-append "mkdir \"" name "\""))))
+
+(define (dir:lister dirname tmp)
+  (case (software-type)
+    ((UNIX COHERENT PLAN9)
+     (zero? (system (string-append "ls '" dirname "' > " tmp))))
+    ((MS-DOS WINDOWS OS/2 ATARIST)
+     (zero? (system (string-append "DIR /B \"" dirname "\" > " tmp))))
+    (else (slib:error (software-type) 'list?))))
+
+;;@args proc directory
+;;@var{proc} must be a procedure taking one argument.
+;;@samp{Directory-For-Each} applies @var{proc} to the (string) name of
+;;each file in @var{directory}.  The dynamic order in which @var{proc} is
+;;applied to the filenames is unspecified.  The value returned by
+;;@samp{directory-for-each} is unspecified.
+;;
+;;@args proc directory pred
+;;Applies @var{proc} only to those filenames for which the procedure
+;;@var{pred} returns a non-false value.
+;;
+;;@args proc directory match
+;;Applies @var{proc} only to those filenames for which
+;;@code{(filename:match?? @var{match})} would return a non-false value
+;;(@pxref{Filenames, , , slib, SLIB}).
+;;
+;;@example
+;;(require 'directory)
+;;(directory-for-each print "." "[A-Z]*.scm")
+;;@print{}
+;;"Bev2slib.scm"
+;;"Template.scm"
+;;@end example
+(define (directory-for-each proc dirname . args)
+  (define selector
+    (cond ((null? args) identity)
+	  ((> (length args) 1)
+	   (slib:error 'directory-for-each 'too-many-arguments (cdr args)))
+	  ((procedure? (car args)) (car args))
+	  ((string? (car args)) (filename:match?? (car args)))
+	  (else
+	   (slib:error 'directory-for-each 'filter? (car args)))))
+  (call-with-tmpnam
+   (lambda (tmp)
+     (and (dir:lister dirname tmp)
+	  (file-exists? tmp)
+	  (call-with-input-file tmp
+	    (lambda (port)
+	      (do ((filename (read-line port) (read-line port)))
+		  ((or (eof-object? filename) (equal? "" filename)))
+		(and (selector filename) (proc filename)))))))))
diff --git a/dirs.txi b/dirs.txi
new file mode 100644
index 0000000..65d8b24
--- /dev/null
+++ b/dirs.txi
@@ -0,0 +1,46 @@
+@code{(require 'directory)}
+@ftindex directory
+
+
+@defun current-directory
+
+@code{current-directory} returns a string containing the absolute file
+name representing the current working directory.  If this string
+cannot be obtained, #f is returned.
+
+If @code{current-directory} cannot be supported by the platform, then #f is returned.
+@end defun
+
+@defun make-directory name
+
+Creates a sub-directory @var{name} of the current-directory.  If
+successful, @code{make-directory} returns #t; otherwise #f.
+@end defun
+
+@defun directory-for-each proc directory
+
+@var{proc} must be a procedure taking one argument.
+@samp{Directory-For-Each} applies @var{proc} to the (string) name of
+each file in @var{directory}.  The dynamic order in which @var{proc} is
+applied to the filenames is unspecified.  The value returned by
+@samp{directory-for-each} is unspecified.
+
+
+@defunx directory-for-each proc directory pred
+Applies @var{proc} only to those filenames for which the procedure
+@var{pred} returns a non-false value.
+
+
+@defunx directory-for-each proc directory match
+Applies @var{proc} only to those filenames for which
+@code{(filename:match?? @var{match})} would return a non-false value
+(@pxref{Filenames, , , slib, SLIB}).
+
+@example
+(require 'directory)
+(directory-for-each print "." "[A-Z]*.scm")
+@print{}
+"Bev2slib.scm"
+"Template.scm"
+@end example
+@end defun
diff --git a/dwindtst.scm b/dwindtst.scm
index 868901e..94b5827 100644
--- a/dwindtst.scm
+++ b/dwindtst.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
diff --git a/dynamic.scm b/dynamic.scm
index 937f93e..3bdd037 100644
--- a/dynamic.scm
+++ b/dynamic.scm
@@ -26,21 +26,23 @@
 				  *current-dynamic-environment*)))
 
 (define dynamic-rtd (make-record-type "dynamic" '()))
+;@
 (define make-dynamic
   (let ((dynamic-constructor (record-constructor dynamic-rtd)))
     (lambda (obj)
       (let ((dynamic (dynamic-constructor)))
 	(extend-current-dynamic-environment dynamic obj)
 	dynamic))))
-
+;@
 (define dynamic? (record-predicate dynamic-rtd))
+
 (define (guarantee-dynamic dynamic)
   (or (dynamic? dynamic)
       (slib:error "Not a dynamic" dynamic)))
 
 (define dynamic:errmsg
   "No value defined for this dynamic in the current dynamic environment")
-
+;@
 (define (dynamic-ref dynamic)
   (guarantee-dynamic dynamic)
   (let loop ((env *current-dynamic-environment*))
@@ -50,7 +52,7 @@
 	   (dynamic-environment:value env))
 	  (else
 	   (loop (dynamic-environment:parent env))))))
-
+;@
 (define (dynamic-set! dynamic obj)
   (guarantee-dynamic dynamic)
   (let loop ((env *current-dynamic-environment*))
@@ -60,7 +62,7 @@
 	   (dynamic-environment:set-value! env obj))
 	  (else
 	   (loop (dynamic-environment:parent env))))))
-
+;@
 (define (call-with-dynamic-binding dynamic obj thunk)
   (let ((out-thunk-env #f)
 	(in-thunk-env (make-dynamic-environment
diff --git a/dynwind.scm b/dynwind.scm
index c9bdb95..a6a80ab 100644
--- a/dynwind.scm
+++ b/dynwind.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -41,7 +41,7 @@
 ;;;time of the error or interrupt.
 
 (define dynamic:winds '())
-
+;@
 (define (dynamic-wind <thunk1> <thunk2> <thunk3>)
   (<thunk1>)
   (set! dynamic:winds (cons (cons <thunk1> <thunk3>) dynamic:winds))
@@ -49,7 +49,7 @@
     (set! dynamic:winds (cdr dynamic:winds))
     (<thunk3>)
     ans))
-
+;@
 (define call-with-current-continuation
   (let ((oldcc call-with-current-continuation))
     (lambda (proc)
diff --git a/elk.init b/elk.init
index 598b935..13fde42 100644
--- a/elk.init
+++ b/elk.init
@@ -1,4 +1,4 @@
-;;;"elk.init" Initialisation file for SLIB for ELK 2.1	-*- Scheme -*-
+;;;"elk.init" Initialisation file for SLIB for ELK 3.0	-*- Scheme -*-
 ;;; Author: Aubrey Jaffer
 ;;;
 ;;; This code is in the public domain.
@@ -16,39 +16,33 @@
 
 ;;; (software-type) should be set to the generic operating system type.
 ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
-
 (define (software-type) 'UNIX)
 
 ;;; (scheme-implementation-type) should return the name of the scheme
 ;;; implementation loading this file.
-
 (define (scheme-implementation-type) 'Elk)
 
 ;;; (scheme-implementation-home-page) should return a (string) URI
 ;;; (Uniform Resource Identifier) for this scheme implementation's home
 ;;; page; or false if there isn't one.
-
 (define (scheme-implementation-home-page)
   "http://www.informatik.uni-bremen.de/~net/elk/")
 
 ;;; (scheme-implementation-version) should return a string describing
 ;;; the version the scheme implementation loading this file.
-
 (define (scheme-implementation-version) "3.0")
 
 ;;; (implementation-vicinity) should be defined to be the pathname of
 ;;; the directory where any auxillary files to your Scheme
 ;;; implementation reside.
-
 (define (implementation-vicinity)
   (case (software-type)
-    ((UNIX)	 "/usr/local/lib/elk-2.1/scm/")
+    ((UNIX)	 "/usr/local/lib/elk/runtime/scm/")
     ((VMS)	"scheme$src:")
     ((MS-DOS)	"C:\\scheme\\")))
 
 ;;; (library-vicinity) should be defined to be the pathname of the
 ;;; directory where files of Scheme library functions reside.
-
 (require 'unix)
 (define getenv unix-getenv)
 (define system unix-system)
@@ -67,14 +61,18 @@
 ;;; (home-vicinity) should return the vicinity of the user's HOME
 ;;; directory, the directory which typically contains files which
 ;;; customize a computer environment for a user.
-
-(define home-vicinity
-  (let ((home-path (getenv "HOME")))
-    (lambda () home-path)))
+(define (home-vicinity)
+  (let ((home (getenv "HOME")))
+    (and home
+	 (case (software-type)
+	   ((UNIX COHERENT MS-DOS)	;V7 unix has a / on HOME
+	    (if (eqv? #\/ (string-ref home (+ -1 (string-length home))))
+		home
+		(string-append home "/")))
+	   (else home)))))
 
 ;;; *features* should be set to a list of symbols describing features
 ;;; of this implementation.  Suggestions for features are:
-
 (define *features*
       '(
 	source				;can load scheme source files
@@ -84,7 +82,7 @@
 
 		       ;; Scheme report features
 
-;	rev5-report			;conforms to
+;	r5rs				;conforms to
 ;	eval				;R5RS two-argument eval
 ;	values				;R5RS multiple values
 ;	dynamic-wind			;R5RS dynamic-wind
@@ -98,11 +96,11 @@
 					;STRING-FILL!, LIST->VECTOR,
 					;VECTOR->LIST, and VECTOR-FILL!
 
-	rev4-report			;conforms to
+	r4rs				;conforms to
 
 	ieee-p1178			;conforms to
 
-;	rev3-report			;conforms to
+;	r3rs				;conforms to
 
 	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
 					;SUBSTRING-MOVE-RIGHT!,
@@ -113,7 +111,7 @@
 
 	multiarg/and-			;/ and - can take more than 2 args.
 ;	with-file			;has WITH-INPUT-FROM-FILE and
-					;WITH-OUTPUT-FROM-FILE
+					;WITH-OUTPUT-TO-FILE
 	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 ;	ieee-floating-point		;conforms to IEEE Standard 754-1985
 					;IEEE Standard for Binary
@@ -152,7 +150,6 @@
 ; EXACT? appears to always return #f which isn't very useful.
 ; Approximating it with INTEGER? at least means that some
 ; of the code in the library will work correctly
-
 (define exact? integer?)  ; WARNING: redefining EXACT?
 
 (define (inexact? arg)
@@ -202,6 +199,37 @@
     (close-input-port insp)
     res))
 
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r rb) (open-input-file filename))
+    ((w wb) (open-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+(define (close-port port)
+  (cond ((input-port? port)
+	 (close-input-port port)
+	 (if (output-port? port) (close-output-port port)))
+	((output-port? port) (close-output-port port))
+	(else (slib:error 'close-port 'port? port))))
+
+(define (browse-url url)
+  (define (try cmd end) (zero? (system (string-append cmd url end))))
+  (or (try "netscape-remote -remote 'openURL(" ")'")
+      (try "netscape -remote 'openURL(" ")'")
+      (try "netscape '" "'&")
+      (try "netscape '" "'")))
+
 ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
 ;;; be returned by CHAR->INTEGER.
 (define char-code-limit 256)
@@ -268,7 +296,7 @@
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Warn: " cep)
-      (for-each (lambda (x) (display x cep)) args))))
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
 
 ;;; define an error procedure for the library
 (define slib:error
@@ -323,7 +351,6 @@
 ; _(global-environment)_ if none is explicitly specified.
 ; If this is not done, definitions in files loaded by other files will
 ; not be loaded in the correct environment.
-
 (define slib:load-source
   (let ((primitive-load load))
     (lambda (<pathname> . rest)
@@ -333,14 +360,12 @@
 ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
 ;;; by compiling "foo.scm" if this implementation can compile files.
 ;;; See feature 'COMPILED.
-
 (define slib:load-compiled
   (let ((primitive-load load))
     (lambda (<pathname> . rest)
       (apply primitive-load (string->symbol (string-append name ".o")) rest))))
 
 ;;; At this point SLIB:LOAD must be able to load SLIB files.
-
 (define slib:load slib:load-source)	;WARNING: redefining LOAD
 
 (slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/eval.scm b/eval.scm
index a5e7e19..ae716f6 100644
--- a/eval.scm
+++ b/eval.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -45,15 +45,15 @@
        (apply (lambda (environment-values identifiers procedure)
 		(eval-1 `((lambda args args) ,@identifiers)))
 	      environment)))))
-
+;@
 (define interaction-environment
   (let ((env (eval:make-environment '())))
     (lambda () env)))
 
-;;; null-environment is set by first call to scheme-report-environment at
+;;;@ null-environment is set by first call to scheme-report-environment at
 ;;; the end of this file.
 (define null-environment #f)
-
+;@
 (define scheme-report-environment
   (let* ((r4rs-procedures
 	  (append
@@ -111,7 +111,7 @@
 			      null-environment scheme-report-environment values)
 	   r4rs-procedures))
 	 (r4rs-environment (eval:make-environment r4rs-procedures))
-	 (r5rs-environment (eval:make-environment r4rs-procedures)))
+	 (r5rs-environment (eval:make-environment r5rs-procedures)))
     (let ((car car))
       (lambda (version)
 	(cond ((car r5rs-environment))
@@ -125,7 +125,7 @@
 	  ((4) r4rs-environment)
 	  ((5) r5rs-environment)
 	  (else (slib:error 'eval 'version version 'not 'available)))))))
-
+;@
 (define eval
   (let ((eval-1 slib:eval)
 	(apply apply)
diff --git a/factor.scm b/factor.scm
index 3b9fb5e..c445004 100644
--- a/factor.scm
+++ b/factor.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -17,7 +17,6 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
-(require 'common-list-functions)
 (require 'modular)
 (require 'random)
 (require 'byte)
@@ -82,8 +81,10 @@
        (if (positive? i) #f #t))))
 
 ;;; prime:products are products of small primes.
+;;; was (comlist:notevery (lambda (prd) (= 1 (gcd n prd))) comps))
 (define (primes-gcd? n comps)
-  (comlist:notevery (lambda (prd) (= 1 (gcd n prd))) comps))
+  (not (let mapf ((lst comps))
+	 (or (null? lst) (and (= 1 (gcd n (car lst))) (mapf (cdr lst)))))))
 (define prime:prime-sqr 121)
 (define prime:products '(105))
 (define prime:sieve (bytes 0 0 1 1 0 1 0 1 0 0 0))
@@ -122,40 +123,37 @@
 ;;There is a slight chance @code{(expt 2 (- prime:trials))} that a
 ;;composite will return @code{#t}.
 (define prime? prime:prime?)
-(define probably-prime? prime:prime?)	;legacy
 
 (define (prime:prime< start)
   (do ((nbr (+ -1 start) (+ -1 nbr)))
       ((or (negative? nbr) (prime:prime? nbr))
        (if (negative? nbr) #f nbr))))
 
-(define (prime:primes< start count)
+;;@body
+;;Returns a list of the first @2 prime numbers less than
+;;@1.  If there are fewer than @var{count} prime numbers
+;;less than @var{start}, then the returned list will have fewer than
+;;@var{start} elements.
+(define (primes< start count)
   (do ((cnt (+ -2 count) (+ -1 cnt))
        (lst '() (cons prime lst))
        (prime (prime:prime< start) (prime:prime< prime)))
       ((or (not prime) (negative? cnt))
        (if prime (cons prime lst) lst))))
-;;@args start count
-;;Returns a list of the first @2 prime numbers less than
-;;@1.  If there are fewer than @var{count} prime numbers
-;;less than @var{start}, then the returned list will have fewer than
-;;@var{start} elements.
-(define primes< prime:primes<)
 
 (define (prime:prime> start)
   (do ((nbr (+ 1 start) (+ 1 nbr)))
       ((prime:prime? nbr) nbr)))
 
-(define (prime:primes> start count)
+;;@body
+;;Returns a list of the first @2 prime numbers greater than @1.
+(define (primes> start count)
   (set! start (max 0 start))
   (do ((cnt (+ -2 count) (+ -1 cnt))
        (lst '() (cons prime lst))
        (prime (prime:prime> start) (prime:prime> prime)))
       ((negative? cnt)
        (reverse (cons prime lst)))))
-;;@args start count
-;;Returns a list of the first @2 prime numbers greater than @1.
-(define primes> prime:primes>)
 
 ;;;;Lankinen's recursive factoring algorithm:
 ;From: ld231782@longs.LANCE.ColoState.EDU (L. Detweiler)
@@ -232,14 +230,13 @@
 	  '()
 	  (prime:fo m))))
 
-(define (prime:factor k)
+;;@body
+;;Returns a list of the prime factors of @1.  The order of the
+;;factors is unspecified.  In order to obtain a sorted list do
+;;@code{(sort! (factor @var{k}) <)}.
+(define (factor k)
   (case k
     ((-1 0 1) (list k))
     (else (if (negative? k)
 	      (cons -1 (prime:fe (- k)))
 	      (prime:fe k)))))
-;;@args k
-;;Returns a list of the prime factors of @1.  The order of the
-;;factors is unspecified.  In order to obtain a sorted list do
-;;@code{(sort! (factor @var{k}) <)}.
-(define factor prime:factor)
diff --git a/fft.scm b/fft.scm
index 9537e9c..2257e30 100644
--- a/fft.scm
+++ b/fft.scm
@@ -1,5 +1,5 @@
 ;;;"fft.scm" Fast Fourier Transform
-;Copyright (C) 1999 Aubrey Jaffer
+;Copyright (C) 1999, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -28,14 +28,13 @@
 ;;; differs in the direction of rotation of the complex unit vectors.
 
 (require 'array)
+(require 'logical)
 
-(define (fft:shuffled&scaled ara n scale)
+;;@code{(require 'fft)}
+;;@ftindex fft
+
+(define (fft:shuffle&scale new ara n scale)
   (define lgn (integer-length (+ -1 n)))
-  (define new (apply make-array 0 (array-dimensions ara)))
-  (define bit-reverse (lambda (width in)
-			(if (zero? width) 0
-			    (+ (bit-reverse (+ -1 width) (quotient in 2))
-			       (ash (modulo in 2) (+ -1 width))))))
   (if (not (eqv? n (expt 2 lgn)))
       (slib:error 'fft "array length not power of 2" n))
   (do ((k 0 (+ 1 k)))
@@ -61,10 +60,35 @@
 	    (array-set! ara (+ u t) k)
 	    (array-set! ara (- u t) k+m/2)))))))
 
+;;@args array
+;;@var{array} is an array of @code{(expt 2 n)} numbers.  @code{fft}
+;;returns an array of complex numbers comprising the
+;;@dfn{Discrete Fourier Transform} of @var{array}.
 (define (fft ara)
   (define n (car (array-dimensions ara)))
-  (dft! (fft:shuffled&scaled ara n 1) n 1))
+  (define new (apply create-array ara (array-dimensions ara)))
+  (dft! (fft:shuffle&scale new ara n 1) n 1))
 
+;;@args array
+;;@code{fft-1} returns an array of complex numbers comprising the
+;;inverse Discrete Fourier Transform of @var{array}.
 (define (fft-1 ara)
   (define n (car (array-dimensions ara)))
-  (dft! (fft:shuffled&scaled ara n (/ n)) n -1))
+  (define new (apply create-array ara (array-dimensions ara)))
+  (dft! (fft:shuffle&scale new ara n (/ n)) n -1))
+
+;;@noindent
+;;@code{(fft-1 (fft @var{array}))} will return an array of values close to
+;;@var{array}.
+;;
+;;@example
+;;(fft '#(1 0+i -1 0-i 1 0+i -1 0-i)) @result{}
+;;
+;;#(0.0 0.0 0.0+628.0783185208527e-18i 0.0
+;;  0.0 0.0 8.0-628.0783185208527e-18i 0.0)
+;;
+;;(fft-1 '#(0 0 0 0 0 0 8 0)) @result{}
+;;
+;;#(1.0 -61.23031769111886e-18+1.0i -1.0 61.23031769111886e-18-1.0i
+;;  1.0 -61.23031769111886e-18+1.0i -1.0 61.23031769111886e-18-1.0i)
+;;@end example
diff --git a/fft.txi b/fft.txi
new file mode 100644
index 0000000..c73f103
--- /dev/null
+++ b/fft.txi
@@ -0,0 +1,32 @@
+@code{(require 'fft)}
+@ftindex fft
+
+
+@defun fft array
+
+@var{array} is an array of @code{(expt 2 n)} numbers.  @code{fft}
+returns an array of complex numbers comprising the
+@dfn{Discrete Fourier Transform} of @var{array}.
+@cindex Discrete Fourier Transform
+@end defun
+
+@defun fft-1 array
+
+@code{fft-1} returns an array of complex numbers comprising the
+inverse Discrete Fourier Transform of @var{array}.
+@end defun
+@noindent
+@code{(fft-1 (fft @var{array}))} will return an array of values close to
+@var{array}.
+
+@example
+(fft '#(1 0+i -1 0-i 1 0+i -1 0-i)) @result{}
+
+#(0.0 0.0 0.0+628.0783185208527e-18i 0.0
+  0.0 0.0 8.0-628.0783185208527e-18i 0.0)
+
+(fft-1 '#(0 0 0 0 0 0 8 0)) @result{}
+
+#(1.0 -61.23031769111886e-18+1.0i -1.0 61.23031769111886e-18-1.0i
+  1.0 -61.23031769111886e-18+1.0i -1.0 61.23031769111886e-18-1.0i)
+@end example
diff --git a/fluidlet.scm b/fluidlet.scm
index 983bfdb..06d4630 100644
--- a/fluidlet.scm
+++ b/fluidlet.scm
@@ -1,5 +1,5 @@
 ; "fluidlet.scm", FLUID-LET for Scheme
-; Copyright (c) 1998, Aubrey Jaffer
+; Copyright (c) 1998 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -18,14 +18,13 @@
 ;each case.
 
 (require 'dynamic-wind)
-(require 'common-list-functions)	;MAKE-LIST
-
+;@
 (defmacro fluid-let (clauses . body)
   (let ((ids (map car clauses))
 	(new-tmps (map (lambda (x) (gentemp)) clauses))
 	(old-tmps (map (lambda (x) (gentemp)) clauses)))
     `(let (,@(map list new-tmps (map cadr clauses))
-	   ,@(map list old-tmps (make-list (length clauses) #f)))
+	   ,@(map list old-tmps (map (lambda (x) #f) clauses)))
        (dynamic-wind
 	   (lambda ()
 	     ,@(map (lambda (ot id) `(set! ,ot ,id))
diff --git a/fmtdoc.txi b/fmtdoc.txi
deleted file mode 100644
index 3e2adb7..0000000
--- a/fmtdoc.txi
+++ /dev/null
@@ -1,434 +0,0 @@
-
-@menu
-* Format Interface::            
-* Format Specification::        
-@end menu
-
-@node Format Interface, Format Specification, Format, Format
-@subsection Format Interface
-
-@defun format destination format-string . arguments
-An almost complete implementation of Common LISP format description
-according to the CL reference book @cite{Common LISP} from Guy L.
-Steele, Digital Press.  Backward compatible to most of the available
-Scheme format implementations.
-
-Returns @code{#t}, @code{#f} or a string; has side effect of printing
-according to @var{format-string}.  If @var{destination} is @code{#t},
-the output is to the current output port and @code{#t} is returned.  If
-@var{destination} is @code{#f}, a formatted string is returned as the
-result of the call.  NEW: If @var{destination} is a string,
-@var{destination} is regarded as the format string; @var{format-string} is
-then the first argument and the output is returned as a string. If
-@var{destination} is a number, the output is to the current error port
-if available by the implementation. Otherwise @var{destination} must be
-an output port and @code{#t} is returned.@refill
-
-@var{format-string} must be a string.  In case of a formatting error
-format returns @code{#f} and prints a message on the current output or
-error port.  Characters are output as if the string were output by the
-@code{display} function with the exception of those prefixed by a tilde
-(~).  For a detailed description of the @var{format-string} syntax
-please consult a Common LISP format reference manual.  For a test suite
-to verify this format implementation load @file{formatst.scm}. Please
-send bug reports to @code{lutzeb@@cs.tu-berlin.de}.
-
-Note: @code{format} is not reentrant, i.e. only one @code{format}-call
-may be executed at a time.
-
-@end defun
-
-@node Format Specification,  , Format Interface, Format
-@subsection Format Specification (Format version 3.0)
-
-Please consult a Common LISP format reference manual for a detailed
-description of the format string syntax.  For a demonstration of the
-implemented directives see @file{formatst.scm}.@refill
-
-This implementation supports directive parameters and modifiers
-(@code{:} and @code{@@} characters). Multiple parameters must be
-separated by a comma (@code{,}).  Parameters can be numerical parameters
-(positive or negative), character parameters (prefixed by a quote
-character (@code{'}), variable parameters (@code{v}), number of rest
-arguments parameter (@code{#}), empty and default parameters.  Directive
-characters are case independent. The general form of a directive
-is:@refill
-
-@noindent
-@var{directive} ::= ~@{@var{directive-parameter},@}[:][@@]@var{directive-character}
-
-@noindent
-@var{directive-parameter} ::= [ [-|+]@{0-9@}+ | '@var{character} | v | # ]
-
-
-@subsubsection Implemented CL Format Control Directives
-
-Documentation syntax: Uppercase characters represent the corresponding
-control directive characters. Lowercase characters represent control
-directive parameter descriptions.
-
-@table @asis
-@item @code{~A}
-Any (print as @code{display} does).
-@table @asis
-@item @code{~@@A}
-left pad.
-@item @code{~@var{mincol},@var{colinc},@var{minpad},@var{padchar}A}
-full padding.
-@end table
-@item @code{~S}
-S-expression (print as @code{write} does).
-@table @asis
-@item @code{~@@S}
-left pad.
-@item @code{~@var{mincol},@var{colinc},@var{minpad},@var{padchar}S}
-full padding.
-@end table
-@item @code{~D}
-Decimal.
-@table @asis
-@item @code{~@@D}
-print number sign always.
-@item @code{~:D}
-print comma separated.
-@item @code{~@var{mincol},@var{padchar},@var{commachar}D}
-padding.
-@end table
-@item @code{~X}
-Hexadecimal.
-@table @asis
-@item @code{~@@X}
-print number sign always.
-@item @code{~:X}
-print comma separated.
-@item @code{~@var{mincol},@var{padchar},@var{commachar}X}
-padding.
-@end table
-@item @code{~O}
-Octal.
-@table @asis
-@item @code{~@@O}
-print number sign always.
-@item @code{~:O}
-print comma separated.
-@item @code{~@var{mincol},@var{padchar},@var{commachar}O}
-padding.
-@end table
-@item @code{~B}
-Binary.
-@table @asis
-@item @code{~@@B}
-print number sign always.
-@item @code{~:B}
-print comma separated.
-@item @code{~@var{mincol},@var{padchar},@var{commachar}B}
-padding.
-@end table
-@item @code{~@var{n}R}
-Radix @var{n}.
-@table @asis
-@item @code{~@var{n},@var{mincol},@var{padchar},@var{commachar}R}
-padding.
-@end table
-@item @code{~@@R}
-print a number as a Roman numeral.
-@item @code{~:@@R}
-print a number as an ``old fashioned'' Roman numeral.
-@item @code{~:R}
-print a number as an ordinal English number.
-@item @code{~R}
-print a number as a cardinal English number.
-@item @code{~P}
-Plural.
-@table @asis
-@item @code{~@@P}
-prints @code{y} and @code{ies}.
-@item @code{~:P}
-as @code{~P but jumps 1 argument backward.}
-@item @code{~:@@P}
-as @code{~@@P but jumps 1 argument backward.}
-@end table
-@item @code{~C}
-Character.
-@table @asis
-@item @code{~@@C}
-prints a character as the reader can understand it (i.e. @code{#\} prefixing).
-@item @code{~:C}
-prints a character as emacs does (eg. @code{^C} for ASCII 03).
-@end table
-@item @code{~F}
-Fixed-format floating-point (prints a flonum like @var{mmm.nnn}).
-@table @asis
-@item @code{~@var{width},@var{digits},@var{scale},@var{overflowchar},@var{padchar}F}
-@item @code{~@@F}
-If the number is positive a plus sign is printed.
-@end table
-@item @code{~E}
-Exponential floating-point (prints a flonum like @var{mmm.nnn}@code{E}@var{ee}).
-@table @asis
-@item @code{~@var{width},@var{digits},@var{exponentdigits},@var{scale},@var{overflowchar},@var{padchar},@var{exponentchar}E}
-@item @code{~@@E}
-If the number is positive a plus sign is printed.
-@end table
-@item @code{~G}
-General floating-point (prints a flonum either fixed or exponential).
-@table @asis
-@item @code{~@var{width},@var{digits},@var{exponentdigits},@var{scale},@var{overflowchar},@var{padchar},@var{exponentchar}G}
-@item @code{~@@G}
-If the number is positive a plus sign is printed.
-@end table
-@item @code{~$}
-Dollars floating-point (prints a flonum in fixed with signs separated).
-@table @asis
-@item @code{~@var{digits},@var{scale},@var{width},@var{padchar}$}
-@item @code{~@@$}
-If the number is positive a plus sign is printed.
-@item @code{~:@@$}
-A sign is always printed and appears before the padding.
-@item @code{~:$}
-The sign appears before the padding.
-@end table
-@item @code{~%}
-Newline.
-@table @asis
-@item @code{~@var{n}%}
-print @var{n} newlines.
-@end table
-@item @code{~&}
-print newline if not at the beginning of the output line.
-@table @asis
-@item @code{~@var{n}&}
-prints @code{~&} and then @var{n-1} newlines.
-@end table
-@item @code{~|}
-Page Separator.
-@table @asis
-@item @code{~@var{n}|}
-print @var{n} page separators.
-@end table
-@item @code{~~}
-Tilde.
-@table @asis
-@item @code{~@var{n}~}
-print @var{n} tildes.
-@end table
-@item @code{~}<newline>
-Continuation Line.
-@table @asis
-@item @code{~:}<newline>
-newline is ignored, white space left.
-@item @code{~@@}<newline>
-newline is left, white space ignored.
-@end table
-@item @code{~T}
-Tabulation.
-@table @asis
-@item @code{~@@T}
-relative tabulation.
-@item @code{~@var{colnum,colinc}T}
-full tabulation.
-@end table
-@item @code{~?}
-Indirection (expects indirect arguments as a list).
-@table @asis
-@item @code{~@@?}
-extracts indirect arguments from format arguments.
-@end table
-@item @code{~(@var{str}~)}
-Case conversion (converts by @code{string-downcase}).
-@table @asis
-@item @code{~:(@var{str}~)}
-converts by @code{string-capitalize}.
-@item @code{~@@(@var{str}~)}
-converts by @code{string-capitalize-first}.
-@item @code{~:@@(@var{str}~)}
-converts by @code{string-upcase}.
-@end table
-@item @code{~*}
-Argument Jumping (jumps 1 argument forward).
-@table @asis
-@item @code{~@var{n}*}
-jumps @var{n} arguments forward.
-@item @code{~:*}
-jumps 1 argument backward.
-@item @code{~@var{n}:*}
-jumps @var{n} arguments backward.
-@item @code{~@@*}
-jumps to the 0th argument.
-@item @code{~@var{n}@@*}
-jumps to the @var{n}th argument (beginning from 0)
-@end table
-@item @code{~[@var{str0}~;@var{str1}~;...~;@var{strn}~]}
-Conditional Expression (numerical clause conditional).
-@table @asis
-@item @code{~@var{n}[}
-take argument from @var{n}.
-@item @code{~@@[}
-true test conditional.
-@item @code{~:[}
-if-else-then conditional.
-@item @code{~;}
-clause separator.
-@item @code{~:;}
-default clause follows.
-@end table
-@item @code{~@{@var{str}~@}}
-Iteration (args come from the next argument (a list)).
-@table @asis
-@item @code{~@var{n}@{}
-at most @var{n} iterations.
-@item @code{~:@{}
-args from next arg (a list of lists).
-@item @code{~@@@{}
-args from the rest of arguments.
-@item @code{~:@@@{}
-args from the rest args (lists).
-@end table
-@item @code{~^}
-Up and out.
-@table @asis
-@item @code{~@var{n}^}
-aborts if @var{n} = 0
-@item @code{~@var{n},@var{m}^}
-aborts if @var{n} = @var{m}
-@item @code{~@var{n},@var{m},@var{k}^}
-aborts if @var{n} <= @var{m} <= @var{k}
-@end table
-@end table
-
-
-@subsubsection Not Implemented CL Format Control Directives
-
-@table @asis
-@item @code{~:A}
-print @code{#f} as an empty list (see below).
-@item @code{~:S}
-print @code{#f} as an empty list (see below).
-@item @code{~<~>}
-Justification.
-@item @code{~:^}
-(sorry I don't understand its semantics completely)
-@end table
-
-
-@subsubsection Extended, Replaced and Additional Control Directives
-
-@table @asis
-@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}D}
-@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}X}
-@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}O}
-@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}B}
-@item @code{~@var{n},@var{mincol},@var{padchar},@var{commachar},@var{commawidth}R}
-@var{commawidth} is the number of characters between two comma characters.
-@end table
-
-@table @asis
-@item @code{~I}
-print a R4RS complex number as @code{~F~@@Fi} with passed parameters for
-@code{~F}.
-@item @code{~Y}
-Pretty print formatting of an argument for scheme code lists.
-@item @code{~K}
-Same as @code{~?.}
-@item @code{~!}
-Flushes the output if format @var{destination} is a port.
-@item @code{~_}
-Print a @code{#\space} character
-@table @asis
-@item @code{~@var{n}_}
-print @var{n} @code{#\space} characters.
-@end table
-@item @code{~/}
-Print a @code{#\tab} character
-@table @asis
-@item @code{~@var{n}/}
-print @var{n} @code{#\tab} characters.
-@end table
-@item @code{~@var{n}C}
-Takes @var{n} as an integer representation for a character. No arguments
-are consumed. @var{n} is converted to a character by
-@code{integer->char}.  @var{n} must be a positive decimal number.@refill
-@item @code{~:S}
-Print out readproof.  Prints out internal objects represented as
-@code{#<...>} as strings @code{"#<...>"} so that the format output can always
-be processed by @code{read}.
-@refill
-@item @code{~:A}
-Print out readproof.  Prints out internal objects represented as
-@code{#<...>} as strings @code{"#<...>"} so that the format output can always
-be processed by @code{read}.
-@item @code{~Q}
-Prints information and a copyright notice on the format implementation.
-@table @asis
-@item @code{~:Q}
-prints format version.
-@end table
-@refill
-@item @code{~F, ~E, ~G, ~$}
-may also print number strings, i.e. passing a number as a string and
-format it accordingly.
-@end table
-
-@subsubsection Configuration Variables
-
-Format has some configuration variables at the beginning of
-@file{format.scm} to suit the systems and users needs. There should be
-no modification necessary for the configuration that comes with SLIB.
-If modification is desired the variable should be set after the format
-code is loaded. Format detects automatically if the running scheme
-system implements floating point numbers and complex numbers.
-
-@table @asis
-
-@item @var{format:symbol-case-conv}
-Symbols are converted by @code{symbol->string} so the case type of the
-printed symbols is implementation dependent.
-@code{format:symbol-case-conv} is a one arg closure which is either
-@code{#f} (no conversion), @code{string-upcase}, @code{string-downcase}
-or @code{string-capitalize}. (default @code{#f})
-
-@item @var{format:iobj-case-conv}
-As @var{format:symbol-case-conv} but applies for the representation of
-implementation internal objects. (default @code{#f})
-
-@item @var{format:expch}
-The character prefixing the exponent value in @code{~E} printing. (default
-@code{#\E})
-
-@end table
-
-@subsubsection Compatibility With Other Format Implementations
-
-@table @asis
-@item SLIB format 2.x:
-See @file{format.doc}.
-
-@item SLIB format 1.4:
-Downward compatible except for padding support and @code{~A}, @code{~S},
-@code{~P}, @code{~X} uppercase printing.  SLIB format 1.4 uses C-style
-@code{printf} padding support which is completely replaced by the CL
-@code{format} padding style.
-
-@item MIT C-Scheme 7.1:
-Downward compatible except for @code{~}, which is not documented
-(ignores all characters inside the format string up to a newline
-character).  (7.1 implements @code{~a}, @code{~s},
-~@var{newline}, @code{~~}, @code{~%}, numerical and variable
-parameters and @code{:/@@} modifiers in the CL sense).@refill
-
-@item Elk 1.5/2.0:
-Downward compatible except for @code{~A} and @code{~S} which print in
-uppercase.  (Elk implements @code{~a}, @code{~s}, @code{~~}, and
-@code{~%} (no directive parameters or modifiers)).@refill
-
-@item Scheme->C 01nov91:
-Downward compatible except for an optional destination parameter: S2C
-accepts a format call without a destination which returns a formatted
-string. This is equivalent to a #f destination in S2C. (S2C implements
-@code{~a}, @code{~s}, @code{~c}, @code{~%}, and @code{~~} (no directive
-parameters or modifiers)).@refill
-
-@end table
-
-This implementation of format is solely useful in the SLIB context
-because it requires other components provided by SLIB.@refill
diff --git a/format.scm b/format.scm
index 709acf7..c9e1d12 100644
--- a/format.scm
+++ b/format.scm
@@ -31,6 +31,13 @@
 (define format:expch #\E)
 ;; The character prefixing the exponent value in ~e printing.
 
+(define format:iteration-bounded #t)
+;; If #t, "~{...~}" iterates no more than format:max-iterations times;
+;; if #f, there is no bound.
+
+(define format:max-iterations 100)
+;; Compatible with previous versions.
+
 (define format:floats (provided? 'inexact))
 ;; Detects if the scheme system implements flonums (see at eof).
 
@@ -605,7 +612,8 @@
 		 ((colon)
 		  (if (not max-iterations) (set! max-iterations 1)))
 		 ((colon-at at) (format:error "illegal modifier"))
-		 (else (if (not max-iterations) (set! max-iterations 100))))
+		 (else (if (not max-iterations)
+			   (set! max-iterations format:max-iterations))))
 	       (if (not (null? params))
 		   (format:error "no parameters allowed in ~~}"))
 	       (if (zero? iteration-nest)
@@ -627,7 +635,8 @@
 					    (list-tail args arg-pos))))
 			     (i 0 (+ i 1)))
 			    ((or (>= arg-pos args-len)
-				 (>= i max-iterations))))))
+				 (and format:iteration-bounded
+				      (>= i max-iterations)))))))
 		     ((sublists)
 		      (let ((args (next-arg))
 			    (args-len 0))
@@ -636,7 +645,8 @@
 			(set! args-len (length args))
 			(do ((arg-pos 0 (+ arg-pos 1)))
 			    ((or (>= arg-pos args-len)
-				 (>= arg-pos max-iterations)))
+				 (and format:iteration-bounded
+				      (>= arg-pos max-iterations))))
 			  (let ((sublist (list-ref args arg-pos)))
 			    (if (not (list? sublist))
 				(format:error
@@ -653,7 +663,8 @@
 						   args arg-pos))))
 				   (i 0 (+ i 1)))
 				  ((or (>= arg-pos args-len)
-				       (>= i max-iterations))
+				       (and format:iteration-bounded
+					    (>= i max-iterations)))
 				   arg-pos))))
 			(add-arg-pos usedup-args)))
 		     ((rest-sublists)
@@ -662,7 +673,8 @@
 			     (usedup-args
 			      (do ((arg-pos 0 (+ arg-pos 1)))
 				  ((or (>= arg-pos args-len)
-				       (>= arg-pos max-iterations))
+				       (and format:iteration-bounded
+					    (>= arg-pos max-iterations)))
 				   arg-pos)
 				(let ((sublist (list-ref args arg-pos)))
 				  (if (not (list? sublist))
diff --git a/formatst.scm b/formatst.scm
index 3f19130..77a46c4 100644
--- a/formatst.scm
+++ b/formatst.scm
@@ -66,6 +66,8 @@
 (set! format:symbol-case-conv #f)
 (set! format:iobj-case-conv #f)
 (set! format:read-proof #f)
+(set! format:iteration-bounded #t)
+(set! format:max-iterations 100)
 
 (format #t "~q")
 
@@ -426,6 +428,23 @@ def")
 (test '("~2:@{ ~a,~a ~} ~a" (a 1) (b 2) (c 3)) " a,1  b,2  (c 3)")
 (test '("~{~}" "<~a,~a>" (a 1 b 2 c 3)) "<a,1><b,2><c,3>")
 (test '("~{ ~a ~{<~a>~}~} ~a" (a (1 2) b (3 4)) 10) " a <1><2> b <3><4> 10")
+(let ((nums (let iter ((ns '()) (l 0))
+              (if (> l 105) (reverse ns) (iter (cons l ns) (+ l 1))))))
+  ;; Test default, only 100 items formatted out:
+  (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums))
+	"0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100")
+  ;; Test control of number of items formatted out:
+  (set! format:max-iterations 90)
+  (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums))
+	"0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90")
+  ;; Test control of imposing bound on number of items formatted out:
+  (set! format:iteration-bounded #f)
+  (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums))
+	"0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105")
+  ;; Restore defaults:
+  (set! format:iteration-bounded #t)
+  (set! format:max-iterations 100)
+  )
 
 ; up and out
 
diff --git a/gambit.init b/gambit.init
index 538fb47..2e8a10d 100644
--- a/gambit.init
+++ b/gambit.init
@@ -11,7 +11,6 @@
 ;;; From: barnett@armadillo.urich.edu (Lewis Barnett)
 ;;; Relative pathnames for Slib in MacGambit
 ;;; Hacked yet again for Gambit v2.4, Jan 1997, by Mike Pope
-
 (define (software-type) 'MACOS)		; for MacGambit.
 (define (software-type) 'UNIX)		; for Unix platforms.
 
@@ -20,7 +19,6 @@
 ;;; (scheme-implementation-home-page) should return a (string) URI
 ;;; (Uniform Resource Identifier) for this scheme implementation's home
 ;;; page; or false if there isn't one.
-
 (define (scheme-implementation-home-page)
   "http://www.iro.umontreal.ca/~gambit/index.html")
 
@@ -35,10 +33,9 @@
 ;;; (implementation-vicinity) should be defined to be the pathname of
 ;;; the directory where any auxillary files to your Scheme
 ;;; implementation reside.
-
 (define implementation-vicinity
   (case (software-type)
-    ((UNIX)	(lambda () "/usr/local/src/scheme/"))
+    ((UNIX)	(lambda () "/usr/local/share/gambc/"))
     ((VMS)	(lambda () "scheme$src:"))
     ((MS-DOS)	(lambda () "C:\\scheme\\"))
     ((WINDOWS)  (lambda () "c:/scheme/"))
@@ -53,10 +50,9 @@
 
 ;;; (library-vicinity) should be defined to be the pathname of the
 ;;; directory where files of Scheme library functions reside.
-
+;;;
 ;;; This assumes that the slib files are in a folder
 ;;; called slib in the same directory as the MacGambit Interpreter.
-
 (define library-vicinity
   (let ((library-path
 	 (case (software-type)
@@ -71,20 +67,24 @@
 ;;; (home-vicinity) should return the vicinity of the user's HOME
 ;;; directory, the directory which typically contains files which
 ;;; customize a computer environment for a user.
-
-(define (home-vicinity) #f)
+(define home-vicinity
+  (case (software-type)
+    ((UNIX)	(lambda () "~/"))
+    ((VMS)	(lambda () "~:"))
+    ((MS-DOS)	(lambda () "~\\"))
+    ((WINDOWS)  (lambda () "~/"))
+    ((MACOS)    (lambda () "~:"))))
 
 ;;; *FEATURES* should be set to a list of symbols describing features
 ;;; of this implementation.  Suggestions for features are:
-
 (define *features*
       '(
 	source				;can load scheme source files
 					;(slib:load-source "filename")
 	compiled			;can load compiled files
 					;(slib:load-compiled "filename")
-	rev4-report			;conforms to
-;	rev3-report			;conforms to
+	r4rs				;conforms to
+;	r3rs				;conforms to
 	ieee-p1178			;conforms to
 ;	srfi				;srfi-0, COND-EXPAND finds all srfi-*
 	sicp				;runs code from Structure and
@@ -104,7 +104,7 @@
 	rationalize
 	delay				;has DELAY and FORCE
 	with-file			;has WITH-INPUT-FROM-FILE and
-					;WITH-OUTPUT-FROM-FILE
+					;WITH-OUTPUT-TO-FILE
 	string-port			;has CALL-WITH-INPUT-STRING and
 					;CALL-WITH-OUTPUT-STRING
 	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
@@ -123,6 +123,7 @@
 ;	object->string
 ;	format
 	trace				;has macros: TRACE and UNTRACE
+	break
 ;	compiler			;has (COMPILER)
 ;	ed				;(ED) is editor
 	system				;posix (system <string>)
@@ -163,6 +164,37 @@
 ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
 ;;; port versions of CALL-WITH-*PUT-FILE.
 
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r rb) (open-input-file filename))
+    ((w wb) (open-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+(define (port? obj) (or (input-port? port) (output-port? port)))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+(define (close-port port)
+  (cond ((input-port? port)
+	 (close-input-port port)
+	 (if (output-port? port) (close-output-port port)))
+	((output-port? port) (close-output-port port))
+	(else (slib:error 'close-port 'port? port))))
+
+(define (browse-url url)
+  (define (try cmd) (eqv? 0 (system (sprintf #f cmd url))))
+  (or (try "netscape-remote -remote 'openURL(%s)'")
+      (try "netscape -remote 'openURL(%s)'")
+      (try "netscape '%s'&")
+      (try "netscape '%s'")))
+
 ;;; "rationalize" adjunct procedures.
 (define (find-ratio x e)
   (let ((rat (rationalize x e)))
@@ -190,10 +222,6 @@
 ;(define macro:eval slib:eval)
 ;(define macro:load load)
 
-; Set up defmacro in terms of gambit's define-macro
-(define-macro (defmacro name args . body)
-  `(define-macro (,name ,@args) ,@body))
-
 (define *defmacros*
   (list (cons 'defmacro
 	      (lambda (name parms . body)
@@ -241,12 +269,14 @@
 	  (evl o))
 	(set! *load-pathname* old-load-pathname)))))
 
+(define print-call-stack identity)	;noop
+
 (define slib:warn
   (lambda args
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
       (display "Warn: " cep)
-      (for-each (lambda (x) (display x cep)) args))))
+      (for-each (lambda (x) (display #\  cep) (write x cep)) args))))
 
 ;; define an error procedure for the library
 (define (slib:error . args)
@@ -264,7 +294,6 @@
 
 ;;; Define these if your implementation's syntax can support it and if
 ;;; they are not already defined.
-
 (define (1+ n) (+ n 1))
 (define (-1+ n) (- n 1))
 (define 1- -1+)
@@ -284,17 +313,19 @@
 
 ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
 ;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
-
 (define slib:load-source load)
 
 ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
 ;;; by compiling "foo.scm" if this implementation can compile files.
 ;;; See feature 'COMPILED.
-
 (define slib:load-compiled load)
 
 ;;; At this point SLIB:LOAD must be able to load SLIB files.
-
 (define slib:load slib:load-source)
 
+(slib:eval '(define-macro (defmacro name parms . body)
+	      (set! *defmacros* (cons `(cons ',name (lambda ,parms ,@body))
+				      *defmacros*))
+	      `(define-macro (,name ,@parms) ,@body)))
+
 (slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/genwrite.scm b/genwrite.scm
index 2e4bf60..4f9105f 100644
--- a/genwrite.scm
+++ b/genwrite.scm
@@ -4,7 +4,7 @@
 ;; Distribution restrictions: none
 
 (define genwrite:newline-str (make-string 1 #\newline))
-
+;@
 (define (generic-write obj display? width output)
 
   (define (read-macro? l)
@@ -247,7 +247,7 @@
     (wr obj 0)))
 
 ; (reverse-string-append l) = (apply string-append (reverse l))
-
+;@
 (define (reverse-string-append l)
 
   (define (rev-string-append l i)
diff --git a/getopt.scm b/getopt.scm
index bb0b8a8..7b73b58 100644
--- a/getopt.scm
+++ b/getopt.scm
@@ -1,5 +1,5 @@
 ;;; "getopt.scm" POSIX command argument processing
-;Copyright (C) 1993, 1994 Aubrey Jaffer
+;Copyright (C) 1993, 1994, 2002 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -19,19 +19,21 @@
 
 (define getopt:scan #f)
 (define getopt:char #\-)
+;@
 (define getopt:opt #f)
+(define *argv* *argv*)
 (define *optind* 1)
 (define *optarg* 0)
-
-(define (getopt argc argv optstring)
+;@
+(define (getopt optstring)
   (let ((opts (string->list optstring))
 	(place #f)
 	(arg #f)
-	(argref (lambda () ((if (vector? argv) vector-ref list-ref)
-			    argv *optind*))))
+	(argref (lambda () ((if (vector? *argv*) vector-ref list-ref)
+			    *argv* *optind*))))
     (and
      (cond ((and getopt:scan (not (string=? "" getopt:scan))) #t)
-	   ((>= *optind* argc) #f)
+	   ((>= *optind* (length *argv*)) #f)
 	   (else
 	    (set! arg (argref))
 	    (cond ((or (<= (string-length arg) 1)
@@ -42,8 +44,7 @@
 		   (set! *optind* (+ *optind* 1))
 		   #f)
 		  (else
-		   (set! getopt:scan
-			 (substring arg 1 (string-length arg)))
+		   (set! getopt:scan (substring arg 1 (string-length arg)))
 		   #t))))
      (begin
        (set! getopt:opt (string-ref getopt:scan 0))
@@ -59,22 +60,21 @@
 	      (set! *optind* (+ *optind* 1))
 	      (set! getopt:scan #f)
 	      getopt:opt)
-	     ((< *optind* argc)
+	     ((< *optind* (length *argv*))
 	      (set! *optarg* (argref))
 	      (set! *optind* (+ *optind* 1))
 	      getopt:opt)
 	     ((and (not (null? opts)) (char=? #\: (car opts))) #\:)
 	     (else #\?))))))
-
-(define (getopt-- argc argv optstring)
-  (let* ((opt (getopt argc argv (string-append optstring "-:")))
+;@
+(define (getopt-- optstring)
+  (let* ((opt (getopt (string-append optstring "-:")))
 	 (optarg *optarg*))
     (cond ((eqv? #\- opt)		;long option
 	   (do ((l (string-length *optarg*))
 		(i 0 (+ 1 i)))
 	       ((or (>= i l) (char=? #\= (string-ref optarg i)))
-		(cond
-		 ((>= i l) (set! *optarg* #f) optarg)
-		 (else (set! *optarg* (substring optarg (+ 1 i) l))
-		       (substring optarg 0 i))))))
+		(cond ((>= i l) (set! *optarg* #f) optarg)
+		      (else (set! *optarg* (substring optarg (+ 1 i) l))
+			    (substring optarg 0 i))))))
 	  (else opt))))
diff --git a/getparam.scm b/getparam.scm
index 3e2d7f1..1e7b7c0 100644
--- a/getparam.scm
+++ b/getparam.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -19,12 +19,41 @@
 
 (require 'getopt)
 (require 'coerce)
+(require 'parameters)
+(require-if 'compiling 'printf)
+(require-if 'compiling 'common-list-functions)
 
-(define (getopt->parameter-list argc argv optnames arities types aliases
-				. description)
+;;@code{(require 'getopt-parameters)}
+;;@ftindex getopt-parameters
+
+;;@args optnames arities types aliases desc @dots{}
+;;Returns @var{*argv*} converted to a parameter-list.  @var{optnames} are
+;;the parameter-names.  @var{arities} and @var{types} are lists of symbols
+;;corresponding to @var{optnames}.
+;;
+;;@var{aliases} is a list of lists of strings or integers paired with
+;;elements of @var{optnames}.  Each one-character string will be treated
+;;as a single @samp{-} option by @code{getopt}.  Longer strings will be
+;;treated as long-named options (@pxref{Getopt, getopt--}).
+;;
+;;If the @var{aliases} association list has only strings as its
+;;@code{car}s, then all the option-arguments after an option (and before
+;;the next option) are adjoined to that option.
+;;
+;;If the @var{aliases} association list has integers, then each (string)
+;;option will take at most one option-argument.  Unoptioned arguments are
+;;collected in a list.  A @samp{-1} alias will take the last argument in
+;;this list; @samp{+1} will take the first argument in the list.  The
+;;aliases -2 then +2; -3 then +3; @dots{} are tried so long as a positive
+;;or negative consecutive alias is found and arguments remain in the list.
+;;Finally a @samp{0} alias, if found, absorbs any remaining arguments.
+;;
+;;In all cases, if unclaimed arguments remain after processing, a warning
+;;is signaled and #f is returned.
+(define (getopt->parameter-list optnames arities types aliases . description)
   (define (can-take-arg? opt)
     (not (eq? 'boolean (list-ref arities (position opt optnames)))))
-  (let ((progname (list-ref argv (+ -1 *optind*)))
+  (let ((progname (list-ref *argv* (+ -1 *optind*)))
 	(optlist '())
 	(long-opt-list '())
 	(optstring #f)
@@ -63,7 +92,8 @@
 		 (for-each (lambda (unc) (adjoin-val unc curopt)) unclaimeds)
 		 (set! unclaimeds '()))))))
       (cond ((not (null? unclaimeds))
-	     (slib:warn 'getopt->parameter-list 'arguments 'unclaimed unclaimeds)
+	     (getopt-barf "%s: Unclaimed argument '%s'"
+			  progname (car unclaimeds))
 	     (apply parameter-list->getopt-usage
 		    progname optnames arities types aliases description))
 	    (else parameter-list)))
@@ -94,34 +124,34 @@
      aliases)
     (set! optstring (list->string (cons #\: optlist)))
     (let loop ()
-      (let ((opt (getopt-- argc argv optstring)))
+      (let ((opt (getopt-- optstring)))
 	(case opt
 	  ((#\: #\?)
-	   (slib:warn 'getopt->parameter-list
-		      (case opt
-			((#\:) "argument missing after")
-			((#\?) "unrecognized option"))
-		      (string #\- getopt:opt))
+	   (getopt-barf (case opt
+			  ((#\:) "%s: argument missing after '-%c'")
+			  ((#\?) "%s: unrecognized option '-%c'"))
+			progname
+			getopt:opt)
 	   (apply parameter-list->getopt-usage
 		  progname optnames arities types aliases description))
 	  ((#f)
-	   (cond ((and (< *optind* argc)
-		       (string=? "-" (list-ref argv *optind*)))
+	   (cond ((and (< *optind* (length *argv*))
+		       (string=? "-" (list-ref *argv* *optind*)))
 		  (set! *optind* (+ 1 *optind*))
 		  (finish))
-		 ((< *optind* argc)
+		 ((< *optind* (length *argv*))
 		  (let ((topt (assoc curopt aliases)))
 		    (if topt (set! curopt (cadr topt)))
 		    (cond
 		     ((and positional? (not topt))
 		      (set! unclaimeds
-			    (cons (list-ref argv *optind*) unclaimeds))
+			    (cons (list-ref *argv* *optind*) unclaimeds))
 		      (set! *optind* (+ 1 *optind*)) (loop))
 		     ((and (member curopt optnames)
-			   (adjoin-val (list-ref argv *optind*) curopt))
+			   (adjoin-val (list-ref *argv* *optind*) curopt))
 		      (set! *optind* (+ 1 *optind*)) (loop))
 		     (else (slib:error 'getopt->parameter-list curopt
-				       (list-ref argv *optind*)
+				       (list-ref *argv* *optind*)
 				       'not 'supported)))))
 		 (else (finish))))
 	  (else
@@ -130,7 +160,7 @@
 	     (if topt (set! topt (cadr topt)))
 	     (cond
 	      ((not topt)
-	       (slib:warn "Option not recognized -" opt)
+	       (getopt-barf "%s: '--%s' option not recognized" progname opt)
 	       (apply parameter-list->getopt-usage
 		      progname optnames arities types aliases description))
 	      ((not (can-take-arg? topt))
@@ -138,9 +168,15 @@
 	       (loop))
 	      (*optarg* (set! curopt topt) (adjoin-val *optarg* curopt) (loop))
 	      (else
-;;;	       (slib:warn 'getopt->parameter-list "= missing for option--" opt)
+	       ;;(getopt-barf "%s: '--%s' option expects '='" progname opt)
+	       ;;(apply parameter-list->getopt-usage progname optnames arities types aliases description)
 	       (set! curopt topt) (loop))))))))))
 
+(define (getopt-barf . args)
+  (require 'printf)
+  (apply fprintf (current-error-port) args)
+  (newline (current-error-port)))
+
 (define (parameter-list->getopt-usage comname optnames arities types aliases
 				      . description)
   (require 'printf)
@@ -198,11 +234,17 @@
     (for-each (lambda (desc) (fprintf cep "  %s\\n" desc)) description))
   #f)
 
-(define (getopt->arglist argc argv optnames positions
+;;@args optnames positions arities types defaulters checks aliases desc @dots{}
+;;Like @code{getopt->parameter-list}, but converts @var{*argv*} to an
+;;argument-list as specified by @var{optnames}, @var{positions},
+;;@var{arities}, @var{types}, @var{defaulters}, @var{checks}, and
+;;@var{aliases}.  If the options supplied violate the @var{arities} or
+;;@var{checks} constraints, then a warning is signaled and #f is returned.
+(define (getopt->arglist optnames positions
 			 arities types defaulters checks aliases . description)
-  (define progname (list-ref argv (+ -1 *optind*)))
+  (define progname (list-ref *argv* (+ -1 *optind*)))
   (let* ((params (apply getopt->parameter-list
-			argc argv optnames arities types aliases description))
+			optnames arities types aliases description))
 	 (fparams (and params (fill-empty-parameters defaulters params))))
     (cond ((and (list? params)
 		(check-parameters checks fparams)
@@ -211,3 +253,49 @@
 			 progname optnames arities types aliases description))
 	  (else #f))))
 
+;;@noindent
+;;These @code{getopt} functions can be used with SLIB relational
+;;databases.  For an example, @xref{Using Databases, make-command-server}.
+;;
+;;@noindent
+;;If errors are encountered while processing options, directions for using
+;;the options (and argument strings @var{desc} @dots{}) are printed to
+;;@code{current-error-port}.
+;;
+;;@example
+;;(begin
+;;  (set! *optind* 1)
+;;  (set! *argv* '("cmd" "-?")
+;;  (getopt->parameter-list
+;;   '(flag number symbols symbols string flag2 flag3 num2 num3)
+;;   '(boolean optional nary1 nary single boolean boolean nary nary)
+;;   '(boolean integer symbol symbol string boolean boolean integer integer)
+;;   '(("flag" flag)
+;;     ("f" flag)
+;;     ("Flag" flag2)
+;;     ("B" flag3)
+;;     ("optional" number)
+;;     ("o" number)
+;;     ("nary1" symbols)
+;;     ("N" symbols)
+;;     ("nary" symbols)
+;;     ("n" symbols)
+;;     ("single" string)
+;;     ("s" string)
+;;     ("a" num2)
+;;     ("Abs" num3))))
+;;@print{}
+;;Usage: cmd [OPTION ARGUMENT ...] ...
+;;
+;;  -f, --flag
+;;  -o, --optional=<number>
+;;  -n, --nary=<symbols> ...
+;;  -N, --nary1=<symbols> ...
+;;  -s, --single=<string>
+;;      --Flag
+;;  -B
+;;  -a        <num2> ...
+;;      --Abs=<num3> ...
+;;
+;;ERROR: getopt->parameter-list "unrecognized option" "-?"
+;;@end example
diff --git a/getparam.txi b/getparam.txi
new file mode 100644
index 0000000..3d2594c
--- /dev/null
+++ b/getparam.txi
@@ -0,0 +1,85 @@
+@code{(require 'getopt-parameters)}
+@ftindex getopt-parameters
+
+
+@defun getopt->parameter-list optnames arities types aliases desc @dots{}
+
+Returns @var{*argv*} converted to a parameter-list.  @var{optnames} are
+the parameter-names.  @var{arities} and @var{types} are lists of symbols
+corresponding to @var{optnames}.
+
+@var{aliases} is a list of lists of strings or integers paired with
+elements of @var{optnames}.  Each one-character string will be treated
+as a single @samp{-} option by @code{getopt}.  Longer strings will be
+treated as long-named options (@pxref{Getopt, getopt--}).
+
+If the @var{aliases} association list has only strings as its
+@code{car}s, then all the option-arguments after an option (and before
+the next option) are adjoined to that option.
+
+If the @var{aliases} association list has integers, then each (string)
+option will take at most one option-argument.  Unoptioned arguments are
+collected in a list.  A @samp{-1} alias will take the last argument in
+this list; @samp{+1} will take the first argument in the list.  The
+aliases -2 then +2; -3 then +3; @dots{} are tried so long as a positive
+or negative consecutive alias is found and arguments remain in the list.
+Finally a @samp{0} alias, if found, absorbs any remaining arguments.
+
+In all cases, if unclaimed arguments remain after processing, a warning
+is signaled and #f is returned.
+@end defun
+
+@defun getopt->arglist optnames positions arities types defaulters checks aliases desc @dots{}
+
+Like @code{getopt->parameter-list}, but converts @var{*argv*} to an
+argument-list as specified by @var{optnames}, @var{positions},
+@var{arities}, @var{types}, @var{defaulters}, @var{checks}, and
+@var{aliases}.  If the options supplied violate the @var{arities} or
+@var{checks} constraints, then a warning is signaled and #f is returned.
+@end defun
+@noindent
+These @code{getopt} functions can be used with SLIB relational
+databases.  For an example, @xref{Using Databases, make-command-server}.
+
+@noindent
+If errors are encountered while processing options, directions for using
+the options (and argument strings @var{desc} @dots{}) are printed to
+@code{current-error-port}.
+
+@example
+(begin
+  (set! *optind* 1)
+  (set! *argv* '("cmd" "-?")
+  (getopt->parameter-list
+   '(flag number symbols symbols string flag2 flag3 num2 num3)
+   '(boolean optional nary1 nary single boolean boolean nary nary)
+   '(boolean integer symbol symbol string boolean boolean integer integer)
+   '(("flag" flag)
+     ("f" flag)
+     ("Flag" flag2)
+     ("B" flag3)
+     ("optional" number)
+     ("o" number)
+     ("nary1" symbols)
+     ("N" symbols)
+     ("nary" symbols)
+     ("n" symbols)
+     ("single" string)
+     ("s" string)
+     ("a" num2)
+     ("Abs" num3))))
+@print{}
+Usage: cmd [OPTION ARGUMENT ...] ...
+
+  -f, --flag
+  -o, --optional=<number>
+  -n, --nary=<symbols> ...
+  -N, --nary1=<symbols> ...
+  -s, --single=<string>
+      --Flag
+  -B
+  -a        <num2> ...
+      --Abs=<num3> ...
+
+ERROR: getopt->parameter-list "unrecognized option" "-?"
+@end example
diff --git a/glob.scm b/glob.scm
index d6e993b..382bbf3 100644
--- a/glob.scm
+++ b/glob.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -17,6 +17,10 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
+;;@code{(require 'filename)} or @code{(require 'glob)}
+;;@ftindex filename
+;;@ftindex glob
+
 (define (glob:pattern->tokens pat)
   (cond
    ((string? pat)
@@ -187,31 +191,87 @@
 		(else
 		 (loop (cdr inds) (cdr wild?) lits res)))))))))
 
+;;@body
+;;Returns a predicate which returns a non-false value if its string argument
+;;matches (the string) @var{pattern}, false otherwise.  Filename matching
+;;is like
+;;@cindex glob
+;;@dfn{glob} expansion described the bash manpage, except that names
+;;beginning with @samp{.} are matched and @samp{/} characters are not
+;;treated specially.
+;;
+;;These functions interpret the following characters specially in
+;;@var{pattern} strings:
+;;@table @samp
+;;@item *
+;;Matches any string, including the null string.
+;;@item ?
+;;Matches any single character.
+;;@item [@dots{}]
+;;Matches any one of the enclosed characters.  A pair of characters
+;;separated by a minus sign (-) denotes a range; any character lexically
+;;between those two characters, inclusive, is matched.  If the first
+;;character following the @samp{[} is a @samp{!} or a @samp{^} then any
+;;character not enclosed is matched.  A @samp{-} or @samp{]} may be
+;;matched by including it as the first or last character in the set.
+;;@end table
+(define (filename:match?? pattern)
+  (glob:make-matcher pattern char=? char<=?))
+(define (filename:match-ci?? pattern)
+  (glob:make-matcher pattern char-ci=? char-ci<=?))
 
-(define (glob:match?? pat)
-  (glob:make-matcher pat char=? char<=?))
-(define (glob:match-ci?? pat)
-  (glob:make-matcher pat char-ci=? char-ci<=?))
-(define filename:match?? glob:match??)
-(define filename:match-ci?? glob:match-ci??)
 
-(define (glob:substitute?? pat templ)
-  (cond ((procedure? templ)
-	 (glob:caller-with-matches pat templ char=? char<=?))
-	((string? templ)
-	 (glob:make-substituter pat templ char=? char<=?))
+;;@args pattern template
+;;Returns a function transforming a single string argument according to
+;;glob patterns @var{pattern} and @var{template}.  @var{pattern} and
+;;@var{template} must have the same number of wildcard specifications,
+;;which need not be identical.  @var{pattern} and @var{template} may have
+;;a different number of literal sections. If an argument to the function
+;;matches @var{pattern} in the sense of @code{filename:match??} then it
+;;returns a copy of @var{template} in which each wildcard specification is
+;;replaced by the part of the argument matched by the corresponding
+;;wildcard specification in @var{pattern}.  A @code{*} wildcard matches
+;;the longest leftmost string possible.  If the argument does not match
+;;@var{pattern} then false is returned.
+;;
+;;@var{template} may be a function accepting the same number of string
+;;arguments as there are wildcard specifications in @var{pattern}.  In
+;;the case of a match the result of applying @var{template} to a list
+;;of the substrings matched by wildcard specifications will be returned,
+;;otherwise @var{template} will not be called and @code{#f} will be returned.
+(define (filename:substitute?? pattern template)
+  (cond ((procedure? template)
+	 (glob:caller-with-matches pattern template char=? char<=?))
+	((string? template)
+	 (glob:make-substituter pattern template char=? char<=?))
 	(else
-	 (slib:error 'glob:substitute "bad second argument" templ))))
-(define (glob:substitute-ci?? pat templ)
-  (cond ((procedure? templ)
-	 (glob:caller-with-matches pat templ char-ci=? char-ci<=?))
-	((string? templ)
-	 (glob:make-substituter pat templ char-ci=? char-ci<=?))
+	 (slib:error 'filename:substitute?? "bad second argument" template))))
+(define (filename:substitute-ci?? pattern template)
+  (cond ((procedure? template)
+	 (glob:caller-with-matches pattern template char-ci=? char-ci<=?))
+	((string? template)
+	 (glob:make-substituter pattern template char-ci=? char-ci<=?))
 	(else
-	 (slib:error 'glob:substitute "bad second argument" templ))))
-(define filename:substitute?? glob:substitute??)
-(define filename:substitute-ci?? glob:substitute-ci??)
+	 (slib:error 'filename:substitute-ci?? "bad second argument" template))))
+
+;;@example
+;;((filename:substitute?? "scm_[0-9]*.html" "scm5c4_??.htm")
+;; "scm_10.html")
+;;@result{} "scm5c4_10.htm"
+;;((filename:substitute?? "??" "beg?mid?end") "AZ")
+;;@result{} "begAmidZend"
+;;((filename:substitute?? "*na*" "?NA?") "banana")
+;;@result{} "banaNA"
+;;((filename:substitute?? "?*?" (lambda (s1 s2 s3) (string-append s3 s1)))
+;; "ABZ")
+;;@result{} "ZA"
+;;@end example
 
+;;@body
+;;@var{str} can be a string or a list of strings.  Returns a new string
+;;(or strings) similar to @code{str} but with the suffix string @var{old}
+;;removed and the suffix string @var{new} appended.  If the end of
+;;@var{str} does not match @var{old}, an error is signaled.
 (define (replace-suffix str old new)
   (let* ((f (glob:make-substituter (list "*" old) (list "*" new)
 				   char=? char<=?))
@@ -222,3 +282,37 @@
     (if (pair? str)
 	(map g str)
 	(g str))))
+
+;;@example
+;;(replace-suffix "/usr/local/lib/slib/batch.scm" ".scm" ".c")
+;;@result{} "/usr/local/lib/slib/batch.c"
+;;@end example
+
+;;@args proc k
+;;@args proc
+;;Calls @1 with @2 arguments, strings returned by successive calls to
+;;@code{tmpnam}.
+;;If @1 returns, then any files named by the arguments to @1 are
+;;deleted automatically and the value(s) yielded by the @1 is(are)
+;;returned.  @2 may be ommited, in which case it defaults to @code{1}.
+;;
+;;@args proc suffix1 ...
+;;Calls @1 with strings returned by successive calls to @code{tmpnam},
+;;each with the corresponding @var{suffix} string appended.
+;;If @1 returns, then any files named by the arguments to @1 are
+;;deleted automatically and the value(s) yielded by the @1 is(are)
+;;returned.
+(define (call-with-tmpnam proc . suffi)
+  (define (do-call paths)
+    (let ((ans (apply proc paths)))
+      (for-each (lambda (path) (if (file-exists? path) (delete-file path)))
+		paths)
+      ans))
+  (cond ((null? suffi) (do-call (list (tmpnam))))
+	((and (= 1 (length suffi)) (number? (car suffi)))
+	 (do ((cnt (if (null? suffi) 0 (+ -1 (car suffi))) (+ -1 cnt))
+	      (paths '() (cons (tmpnam) paths)))
+	     ((negative? cnt)
+	      (do-call paths))))
+	(else (do-call (map (lambda (suffix) (string-append (tmpnam) suffix))
+			    suffi)))))
diff --git a/glob.txi b/glob.txi
new file mode 100644
index 0000000..d83b66b
--- /dev/null
+++ b/glob.txi
@@ -0,0 +1,100 @@
+@code{(require 'filename)} or @code{(require 'glob)}
+@ftindex filename
+@ftindex glob
+
+
+@defun filename:match?? pattern
+@defunx filename:match-ci?? pattern
+
+Returns a predicate which returns a non-false value if its string argument
+matches (the string) @var{pattern}, false otherwise.  Filename matching
+is like
+@cindex glob
+@dfn{glob} expansion described the bash manpage, except that names
+@cindex glob
+beginning with @samp{.} are matched and @samp{/} characters are not
+treated specially.
+
+These functions interpret the following characters specially in
+@var{pattern} strings:
+@table @samp
+@item *
+Matches any string, including the null string.
+@item ?
+Matches any single character.
+@item [@dots{}]
+Matches any one of the enclosed characters.  A pair of characters
+separated by a minus sign (-) denotes a range; any character lexically
+between those two characters, inclusive, is matched.  If the first
+character following the @samp{[} is a @samp{!} or a @samp{^} then any
+character not enclosed is matched.  A @samp{-} or @samp{]} may be
+matched by including it as the first or last character in the set.
+@end table
+@end defun
+
+@defun filename:substitute?? pattern template
+@defunx filename:substitute-ci?? pattern template
+
+Returns a function transforming a single string argument according to
+glob patterns @var{pattern} and @var{template}.  @var{pattern} and
+@var{template} must have the same number of wildcard specifications,
+which need not be identical.  @var{pattern} and @var{template} may have
+a different number of literal sections. If an argument to the function
+matches @var{pattern} in the sense of @code{filename:match??} then it
+returns a copy of @var{template} in which each wildcard specification is
+replaced by the part of the argument matched by the corresponding
+wildcard specification in @var{pattern}.  A @code{*} wildcard matches
+the longest leftmost string possible.  If the argument does not match
+@var{pattern} then false is returned.
+
+@var{template} may be a function accepting the same number of string
+arguments as there are wildcard specifications in @var{pattern}.  In
+the case of a match the result of applying @var{template} to a list
+of the substrings matched by wildcard specifications will be returned,
+otherwise @var{template} will not be called and @code{#f} will be returned.
+@end defun
+@example
+((filename:substitute?? "scm_[0-9]*.html" "scm5c4_??.htm")
+ "scm_10.html")
+@result{} "scm5c4_10.htm"
+((filename:substitute?? "??" "beg?mid?end") "AZ")
+@result{} "begAmidZend"
+((filename:substitute?? "*na*" "?NA?") "banana")
+@result{} "banaNA"
+((filename:substitute?? "?*?" (lambda (s1 s2 s3) (string-append s3 s1)))
+ "ABZ")
+@result{} "ZA"
+@end example
+
+
+@defun replace-suffix str old new
+
+@var{str} can be a string or a list of strings.  Returns a new string
+(or strings) similar to @code{str} but with the suffix string @var{old}
+removed and the suffix string @var{new} appended.  If the end of
+@var{str} does not match @var{old}, an error is signaled.
+@end defun
+@example
+(replace-suffix "/usr/local/lib/slib/batch.scm" ".scm" ".c")
+@result{} "/usr/local/lib/slib/batch.c"
+@end example
+
+
+@defun call-with-tmpnam proc k
+
+
+@defunx call-with-tmpnam proc
+Calls @var{proc} with @var{k} arguments, strings returned by successive calls to
+@code{tmpnam}.
+If @var{proc} returns, then any files named by the arguments to @var{proc} are
+deleted automatically and the value(s) yielded by the @var{proc} is(are)
+returned.  @var{k} may be ommited, in which case it defaults to @code{1}.
+
+
+@defunx call-with-tmpnam proc suffix1 @dots{}
+Calls @var{proc} with strings returned by successive calls to @code{tmpnam},
+each with the corresponding @var{suffix} string appended.
+If @var{proc} returns, then any files named by the arguments to @var{proc} are
+deleted automatically and the value(s) yielded by the @var{proc} is(are)
+returned.
+@end defun
diff --git a/grapheps.ps b/grapheps.ps
new file mode 100644
index 0000000..87658dd
--- /dev/null
+++ b/grapheps.ps
@@ -0,0 +1,344 @@
+%%EndComments
+/plotdict 100 dict def
+plotdict begin
+
+% Definitions so that internal assignments are bound before setting.
+/DATA 0 def
+/DEN 0 def
+/DIAG 0 def
+/DIAG2 0 def
+/DLTA 0 def
+/EXPSN 0 def
+/GPROCS 0 def
+/GD 6 def
+/GR 3 def
+/IDX 0 def
+/ISIZ 0 def
+/MAX 0 def
+/MIN 0 def
+/NUM 0 def
+/PLOT-bmargin 0 def
+/PLOT-lmargin 0 def
+/PLOT-rmargin 0 def
+/PLOT-tmargin 0 def
+/PROC 0 def
+/ROW 0 def
+/TXT 0 def
+/WPAGE 0 def
+/X-COORD 0 def
+/XDX 0 def
+/XOFF 0 def
+/XPARTS 0 def
+/XRNG 0 def
+/XSCL 0 def
+/XSTEP 0 def
+/XSTEPH 0 def
+/XTSCL 0 def
+/XWID 0 def
+/Y-COORD 0 def
+/YDX 0 def
+/YHIT 0 def
+/YOFF 0 def
+/YPARTS 0 def
+/YRNG 0 def
+/YSCL 0 def
+/YSTEP 0 def
+/YSTEPH 0 def
+/YTSCL 0 def
+/graphrect 0 def
+/plotrect 0 def
+
+% Here are the procedure-arrays for passing as the third argument to
+% plot-column.  Plot-column moves to the first coordinate before
+% calls to the first procedure.  Thus both line and scatter graphs are
+% supported.  Many additional glyph types can be produced as
+% combinations of these types.  This is best accomplished by calling
+% plot-column with each component.
+
+% GD and GR are the graphic-glyph diameter and radius.
+% DIAG and DIAG2, used in /cross are diagonal and twice diagonal.
+% gtrans maps x, y coordinates on the stack to 72dpi page coordinates.
+
+% Render line connecting points
+/line    [{} {lineto} {}] bind def
+/mountain [{currentpoint 2 copy pop bottomedge moveto lineto}
+	   {lineto}
+	   {currentpoint pop bottomedge lineto closepath fill}] bind def
+/cloud    [{currentpoint 2 copy pop topedge moveto lineto}
+	   {lineto}
+	   {currentpoint pop topedge lineto closepath fill}] bind def
+% Render lines from x-axis to points
+/impulse [{} {moveto currentpoint pop 0 lineto} {}] bind def
+/bargraph [{} {exch GR sub exch 0 exch GD exch rectstroke} {}] bind def
+
+% Solid round dot.
+/disc    [{GD setlinewidth 1 setlinecap}
+			 {moveto 0 0 rlineto} {}] bind def
+% Minimal point -- invisible if linewidth is 0.
+/point   [{1 setlinecap} {moveto 0 0 rlineto} {}] bind def
+% Square box.
+/square  [{} {GR sub exch GR sub exch GD dup rectstroke} {}] bind def
+% Square box at 45.o
+/diamond [{}
+	  {2 copy GR add moveto
+	   GR neg GR neg rlineto GR GR neg rlineto
+		   GR GR rlineto GR neg GR rlineto
+	   closepath}
+	  {}] bind def
+% Plus Sign
+/plus	 [{}
+	  {       GR sub moveto  0 GD rlineto
+	   GR neg GR neg rmoveto GD 0 rlineto}
+	  {}] bind def
+% X Sign
+/cross   [{/DIAG GR .707 mul def /DIAG2 DIAG 2 mul def}
+	  {exch DIAG sub exch DIAG add moveto DIAG2 dup neg rlineto
+			  DIAG2 neg 0 rmoveto     DIAG2 dup rlineto}
+	  {}] bind def
+% Triangle pointing upward
+/triup   [{}
+	  {2 copy GR 1.12 mul add moveto GR neg GR -1.62 mul rlineto
+		      GR 2 mul 0 rlineto GR neg GR  1.62 mul rlineto
+	   closepath}
+	  {}] bind def
+% Triangle pointing downward
+/tridown [{}
+	  {2 copy GR 1.12 mul sub moveto GR neg GR  1.62 mul rlineto
+		      GR 2 mul 0 rlineto GR neg GR -1.62 mul rlineto
+	   closepath}
+	  {}] bind def
+/pentagon [{}
+	   {gsave translate 0 GR moveto 4 {72 rotate 0 GR lineto} repeat
+		  closepath stroke grestore}
+	   {}] bind def
+/circle   [{stroke} {GR 0 360 arc stroke} {}] bind def
+
+% ( TITLE ) ( SUBTITLE )
+/title-top
+{ dup stringwidth pop -2 div plotrect 0 get plotrect 2 get 2 div add add
+  plotrect 1 get plotrect 3 get add pointsize .4 mul add moveto show
+  dup stringwidth pop -2 div plotrect 0 get plotrect 2 get 2 div add add
+  plotrect 1 get plotrect 3 get add pointsize 1.4 mul add moveto show
+} bind def
+
+% ( TITLE ) ( SUBTITLE )
+/title-bottom
+{ dup stringwidth pop -2 div plotrect 0 get plotrect 2 get 2 div add add
+  plotrect 1 get pointsize -2 mul add moveto show
+  dup stringwidth pop -2 div plotrect 0 get plotrect 2 get 2 div add add
+  plotrect 1 get pointsize -1 mul add moveto show
+} bind def
+
+% Plots column K against column J of given two-dimensional ARRAY.
+% The arguments are:
+%   [ ARRAY J K ] J and K are column-indexes into ARRAY
+%   [ PREAMBLE RENDER POSTAMBLE ] Plotting procedures:
+%       PREAMBLE  - Executed once before plotting row
+%       RENDER    - Called with each pair of coordinates to plot
+%       POSTAMBLE - Called once after plotting row (often does stroke)
+/plot-column
+{ /GPROCS exch def aload pop /YDX exch def /XDX exch def /DATA exch def
+  /GD glyphsize def
+  /GR GD .5 mul def
+  gsave
+    /ROW DATA 0 get def ROW XDX get ROW YDX get gtrans moveto
+    GPROCS 0 get exec % preamble
+    /PROC GPROCS 1 get def DATA {dup XDX get exch YDX get gtrans PROC} forall
+    GPROCS 2 get exec stroke % postamble
+  grestore
+} bind def
+
+/whole-page
+{clippath pathbbox 2 index sub exch 3 index sub exch 4 array astore} bind def
+
+/partition-page
+{ /YPARTS exch def /XPARTS exch def /WPAGE exch def
+  /XWID WPAGE 2 get XPARTS div def /YHIT WPAGE 3 get YPARTS div def
+  /Y-COORD WPAGE 1 get def
+  YPARTS
+  { /X-COORD WPAGE 0 get WPAGE 2 get add XWID sub def
+    XPARTS {[X-COORD Y-COORD XWID YHIT]
+	    /X-COORD X-COORD XWID sub def} repeat
+    /Y-COORD Y-COORD YHIT add def
+
author	Steve Langasek <vorlon@debian.org>	2005-01-10 08:53:33 +0000
committer	Bryan Newbold <bnewbold@robocracy.org>	2017-02-20 00:05:30 -0800
commit	e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch)
tree	abbf06041619e445f9d0b772b0d58132009d8234
parent	f559c149c83da84d0b1c285f0298c84aec564af9 (diff)
parent	8466d8cfa486fb30d1755c4261b781135083787b (diff)
download	slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz