X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdocumentation.lisp;h=9c562b31633732bcf97cceaedd682b8b7503f65a;hb=2ef330d818799fe54587bdcb4c626b397ca15266;hp=15ae5d02c5aad143953be9f1a0889377dc2719dd;hpb=cd176690400f8b6fa23faa4dc6fa8494bcbce480;p=sbcl.git

diff --git a/src/pcl/documentation.lisp b/src/pcl/documentation.lisp
index 15ae5d0..9c562b3 100644
--- a/src/pcl/documentation.lisp
+++ b/src/pcl/documentation.lisp
@@ -31,12 +31,9 @@
   (%fun-doc x))
 
 (defmethod documentation ((x list) (doc-type (eql 'function)))
-  ;; FIXME: could test harder to see whether it's a SETF function name,
-  ;; then call WARN
-  (when (eq (first x) 'setf)	; Give up if not a setf function name.
-    (or (values (info :setf :documentation (second x)))
-	;; Try the pcl function documentation.
-	(and (fboundp x) (documentation (fdefinition x) t)))))
+  (and (legal-fun-name-p x)
+       (fboundp x)
+       (documentation (fdefinition x) t)))
 
 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
   (or (values (info :function :documentation x))
@@ -47,7 +44,7 @@
   (values (info :setf :documentation x)))
 
 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function)))
-  (setf (info :setf :documentation (cadr x)) new-value))
+  (setf (info :function :documentation x) new-value))
 
 (defmethod (setf documentation) (new-value
 				 (x symbol)
@@ -71,28 +68,12 @@
 ;;; other code which does low-level hacking of packages.. -- WHN 19991203
 
 ;;; types, classes, and structure names
-(defmethod documentation ((x cl:structure-class) (doc-type (eql 't)))
-  (values (info :type :documentation (cl:class-name x))))
-
 (defmethod documentation ((x structure-class) (doc-type (eql 't)))
   (values (info :type :documentation (class-name x))))
 
-(defmethod documentation ((x cl:standard-class) (doc-type (eql 't)))
-  (or (values (info :type :documentation (cl:class-name x)))
-      (let ((pcl-class (sb-kernel:class-pcl-class x)))
-	(and pcl-class (plist-value pcl-class 'documentation)))))
-
-(defmethod documentation ((x cl:structure-class) (doc-type (eql 'type)))
-  (values (info :type :documentation (cl:class-name x))))
-
 (defmethod documentation ((x structure-class) (doc-type (eql 'type)))
   (values (info :type :documentation (class-name x))))
 
-(defmethod documentation ((x cl:standard-class) (doc-type (eql 'type)))
-  (or (values (info :type :documentation (cl:class-name x)))
-      (let ((pcl-class (sb-kernel:class-pcl-class x)))
-	(and pcl-class (plist-value pcl-class 'documentation)))))
-
 (defmethod documentation ((x symbol) (doc-type (eql 'type)))
   (or (values (info :type :documentation x))
       (let ((class (find-class x nil)))
@@ -104,27 +85,17 @@
     (values (info :type :documentation x))))
 
 (defmethod (setf documentation) (new-value
-				 (x cl:structure-class)
-				 (doc-type (eql 't)))
-  (setf (info :type :documentation (cl:class-name x)) new-value))
-
-(defmethod (setf documentation) (new-value
 				 (x structure-class)
 				 (doc-type (eql 't)))
   (setf (info :type :documentation (class-name x)) new-value))
 
 (defmethod (setf documentation) (new-value
-				 (x cl:structure-class)
-				 (doc-type (eql 'type)))
-  (setf (info :type :documentation (cl:class-name x)) new-value))
-
-(defmethod (setf documentation) (new-value
 				 (x structure-class)
 				 (doc-type (eql 'type)))
   (setf (info :type :documentation (class-name x)) new-value))
 
 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'type)))
-  (if (structure-type-p x)	; Catch structures first.
+  (if (or (structure-type-p x) (condition-type-p x))
       (setf (info :type :documentation x) new-value)
       (let ((class (find-class x nil)))
 	(if class