X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fprint.lisp;h=0e989cadb48000383c192a7060a6cbb3b4838cc0;hb=a7f04616aa9d77ba780a2a6cf6c78b250b1d4a07;hp=31b48ab8e806cc287eaafbdb6c63ede7f16daa66;hpb=2a1df4bcc815f763fac346f32fbe535b39a0d2e1;p=sbcl.git diff --git a/src/code/print.lisp b/src/code/print.lisp index 31b48ab..0e989ca 100644 --- 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) ;;;; OUTPUT-OBJECT -- the main entry point