X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdescribe.lisp;h=4fd565aa38ca85154bcb0d4178fa61e1b5e54607;hb=0b96758f3645dff3e681d82cc97ddab1faae27ac;hp=e9ae2a43752412b721f30dc8c5db3dfe1e116a89;hpb=648b48d2406f6d6f2bf341bf8ed350aac85398d0;p=sbcl.git

diff --git a/src/pcl/describe.lisp b/src/pcl/describe.lisp
index e9ae2a4..4fd565a 100644
--- a/src/pcl/describe.lisp
+++ b/src/pcl/describe.lisp
@@ -91,39 +91,47 @@
 
 (defmethod describe-object ((fun standard-generic-function) stream)
   (format stream "~&~A is a generic function." fun)
-  (format stream "~&Its arguments are:~&  ~S"
+  (when (documentation fun t)
+    (format stream "~&Its documentation is: ~A" (documentation fun t)))
+  (format stream "~&Its lambda-list is:~&  ~S"
 	  (generic-function-pretty-arglist fun))
+  (format stream "~&Its method-combination is:~&  ~S"
+	  (generic-function-method-combination fun))
   (let ((methods (generic-function-methods fun)))
     (if (null methods)
 	(format stream "~&It has no methods.~%")
 	(let ((gf-name (generic-function-name fun)))
-	  (format stream "Its methods are:")
+	  (format stream "~&Its methods are:")
 	  (dolist (method methods)
-	    (format stream "~2%    (~A ~{~S ~}~:S) =>"
+	    (format stream "~&  (~A ~{~S ~}~:S)~%"
 		    gf-name
 		    (method-qualifiers method)
 		    (unparse-specializers method))
-	    (describe (or (method-fast-function method)
-			  (method-function method))
-		      stream))))))
+	    (when (documentation method t)
+	      (format stream "~&    Method documentation: ~A"
+		      (documentation method t))))))))
 
 (defmethod describe-object ((class class) stream)
   (flet ((pretty-class (c) (or (class-name c) c)))
     (macrolet ((ft (string &rest args) `(format stream ,string ,@args)))
-      (ft "~&~S is a class. It is an instance of ~S."
+      (ft "~&~@<~S is a class. It is an instance of ~S.~:@>"
 	  class (pretty-class (class-of class)))
       (let ((name (class-name class)))
 	(if name
 	    (if (eq class (find-class name nil))
-		(ft "~&Its proper name is ~S." name)
-		(ft "~&Its name is ~S, but this is not a proper name." name))
-	    (ft "It has no name (the name is NIL).~%")))
-      (ft "~&~@<The direct superclasses are: ~:S, and the direct~%~
-	   subclasses are: ~:S. The class precedence list is:~2I~_~S~I~_~
-	   There are ~S methods specialized for this class.~:>~%"
+		(ft "~&~@<Its proper name is ~S.~@:>" name)
+		(ft "~&~@<Its name is ~S, but this is not a proper name.~@:>"
+		    name))
+	    (ft "~&~@<It has no name (the name is NIL).~@:>")))
+      (ft "~&~@<The direct superclasses are: ~:S, and the direct ~
+	   subclasses are: ~:S.~I~_The class is ~:[not ~;~]finalized~
+           ~:[. ~;; its class precedence list is:~2I~_~:*~S.~]~I~_~
+	   There ~[are~;is~:;are~] ~:*~S method~:P specialized for ~
+           this class.~:@>~%"
 	  (mapcar #'pretty-class (class-direct-superclasses class))
 	  (mapcar #'pretty-class (class-direct-subclasses class))
-	  (mapcar #'pretty-class (class-precedence-list class))
+	  (class-finalized-p class)
+	  (mapcar #'pretty-class (cpl-or-nil class))
 	  (length (specializer-direct-methods class))))))
 
 (defmethod describe-object ((package package) stream)