1.0.10.51: New function: THREAD-YIELD

[sbcl.git] / doc / manual / docstrings.lisp

diff --git a/doc/manual/docstrings.lisp b/doc/manual/docstrings.lisp
index 2233c0e..1177d3d 100644 (file)
--- a/doc/manual/docstrings.lisp
+++ b/doc/manual/docstrings.lisp
@@ -67,7 +67,8 @@
   "A list of symbols accepted as second argument of `documentation'")
 
 (defparameter *character-replacements*
-  '((#\* . "star") (#\/ . "slash") (#\+ . "plus"))
+  '((#\* . "star") (#\/ . "slash") (#\+ . "plus")
+    (#\< . "lt") (#\> . "gt"))
   "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.")
@@ -117,6 +118,11 @@ you deserve to lose.")
 (defmethod specializer-name ((specializer class))
   (class-name specializer))
 
+(defun ensure-class-precedence-list (class)
+  (unless (class-finalized-p class)
+    (finalize-inheritance class))
+  (class-precedence-list class))
+
 (defun specialized-lambda-list (method)
   ;; courtecy of AMOP p. 61
   (let* ((specializers (method-specializers method))
@@ -270,6 +276,10 @@ symbols or lists of symbols."))
    (children :initarg :children :initform nil :reader get-children)
    (package :initform *documentation-package* :reader get-package)))
 
+(defmethod print-object ((documentation documentation) stream)
+  (print-unreadable-object (documentation stream :type t)
+    (princ (list (get-kind documentation) (get-name documentation)) stream)))
+
 (defgeneric make-documentation (x doc-type string))
 
 (defmethod make-documentation ((x package) doc-type string)
@@ -290,11 +300,11 @@ symbols or lists of symbols."))
                      ((typep fdef 'generic-function)
                       (assert (or (symbolp name) (setf-name-p name)))
                       'generic-function)
-                     (t
+                     (fdef
                       (assert (or (symbolp name) (setf-name-p name)))
                       'function)))
          (children (when (eq kind 'generic-function)
-                             (collect-gf-documentation fdef))))
+                     (collect-gf-documentation fdef))))
     (make-instance 'documentation
                    :name (name x)
                    :string string
@@ -348,7 +358,7 @@ there is no corresponding docstring."
 
 (defun lambda-list (doc)
   (case (get-kind doc)
-    ((package constant variable type structure class condition)
+    ((package constant variable type structure class condition nil)
      nil)
     (method
      (third (get-name doc)))
@@ -692,19 +702,30 @@ followed another tabulation label or a tabulation body."
   (when (member (get-kind doc) '(class structure condition))
     (let ((name (get-name doc)))
       ;; class precedence list
-      (format *texinfo-output* "Class precedence list: @code{~(~{@w{~A}~^, ~}~)}~%~%"
+      (format *texinfo-output* "Class precedence list: @code{~(~{@lw{~A}~^, ~}~)}~%~%"
               (remove-if (lambda (class)  (hide-superclass-p name class))
-                         (mapcar #'class-name (class-precedence-list (find-class name)))))
+                         (mapcar #'class-name (ensure-class-precedence-list (find-class name)))))
       ;; slots
       (let ((slots (remove-if (lambda (slot) (hide-slot-p name slot))
                               (class-direct-slots (find-class name)))))
         (when slots
           (format *texinfo-output* "Slots:~%@itemize~%")
           (dolist (slot slots)
-            (format *texinfo-output* "@item ~(@code{~A} ~
-                                     ~@[--- initargs: @code{~{@w{~S}~^, ~}}~]~)~%~%"
+            (format *texinfo-output*
+                    "@item ~(@code{~A}~#[~:; --- ~]~
+                      ~:{~2*~@[~2:*~A~P: ~{@code{@w{~S}}~^, ~}~]~:^; ~}~)~%~%"
                     (slot-definition-name slot)
-                    (slot-definition-initargs slot))
+                    (remove
+                     nil
+                     (mapcar
+                      (lambda (name things)
+                        (if things
+                            (list name (length things) things)))
+                      '("initarg" "reader"  "writer")
+                      (list
+                       (slot-definition-initargs slot)
+                       (slot-definition-readers slot)
+                       (slot-definition-writers slot)))))
             ;; FIXME: Would be neater to handler as children
             (write-texinfo-string (docstring slot t)))
           (format *texinfo-output* "@end itemize~%~%"))))))