X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdescribe.lisp;h=c727c4386c613e56669445ab249ac22fdaca5856;hb=7d853ed1882221bc790062e423a74a620f6e4ee1;hp=d459b530fbaab4845f407ed14aaacf8dbabc4563;hpb=a22dd643fb599880f4c0856e1a85bffe4358aea8;p=sbcl.git

diff --git a/src/pcl/describe.lisp b/src/pcl/describe.lisp
index d459b53..c727c43 100644
--- a/src/pcl/describe.lisp
+++ b/src/pcl/describe.lisp
@@ -32,128 +32,125 @@
 (defmethod describe-object ((object slot-object) stream)
 
   (fresh-line stream)
-  
+
   (let* ((class (class-of object))
-	 (slotds (slots-to-inspect class object))
-	 (max-slot-name-length 0)
-	 (instance-slotds ())
-	 (class-slotds ())
-	 (other-slotds ()))
+         (slotds (slots-to-inspect class object))
+         (max-slot-name-length 0)
+         (instance-slotds ())
+         (class-slotds ())
+         (other-slotds ()))
 
     (format stream "~&~@<~S ~_is an instance of class ~S.~:>" object class)
 
     ;; Figure out a good width for the slot-name column.
     (flet ((adjust-slot-name-length (name)
-	     (setq max-slot-name-length
-		   (max max-slot-name-length
-			(length (the string (symbol-name name)))))))
+             (setq max-slot-name-length
+                   (max max-slot-name-length
+                        (length (the string (symbol-name name)))))))
       (dolist (slotd slotds)
-	(adjust-slot-name-length (slot-definition-name slotd))
-	(case (slot-definition-allocation slotd)
-	  (:instance (push slotd instance-slotds))
-	  (:class  (push slotd class-slotds))
-	  (otherwise (push slotd other-slotds))))
+        (adjust-slot-name-length (slot-definition-name slotd))
+        (case (slot-definition-allocation slotd)
+          (:instance (push slotd instance-slotds))
+          (:class  (push slotd class-slotds))
+          (otherwise (push slotd other-slotds))))
       (setq max-slot-name-length  (min (+ max-slot-name-length 3) 30)))
 
     ;; Now that we know the width, we can print.
     (flet ((describe-slot (name value &optional (allocation () alloc-p))
-	     (if alloc-p
-		 (format stream
-			 "~& ~A ~S ~VT  ~S"
-			 name allocation (+ max-slot-name-length 7) value)
-		 (format stream
-			 "~& ~A~VT  ~S"
-			 name max-slot-name-length value))))
+             (if alloc-p
+                 (format stream
+                         "~& ~A ~S ~VT  ~S"
+                         name allocation (+ max-slot-name-length 7) value)
+                 (format stream
+                         "~& ~A~VT  ~S"
+                         name max-slot-name-length value))))
       (when instance-slotds
-	(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)))))
+        (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:")
-	(dolist (slotd (nreverse class-slotds))
-	  (describe-slot
-	   (slot-definition-name slotd)
-	   (slot-value-or-default object
-				  (slot-definition-name slotd)))))
+        (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:")
-	(dolist (slotd (nreverse other-slotds))
-	  (describe-slot
-	   (slot-definition-name slotd)
-	   (slot-value-or-default object
-				  (slot-definition-name slotd))
-	   (slot-definition-allocation slotd))))))
+        (format stream "~&The following slots have allocation as shown:")
+        (dolist (slotd (nreverse other-slotds))
+          (describe-slot
+           (slot-definition-name slotd)
+           (slot-value-or-default object
+                                  (slot-definition-name slotd))
+           (slot-definition-allocation slotd))))))
 
   (terpri stream))
 
 (defmethod describe-object ((fun standard-generic-function) stream)
   (format stream "~&~A is a generic function." fun)
   (when (documentation fun t)
-    (format stream "~&  Function documentation: ~A" (documentation fun t)))
+    (format stream "~&Its documentation is: ~A" (documentation fun t)))
   (format stream "~&Its lambda-list is:~&  ~S"
-	  (generic-function-pretty-arglist fun))
+          (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:")
-	  (dolist (method methods)
-	    (format stream "~&  (~A ~{~S ~}~:S)~%"
-		    gf-name
-		    (method-qualifiers method)
-		    (unparse-specializers method))
-	    (when (documentation method t)
-	      (format stream "~&    Method documentation: ~A"
-		      (documentation method t))))))))
+        (format stream "~&It has no methods.~%")
+        (let ((gf-name (generic-function-name fun)))
+          (format stream "~&Its methods are:")
+          (dolist (method methods)
+            (format stream "~&  (~A ~{~S ~}~:S)~%"
+                    gf-name
+                    (method-qualifiers method)
+                    (unparse-specializers fun (method-specializers method)))
+            (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.~:@>"
-	  class (pretty-class (class-of class)))
+          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).~@:>")))
+        (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.~I~_The class is ~:[not ~;~]finalized~
+           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 ~
+           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))
-	  (class-finalized-p class)
-	  (mapcar #'pretty-class (cpl-or-nil class))
-	  (length (specializer-direct-methods class))))))
+          (mapcar #'pretty-class (class-direct-superclasses class))
+          (mapcar #'pretty-class (class-direct-subclasses class))
+          (class-finalized-p class)
+          (mapcar #'pretty-class (cpl-or-nil class))
+          (length (specializer-direct-methods class))))))
 
 (defmethod describe-object ((package package) stream)
   (format stream "~&~S is a ~S." package (type-of package))
   (format stream
-	  "~@[~&~@<It has nicknames ~2I~{~:_~S~^ ~}~:>~]"
-	  (package-nicknames package))
-  (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))
+          "~@[~&~@<It has nicknames ~2I~{~:_~S~^ ~}~:>~]"
+          (package-nicknames package))
+  (format stream
+          "~&It has ~S internal and ~S external symbols."
+          (package-internal-symbol-count package)
+          (package-external-symbol-count package))
   (flet (;; Turn a list of packages into something a human likes
-	 ;; to read.
-	 (humanize (package-list)
-	   (sort (mapcar #'package-name package-list) #'string<)))
+         ;; 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)))
+            "~@[~&~@<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))))
+            "~@[~&~@<It is used by packages named ~2I~{~:_~S~^ ~}~:>~]"
+            (humanize (package-used-by-list package))))
   (terpri stream))