From b2a467878ff55db8f1c1f21b7b41031211ec5e9e Mon Sep 17 00:00:00 2001
From: Gabor Melis <mega@hotpop.com>
Date: Fri, 4 Dec 2009 16:07:38 +0000
Subject: [PATCH] 1.0.33.5: improve DESCRIBE (#lp488976)

Instead of printing the object type and address in an around method on
DESCRIBE-OBJECT, make it a normal method that all other methods are
supposed to call via CALL-NEXT-METHOD if they wish. This makes it
possible to completely change the output of DESCRIBE for one class
while leaving other classes alone.

Also, kill the unused *IN-DESCRIBE* var in the process.
---
 src/code/describe.lisp |   31 ++++++++++++++++---------------
 version.lisp-expr      |    2 +-
 2 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/src/code/describe.lisp b/src/code/describe.lisp
index 7762f8e..1f13b6f 100644
--- a/src/code/describe.lisp
+++ b/src/code/describe.lisp
@@ -169,40 +169,37 @@
 
 (defgeneric describe-object (x stream))
 
-(defvar *in-describe* nil)
-
-(defmethod describe-object :around (x s)
-  (cond (*in-describe*
-         (call-next-method))
-        (t
-         (format s "~&~A~%  [~A]~%"
-                 (object-self-string x)
-                 (object-type-string x))
-         (pprint-logical-block (s nil)
-           (call-next-method x s)))))
-
 ;;; Catch-all.
 (defmethod describe-object ((x t) s)
+  (format s "~&~A~%  [~A]~%"
+          (object-self-string x)
+          (object-type-string x))
   (values))
 
 (defmethod describe-object ((x cons) s)
+  (call-next-method)
   (describe-function x nil s))
 
 (defmethod describe-object ((x function) s)
+  (call-next-method)
   (describe-function nil x s))
 
 (defmethod describe-object ((x class) s)
+  (call-next-method)
   (describe-class nil x s)
   (describe-instance x s))
 
 (defmethod describe-object ((x sb-pcl::slot-object) s)
+  (call-next-method)
   (describe-instance x s))
 
 (defmethod describe-object ((x character) s)
+  (call-next-method)
   (format s "~%:_Char-code: ~S" (char-code x))
   (format s "~%:_Char-name: ~A~%_" (char-name x)))
 
 (defmethod describe-object ((x array) s)
+  (call-next-method)
   (format s "~%Element-type: ~S" (array-element-type x))
   (if (vectorp x)
       (if (array-has-fill-pointer-p x)
@@ -225,9 +222,11 @@
     (terpri s)))
 
 (defmethod describe-object ((x hash-table) s)
-  ;; Don't print things which are already apparent from the printed representation
-  ;; -- COUNT, TEST, and WEAKNESS
-  (format s "~%Occupancy: ~,1F" (float (/ (hash-table-count x) (hash-table-size x))))
+  (call-next-method)
+  ;; Don't print things which are already apparent from the printed
+  ;; representation -- COUNT, TEST, and WEAKNESS
+  (format s "~%Occupancy: ~,1F" (float (/ (hash-table-count x)
+                                          (hash-table-size x))))
   (format s "~%Rehash-threshold: ~S" (hash-table-rehash-threshold x))
   (format s "~%Rehash-size: ~S" (hash-table-rehash-size x))
   (format s "~%Size: ~S" (hash-table-size x))
@@ -235,6 +234,7 @@
   (terpri s))
 
 (defmethod describe-object ((symbol symbol) stream)
+  (call-next-method)
   ;; Describe the value cell.
   (let* ((kind (info :variable :kind symbol))
          (wot (ecase kind
@@ -318,6 +318,7 @@
       (terpri stream))))
 
 (defmethod describe-object ((package package) stream)
+  (call-next-method)
   (describe-documentation package t stream)
   (flet ((humanize (list)
            (sort (mapcar (lambda (x)
diff --git a/version.lisp-expr b/version.lisp-expr
index e33922f..8a41bfe 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.33.4"
+"1.0.33.5"
-- 
1.7.10.4