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