From ce89644b81120b86a226687864e22490fb906874 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Wed, 27 Dec 2000 13:24:29 +0000
Subject: [PATCH] o Have print-unreadable-object respect *print-pretty*.

---
 code/print.lisp | 53 +++++++++++++++++++++++++++++++++----------------
 1 file changed, 36 insertions(+), 17 deletions(-)

diff --git a/code/print.lisp b/code/print.lisp
index 588e09a58..3cd5e1bc2 100644
--- a/code/print.lisp
+++ b/code/print.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.76 2000/04/29 04:09:17 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.77 2000/12/27 13:24:29 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -255,22 +255,41 @@
 (defun %print-unreadable-object (object stream type identity body)
   (when *print-readably*
     (error 'print-not-readable :object object))
-  (write-string "#<" stream)
-  (when type
-    (write (type-of object) :stream stream :circle nil
-	   :level nil :length nil)
-    (when (or body identity)
-      (write-char #\space stream)))
-  (when body
-    (funcall body))
-  (when identity
-    (when body
-      (write-char #\space stream))
-    (write-char #\{ stream)
-    (write (get-lisp-obj-address object) :stream stream
-	   :radix nil :base 16)
-    (write-char #\} stream))
-  (write-char #\> stream)
+  (cond (*print-pretty*
+	 (pprint-logical-block (stream nil :prefix "#<" :suffix ">")
+	   (when type
+	     (write (type-of object) :stream stream :circle nil
+		    :level nil :length nil)
+	     (when (or body identity)
+	       (write-char #\space stream)
+	       (pprint-newline :fill stream)))
+	   (when body
+	     (funcall body))
+	   (when identity
+	     (when body
+	       (write-char #\space stream)
+	       (pprint-newline :fill stream))
+	     (write-char #\{ stream)
+	     (write (get-lisp-obj-address object) :stream stream
+		    :radix nil :base 16)
+	     (write-char #\} stream))))
+	(t
+	 (write-string "#<" stream)
+	 (when type
+	   (write (type-of object) :stream stream :circle nil
+		  :level nil :length nil)
+	   (when (or body identity)
+	     (write-char #\space stream)))
+	 (when body
+	   (funcall body))
+	 (when identity
+	   (when body
+	     (write-char #\space stream))
+	   (write-char #\{ stream)
+	   (write (get-lisp-obj-address object) :stream stream
+		  :radix nil :base 16)
+	   (write-char #\} stream))
+	 (write-char #\> stream)))
   nil)
 
 
-- 
GitLab