1.0.40.1: fix return value of WRITE

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

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 31b48ab..0e989ca 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -18,8 +18,8 @@
 
 (defvar *print-readably* nil
   #!+sb-doc
-  "If true, all objects will printed readably. If readable printing is
-  impossible, an error will be signalled. This overrides the value of
+  "If true, all objects will be printed readably. If readable printing
+  is impossible, an error will be signalled. This overrides the value of
   *PRINT-ESCAPE*.")
 (defvar *print-escape* t
   #!+sb-doc
@@ -30,7 +30,7 @@
   "Should pretty printing be used?")
 (defvar *print-base* 10.
   #!+sb-doc
-  "the output base for RATIONALs (including integers)")
+  "The output base for RATIONALs (including integers).")
 (defvar *print-radix* nil
   #!+sb-doc
   "Should base be verified when printing RATIONALs?")
@@ -56,10 +56,10 @@
   "Should #: prefixes be used when printing symbols with null SYMBOL-PACKAGE?")
 (defvar *print-lines* nil
   #!+sb-doc
-  "the maximum number of lines to print per object")
+  "The maximum number of lines to print per object.")
 (defvar *print-right-margin* nil
   #!+sb-doc
-  "the position of the right margin in ems (for pretty-printing)")
+  "The position of the right margin in ems (for pretty-printing).")
 (defvar *print-miser-width* nil
   #!+sb-doc
   "If the remaining space between the current column and the right margin
@@ -69,7 +69,7 @@
 (defvar *print-pprint-dispatch*)
 #!+sb-doc
 (setf (fdocumentation '*print-pprint-dispatch* 'variable)
-      "the pprint-dispatch-table that controls how to pretty-print objects")
+      "The pprint-dispatch-table that controls how to pretty-print objects.")
 
 (defmacro with-standard-io-syntax (&body body)
   #!+sb-doc
@@ -167,7 +167,7 @@
                      ((:pprint-dispatch *print-pprint-dispatch*)
                       *print-pprint-dispatch*))
   #!+sb-doc
-  "Output OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*"
+  "Output OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*."
   (output-object object (out-synonym-of stream))
   object)
 
@@ -193,9 +193,11 @@
         (push (list variable value) bind)))
     (unless (assoc 'stream bind)
       (push (list 'stream '*standard-output*) bind))
-    `(let ,(nreverse bind)
-       ,@(when ignore `((declare (ignore ,@ignore))))
-       (output-object ,object stream))))
+    (once-only ((object object))
+      `(let ,(nreverse bind)
+         ,@(when ignore `((declare (ignore ,@ignore))))
+         (output-object ,object stream)
+         ,object))))
 
 (defun prin1 (object &optional stream)
   #!+sb-doc
@@ -314,12 +316,14 @@
            (when type
              (write (type-of object) :stream stream :circle nil
                     :level nil :length nil)
-             (write-char #\space stream))
+             (write-char #\space stream)
+             (pprint-newline :fill stream))
            (when body
              (funcall body))
            (when identity
              (when (or body (not type))
                (write-char #\space stream))
+             (pprint-newline :fill stream)
              (write-char #\{ stream)
              (write (get-lisp-obj-address object) :stream stream
                     :radix nil :base 16)
@@ -332,9 +336,9 @@
            (pprint-logical-block (stream nil :prefix "#<" :suffix ">")
              (print-description)))
           (t
-            (write-string "#<" stream)
-            (print-description)
-            (write-char #\> stream))))
+           (write-string "#<" stream)
+           (print-description)
+           (write-char #\> stream))))
   nil)
 \f
 ;;;; OUTPUT-OBJECT -- the main entry point