X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprint.lisp;h=04d85f4e31d0c9e25c20c5ab64082e8731febb27;hb=6c4d4d984b1af6b2a73568cec3ab9c8795cff2da;hp=03bfd1b2f6c6b67b20817b3e7b8d091118f77144;hpb=165bb53b405ab95ce76615ab77cee8284df0a36e;p=sbcl.git

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 03bfd1b..04d85f4 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -94,7 +94,7 @@
        *READ-EVAL*			T
        *READ-SUPPRESS*			NIL
        *READTABLE*			the standard readtable"
-  `(%with-standard-io-syntax #'(lambda () ,@body)))
+  `(%with-standard-io-syntax (lambda () ,@body)))
 
 (defun %with-standard-io-syntax (function)
   (let ((*package* (find-package "COMMON-LISP-USER"))
@@ -376,11 +376,6 @@
 
 ;;;; OUTPUT-OBJECT -- the main entry point
 
-;;; the current pretty printer. This should be either a function that
-;;; takes two arguments (the object and the stream) or NIL to indicate
-;;; that there is no pretty printer installed.
-(defvar *pretty-printer* nil)
-
 ;;; Objects whose print representation identifies them EQLly don't
 ;;; need to be checked for circularity.
 (defun uniquely-identified-by-print-p (x)
@@ -393,10 +388,7 @@
 (defun output-object (object stream)
   (labels ((print-it (stream)
 	     (if *print-pretty*
-		 (if *pretty-printer*
-		     (funcall *pretty-printer* object stream)
-		     (let ((*print-pretty* nil))
-		       (output-ugly-object object stream)))
+		 (sb!pretty:output-pretty-object object stream)
 		 (output-ugly-object object stream)))
 	   (check-it (stream)
              (multiple-value-bind (marker initiate)
@@ -470,13 +462,13 @@
 		      *print-object-is-disabled-p*))
 	    (print-object object stream))
 	   ((typep object 'structure-object)
-	    (default-structure-print object stream *current-level*))
+	    (default-structure-print object stream *current-level-in-print*))
 	   (t
 	    (write-string "#<INSTANCE but not STRUCTURE-OBJECT>" stream))))
     (function
      (unless (and (funcallable-instance-p object)
 		  (printed-as-funcallable-standard-class object stream))
-       (output-function object stream)))
+       (output-fun object stream)))
     (symbol
      (output-symbol object stream))
     (number
@@ -519,12 +511,12 @@
 
 ;;; This variable contains the current definition of one of three
 ;;; symbol printers. SETUP-PRINTER-STATE sets this variable.
-(defvar *internal-symbol-output-function* nil)
+(defvar *internal-symbol-output-fun* nil)
 
 ;;; This function sets the internal global symbol
-;;; *INTERNAL-SYMBOL-OUTPUT-FUNCTION* to the right function depending
-;;; on the value of *PRINT-CASE*. See the manual for details. The
-;;; print buffer stream is also reset.
+;;; *INTERNAL-SYMBOL-OUTPUT-FUN* to the right function depending on
+;;; the value of *PRINT-CASE*. See the manual for details. The print
+;;; buffer stream is also reset.
 (defun setup-printer-state ()
   (unless (and (eq *print-case* *previous-case*)
 	       (eq (readtable-case *readtable*) *previous-readtable-case*))
@@ -538,7 +530,7 @@
       (setf (readtable-case *readtable*) :upcase)
       (error "invalid READTABLE-CASE value: ~S" *previous-readtable-case*))
 
-    (setq *internal-symbol-output-function*
+    (setq *internal-symbol-output-fun*
 	  (case *previous-readtable-case*
 	    (:upcase
 	     (case *print-case*
@@ -606,7 +598,7 @@
   (setup-printer-state)
   (if (and maybe-quote (symbol-quotep name))
       (output-quoted-symbol-name name stream)
-      (funcall *internal-symbol-output-function* name stream)))
+      (funcall *internal-symbol-output-fun* name stream)))
 
 ;;;; escaping symbols
 
@@ -839,10 +831,10 @@
       (when (test letter) (advance OTHER nil))
       (go DIGIT))))
 
-;;;; *INTERNAL-SYMBOL-OUTPUT-FUNCTION*
+;;;; *INTERNAL-SYMBOL-OUTPUT-FUN*
 ;;;;
-;;;; Case hackery. These functions are stored in
-;;;; *INTERNAL-SYMBOL-OUTPUT-FUNCTION* according to the values of
+;;;; case hackery: These functions are stored in
+;;;; *INTERNAL-SYMBOL-OUTPUT-FUN* according to the values of
 ;;;; *PRINT-CASE* and READTABLE-CASE.
 
 ;;; called when:
@@ -1054,7 +1046,7 @@
 ;;; use until CLOS is set up (at which time it will be replaced with
 ;;; the real generic function implementation)
 (defun print-object (instance stream)
-  (default-structure-print instance stream *current-level*))
+  (default-structure-print instance stream *current-level-in-print*))
 
 ;;;; integer, ratio, and complex printing (i.e. everything but floats)
 
@@ -1570,12 +1562,12 @@
   (declare (ignore object stream))
   nil)
 
-(defun output-function (object stream)
+(defun output-fun (object stream)
   (let* ((*print-length* 3) ; in case we have to..
 	 (*print-level* 3)  ; ..print an interpreted function definition
 	 ;; FIXME: This find-the-function-name idiom ought to be
 	 ;; encapsulated in a function somewhere.
-	 (name (case (function-subtype object)
+	 (name (case (fun-subtype object)
 		 (#.sb!vm:closure-header-widetag "CLOSURE")
 		 (#.sb!vm:simple-fun-header-widetag (%simple-fun-name object))
 		 (t 'no-name-available)))