0.6.11.6:

[sbcl.git] / src / code / pprint.lisp

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index e564148..b23a4dc 100644 (file)
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!PRETTY")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; pretty streams
 
@@ -31,7 +28,7 @@
 
 (defconstant default-line-length 80)
 
-(defstruct (pretty-stream (:include sb!sys:lisp-stream
+(defstruct (pretty-stream (:include sb!kernel:lisp-stream
                                    (:out #'pretty-out)
                                    (:sout #'pretty-sout)
                                    (:misc #'pretty-misc))
@@ -100,6 +97,11 @@
   (declare (type posn posn) (type pretty-stream stream)
           (values posn))
   (index-column (posn-index posn stream) stream))
+
+;;; Is it OK to do pretty printing on this stream at this time?
+(defun print-pretty-on-stream-p (stream)
+  (and (pretty-stream-p stream)
+       *print-pretty*))
 \f
 ;;;; stream interface routines
 
@@ -242,9 +244,7 @@
   (posn 0 :type posn))
 
 (defmacro enqueue (stream type &rest args)
-  (let ((constructor (intern (concatenate 'string
-                                         "MAKE-"
-                                         (symbol-name type)))))
+  (let ((constructor (symbolicate "MAKE-" type)))
     (once-only ((stream stream)
                (entry `(,constructor :posn
                                      (index-posn
@@ -500,8 +500,8 @@
           (ecase (fits-on-line-p stream (block-start-section-end next)
                                  force-newlines-p)
             ((t)
-             ;; Just nuke the whole logical block and make it look like one
-             ;; nice long literal.
+             ;; Just nuke the whole logical block and make it look
+             ;; like one nice long literal.
              (let ((end (block-start-block-end next)))
                (expand-tabs stream end)
                (setf tail (cdr (member end tail)))))
@@ -660,7 +660,7 @@
                  ((t) *terminal-io*)
                  ((nil) *standard-output*)
                  (t stream))))
-    (when (pretty-stream-p stream)
+    (when (print-pretty-on-stream-p stream)
       (enqueue-newline stream kind)))
   nil)
 
@@ -683,7 +683,7 @@
                  ((t) *terminal-io*)
                  ((nil) *standard-output*)
                  (t stream))))
-    (when (pretty-stream-p stream)
+    (when (print-pretty-on-stream-p stream)
       (enqueue-indent stream relative-to n)))
   nil)
 
@@ -708,7 +708,7 @@
                  ((t) *terminal-io*)
                  ((nil) *standard-output*)
                  (t stream))))
-    (when (pretty-stream-p stream)
+    (when (print-pretty-on-stream-p stream)
       (enqueue-tab stream kind colnum colinc)))
   nil)