(in-package "SB-PCL")
-(sb-int:file-comment
- "$Header$")
-
(defmethod slots-to-inspect ((class slot-class) (object slot-object))
(class-slots class))
(: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
- (format stream "~% The following slots have :INSTANCE allocation:")
+ (format stream "~%The following slots have :INSTANCE allocation:")
(dolist (slotd (nreverse instance-slotds))
(describe-slot
(slot-definition-name slotd)
(slot-value-or-default object
(slot-definition-name slotd)))))
(when class-slotds
- (format stream "~% The following slots have :CLASS allocation:")
+ (format stream "~%The following slots have :CLASS allocation:")
(dolist (slotd (nreverse class-slotds))
(describe-slot
(slot-definition-name slotd)
(slot-value-or-default object
(slot-definition-name slotd)))))
(when other-slotds
- (format stream "~% The following slots have allocation as shown:")
+ (format stream "~%The following slots have allocation as shown:")
(dolist (slotd (nreverse other-slotds))
(describe-slot
(slot-definition-name slotd)
(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)))
(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))
(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 (sb-impl::package-internal-symbols package))
- (internal-count (- (sb-impl::package-hashtable-size internal)
- (sb-impl::package-hashtable-free internal)))
- (external (sb-impl::package-external-symbols package))
- (external-count (- (sb-impl::package-hashtable-size external)
- (sb-impl::package-hashtable-free external))))
+ (let* ((internal (package-internal-symbols package))
+ (internal-count (- (package-hashtable-size internal)
+ (package-hashtable-free internal)))
+ (external (package-external-symbols package))
+ (external-count (- (package-hashtable-size external)
+ (package-hashtable-free external))))
(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))))))