From b74667c423a9a6f0cc010e33aa94aa9a7cdc8c5f Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Wed, 7 Apr 2004 08:56:59 +0000
Subject: [PATCH] 0.8.9.25: 	Too late!  Merge fixes to docstrings
 mechanism 	... Make it work (including being able to
 load contribs) on 		freshly-dumped uninstalled
 cores; 	... transform #\+ to "plus" 	... generate
 documentation for all nominally public packages 	
 (note that because of reexports, SB-ALIEN:* gets 	
 documented as common-lisp-var-star.  Probably 	
 fixable)

---
 doc/manual/docstrings.lisp |   45 +++++++++++++++++---------------------------
 doc/manual/docstrings.sh   |   11 +++--------
 version.lisp-expr          |    2 +-
 3 files changed, 21 insertions(+), 37 deletions(-)

diff --git a/doc/manual/docstrings.lisp b/doc/manual/docstrings.lisp
index 44de495..8716cf4 100644
--- a/doc/manual/docstrings.lisp
+++ b/doc/manual/docstrings.lisp
@@ -5,8 +5,7 @@
 
 #+sbcl
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (require 'sb-introspect)
-  )
+  (require 'sb-introspect))
 
 (defparameter *documentation-types*
   '(compiler-macro
@@ -35,6 +34,7 @@
   (let* ((package (find-package package))
          (package-doc (documentation package t))
          (result nil))
+    (check-type package package)
     (do-external-symbols (symbol package)
       (let ((docs (documentation-for-symbol symbol)))
         (when docs (setf result (nconc docs result)))))
@@ -61,18 +61,10 @@
 ;;; Begin, rest and end of definition.
 
 (defun argument-list (fname)
-  (prog1
-      ;; arglist accessors looked up in slime; FIXME: can we depend on
-      ;; swank instead?  Some of the arglist accessors (not found
-      ;; here) are hairy ...
-      #+clisp (ext:arglist fname)
-      #+sbcl (sb-introspect:function-arglist fname)
-      #+openmcl (ccl:arglist fname)
-      '(arglist not supported in this implementation)
-  ))
+  (sb-introspect:function-arglist fname))
 
 (defvar *character-replacements*
-  '((#\* . "star") (#\/ . "slash"))
+  '((#\* . "star") (#\/ . "slash") (#\+ . "plus"))
   "Characters and their replacement names that `alphanumize'
   uses.  If the replacements contain any of the chars they're
   supposed to replace, you deserve to lose.")
@@ -115,11 +107,12 @@
              (package "package")
              (setf "setf-expander")
              (structure "struct")
-             (type (if (find-class symbol)
-                       (if (documentation symbol 'structure) ; cheesy structness check
-                           "struct"
-                           "class")
-                       "type"))
+             (type (let ((class (find-class symbol)))
+		     (etypecase class
+		       (structure-class "struct")
+		       (standard-class "class")
+		       (sb-pcl::condition-class "condition")
+		       (null "type"))))
              (variable (if (constantp symbol)
                            "constant"
                            "var")))
@@ -137,11 +130,12 @@
     (package "@deffn Package")
     (setf "@deffn {Setf Expander}")
     (structure "@deftp Structure")
-    (type (if (find-class symbol)
-              (if (documentation symbol 'structure) ; cheesy structness check
-                  "@deftp Structure"
-                  "@deftp Class")
-              "@deftp Type"))
+    (type (let ((class (find-class symbol)))
+	    (etypecase class
+	      (structure-class "@deftp Structure")
+	      (standard-class "@deftp Class")
+	      (sb-pcl::condition-class "@deftp Condition")
+	      (null "@deftp Type"))))
     (variable (if (constantp symbol)
                   "@defvr Constant"
                   "@defvar"))))
@@ -176,12 +170,7 @@
     (method-combination "@end deffn")
     (package "@end deffn")
     (setf "@end deffn")
-    ;;(structure "@end deftp") ; caught by `type'
-    (type (if (find-class symbol)
-              (if (documentation symbol 'structure) ; cheesy structness check
-                  "@end deftp"
-                  "@end deftp")
-              "@end deftp"))
+    (type "@end deftp")
     (variable (if (constantp symbol)
                   "@end defvr"
                   "@defvar"))))
diff --git a/doc/manual/docstrings.sh b/doc/manual/docstrings.sh
index 51a971d..4b499a9 100644
--- a/doc/manual/docstrings.sh
+++ b/doc/manual/docstrings.sh
@@ -10,24 +10,20 @@
 # more information.
 
 # how we invoke SBCL
-#
-# Until sbcl-0.6.12.8, the shell variable SBCL was bound to a relative
-# pathname, but now we take care to bind it to an absolute pathname (still
-# generated relative to `pwd` in the tests/ directory) so that tests
-# can chdir before invoking SBCL and still work.
 
 # We create the documentation from the in-tree sbcl if it is found,
 # else an installed sbcl is used.
 sbclsystem=`pwd`/../../src/runtime/sbcl
 if [ -e $sbclsystem ] 
 then
-SBCL="${1:-$sbclsystem --core `pwd`/../output/sbcl.core}"
+SBCL="${1:-$sbclsystem --core `pwd`/../../output/sbcl.core}"
+export SBCL_HOME=`pwd`/../../contrib
 else
 SBCL="${1:-`which sbcl`}"
 fi
 
 # List of package names that documentation will be created for.
-PACKAGES=":SB-EXT"
+PACKAGES=":SB-ALIEN :SB-EXT :SB-GRAY :SB-MOP :SB-PROFILE :SB-THREAD"
 
 # Output directory.  This has to end with a slash (it's interpreted by
 # Lisp's `pathname' function) or you lose.
@@ -35,5 +31,4 @@ DOCSTRINGDIR="${DOCSTRINGDIR:-docstrings/}"
 
 
 echo /creating docstring snippets from SBCL=\'$SBCL\' for packages \'$PACKAGES\'
-
 echo "(progn (load \"docstrings.lisp\") (docstrings-to-texinfo \"$DOCSTRINGDIR\" $PACKAGES) (sb-ext:quit))" | $SBCL --noinform --sysinit /dev/null --userinit /dev/null --noprint --disable-debugger
diff --git a/version.lisp-expr b/version.lisp-expr
index 9979de3..113a7a0 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.9.24"
+"0.8.9.25"
-- 
1.7.10.4