X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdescribe.lisp;h=e04d40cb987e09281f7d95ffb93d2e784b32a144;hb=0c7ffa8fb85a94482814835c9f28abfd0400ab99;hp=d9a4e2b5e1cae396b969d521338d86c23b2c61cf;hpb=204f2fa9771ad9e55718dc76205afec7d11b3011;p=sbcl.git diff --git a/src/pcl/describe.lisp b/src/pcl/describe.lisp index d9a4e2b..e04d40c 100644 --- a/src/pcl/describe.lisp +++ b/src/pcl/describe.lisp @@ -26,8 +26,6 @@ (in-package "SB-PCL") -(declaim #.*optimize-byte-compilation*) - (defmethod slots-to-inspect ((class slot-class) (object slot-object)) (class-slots class)) @@ -90,17 +88,22 @@ (defvar *describe-metaobjects-as-objects-p* nil) (defmethod describe-object ((fun standard-generic-function) stream) - (format stream "~A is a generic function.~%" fun) + (format stream "~&~A is a generic function.~%" fun) (format stream "Its arguments are:~% ~S~%" (generic-function-pretty-arglist fun)) - (format stream "Its methods are:") - (dolist (method (generic-function-methods fun)) - (format stream "~2% ~{~S ~}~:S =>~%" - (method-qualifiers method) - (unparse-specializers method)) - (describe-object (or (method-fast-function method) - (method-function method)) - stream)) + (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:") + (dolist (method methods) + (format stream "~2% (~A ~{~S ~}~:S) =>~%" + gf-name + (method-qualifiers method) + (unparse-specializers method)) + (describe-object (or (method-fast-function method) + (method-function method)) + stream))))) (when *describe-metaobjects-as-objects-p* (call-next-method))) @@ -117,7 +120,7 @@ (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:~%~S~%~ - There are ~D methods specialized for this class." + There are ~W methods 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)) @@ -129,7 +132,7 @@ (pprint-logical-block (stream nil) (format stream "~&~S is a ~S." package (type-of package)) (format stream - "~@[~&It has nicknames ~{~:_~S~^ ~}~]" + "~@[~&It has nicknames ~2I~{~:_~S~^ ~}~]" (package-nicknames package)) (let* ((internal (package-internal-symbols package)) (internal-count (- (package-hashtable-size internal) @@ -140,9 +143,13 @@ (format stream "~&It has ~S internal and ~S external symbols." internal-count external-count)) - (format stream - "~@[~&It uses ~{~:_~S~^ ~}~]" - (package-use-list package)) - (format stream - "~@[~&It is used by ~{~:_~S~^ ~}~]" - (package-used-by-list package)))) + (flet (;; Turn a list of packages into something a human likes + ;; to read. + (humanize (package-list) + (sort (mapcar #'package-name package-list) #'string<))) + (format stream + "~@[~&It uses packages named ~2I~{~:_~S~^ ~}~]" + (humanize (package-use-list package))) + (format stream + "~@[~&It is used by packages named ~2I~{~:_~S~^ ~}~]" + (humanize (package-used-by-list package))))))