X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdescribe.lisp;h=dc49e9204c826d9c88d8939269cf0572b7f8c2b6;hb=8b313a75eb6bcc7b1c8eda798c8350b49f94861c;hp=b02ccb0b404722b6731fac518143357e5aeba901;hpb=1bfc464c657a8f4ad24ef612f76a38d8f6f1bbad;p=sbcl.git diff --git a/src/pcl/describe.lisp b/src/pcl/describe.lisp index b02ccb0..dc49e92 100644 --- a/src/pcl/describe.lisp +++ b/src/pcl/describe.lisp @@ -59,7 +59,7 @@ (:class (push slotd class-slotds)) (otherwise (push slotd other-slotds)))) (setq max-slot-name-length (min (+ max-slot-name-length 3) 30)) - (format stream "~%~@<~S ~_is an instance of class ~S.~:>" object class) + (format stream "~&~@<~S ~_is an instance of class ~S.~:>" object class) ;; Now that we know the width, we can print. (when instance-slotds @@ -88,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))) @@ -127,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) @@ -138,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))))))