X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fpprint.lisp;h=89bac81df5bb0bf9ca0566e13cf6f9cb2536ad7f;hb=67f787e86602efc7e4007fb6bbc970a2fcf613f5;hp=8d2de3bef95708fc6be5f8e2c67c1aea1bb1a8a2;hpb=e60c0fcde88bf21c3b9faffe8718d07c888b934a;p=sbcl.git

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index 8d2de3b..89bac81 100644
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -707,15 +707,19 @@
 
 (defun pprint-indent (relative-to n &optional stream)
   #!+sb-doc
-  "Specify the indentation to use in the current logical block if STREAM
-   (which defaults to *STANDARD-OUTPUT*) is it is a pretty-printing stream
-   and do nothing if not. (See PPRINT-LOGICAL-BLOCK.)  N is the indentation
-   to use (in ems, the width of an ``m'') and RELATIVE-TO can be either:
+  "Specify the indentation to use in the current logical block if
+STREAM \(which defaults to *STANDARD-OUTPUT*) is a pretty-printing
+stream and do nothing if not. (See PPRINT-LOGICAL-BLOCK.) N is the
+indentation to use (in ems, the width of an ``m'') and RELATIVE-TO can
+be either:
+
      :BLOCK - Indent relative to the column the current logical block
         started on.
+
      :CURRENT - Indent relative to the current column.
-   The new indentation value does not take effect until the following line
-   break."
+
+The new indentation value does not take effect until the following
+line break."
   (declare (type (member :block :current) relative-to)
            (type real n)
            (type (or stream (member t nil)) stream)
@@ -1234,6 +1238,13 @@
            stream
            list))
 
+(defun pprint-defpackage (stream list &rest noise)
+  (declare (ignore noise))
+  (funcall  (formatter
+             "~:<~W~^ ~3I~:_~W~^~1I~@{~:@_~:<~W~^ ~:I~@_~@{~W~^ ~_~}~:>~}~:>")
+            stream
+            list))
+
 (defun pprint-destructuring-bind (stream list &rest noise)
   (declare (ignore noise))
   (funcall (formatter
@@ -1304,8 +1315,13 @@
 ;;; OUTPUT-PRETTY-OBJECT is called by OUTPUT-OBJECT when
 ;;; *PRINT-PRETTY* is true.
 (defun output-pretty-object (object stream)
-  (with-pretty-stream (stream)
-    (funcall (pprint-dispatch object) stream object)))
+  (multiple-value-bind (fun pretty) (pprint-dispatch object)
+    (if pretty
+        (with-pretty-stream (stream)
+          (funcall fun stream object))
+        ;; No point in consing up a pretty stream if we are not using pretty
+        ;; printing the object after all.
+        (output-ugly-object object stream))))
 
 (defun !pprint-cold-init ()
   (/show0 "entering !PPRINT-COLD-INIT")
@@ -1356,6 +1372,7 @@
                           (define-modify-macro pprint-defun)
                           (define-setf-expander pprint-defun)
                           (defmacro pprint-defun)
+                          (defpackage pprint-defpackage)
                           (defparameter pprint-block)
                           (defsetf pprint-defun)
                           (defstruct pprint-block)