changeset 1366:ebf903dc2d70

(custom-prin1-chars): Var defined, and renamed from prin1-chars. (circle-tree, circle-table): Define vars. (cust-print-vector, cust-print-list): Rename level to circle-level. (cust-print-top-level): Likewise. (circle-level): Var defined.

--- a/lisp/emacs-lisp/cust-print.el	Thu Oct 08 06:14:35 1992 +0000
+++ b/lisp/emacs-lisp/cust-print.el	Thu Oct 08 06:44:24 1992 +0000
@@ -107,7 +107,7 @@
 Also see `print-length' and `print-circle'.
 
 If non-nil, components at levels equal to or greater than `print-level'
-are printed simply as \"#\".  The object to be printed is at level 0,
+are printed simply as `#'.  The object to be printed is at level 0,
 and if the object is a list or vector, its top-level components are at
 level 1.")
 
@@ -231,15 +231,17 @@
   "Same as `custom-prin1' except no quoting."
   (cust-print-top-level object stream 'cust-print-internal-princ))
 
+(defvar custom-prin1-chars)
+
 (defun custom-prin1-to-string-func (c)
   "Stream function for `custom-prin1-to-string'."
-  (setq prin1-chars (cons c prin1-chars)))
+  (setq custom-prin1-chars (cons c custom-prin1-chars)))
 
 (defun custom-prin1-to-string (object)
   "Replacement for standard `prin1-to-string'."
-  (let ((prin1-chars nil))
+  (let ((custom-prin1-chars nil))
     (custom-prin1 object 'custom-prin1-to-string-func)
-    (concat (nreverse prin1-chars))))
+    (concat (nreverse custom-prin1-chars))))
 
 
 (defun custom-print (object &optional stream)
@@ -287,11 +289,15 @@
 ;;=========================================
 ;; Support for custom prin1 and princ
 
+(defvar circle-table)
+(defvar circle-tree)
+(defvar circle-level)
+
 (defun cust-print-top-level (object stream internal-printer)
   "Set up for printing."
   (let ((standard-output (or stream standard-output))
 	(circle-table (and print-circle (cust-print-preprocess-circle-tree object)))
-	(level (or print-level -1))
+	(circle-level (or print-level -1))
 	)
 
     (fset 'cust-print-internal-printer internal-printer)
@@ -387,9 +393,9 @@
 
 ;; Print a list using print-length, print-level, and print-circle.
 (defun cust-print-list (list)
-  (if (= level 0)
+  (if (= circle-level 0)
       (cust-print-internal-princ "#")
-    (let ((level (1- level)))
+    (let ((circle-level (1- circle-level)))
       (cust-print-internal-princ "(")
       (let ((length (or print-length 0)))
 
@@ -422,9 +428,9 @@
 
 ;; Print a vector according to print-length, print-level, and print-circle.
 (defun cust-print-vector (vector)
-  (if (= level 0)
+  (if (= circle-level 0)
       (cust-print-internal-princ "#")
-    (let ((level (1- level))
+    (let ((circle-level (1- circle-level))
 	  (i 0)
 	  (len (length vector)))
       (cust-print-internal-princ "[")
@@ -523,50 +529,45 @@
 
 ;;=======================================
 
-(quote 
- examples
- 
- (progn
-   ;; Create some circular structures.
-   (setq circ-sym (let ((x (make-symbol "FOO"))) (list x x)))
-   (setq circ-list (list 'a 'b (vector 1 2 3 4) 'd 'e 'f))
-   (setcar (nthcdr 3 circ-list) circ-list)
-   (aset (nth 2 circ-list) 2 circ-list)
-   (setq dotted-circ-list (list 'a 'b 'c))
-   (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list)
-   (setq circ-vector (vector 1 2 3 4 (list 'a 'b 'c 'd) 6 7))
-   (aset circ-vector 5 (make-symbol "-gensym-"))
-   (setcar (cdr (aref circ-vector 4)) (aref circ-vector 5))
-   nil)
+;; Example.
 
- (install-custom-print-funcs)
- ;; (setq print-circle t)
+;;;; Create some circular structures.
+;;(setq circ-sym (let ((x (make-symbol "FOO"))) (list x x)))
+;;(setq circ-list (list 'a 'b (vector 1 2 3 4) 'd 'e 'f))
+;;(setcar (nthcdr 3 circ-list) circ-list)
+;;(aset (nth 2 circ-list) 2 circ-list)
+;;(setq dotted-circ-list (list 'a 'b 'c))
+;;(setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list)
+;;(setq circ-vector (vector 1 2 3 4 (list 'a 'b 'c 'd) 6 7))
+;;(aset circ-vector 5 (make-symbol "-gensym-"))
+;;(setcar (cdr (aref circ-vector 4)) (aref circ-vector 5))
 
- (let ((print-circle t))
-   (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)")
-       (error "circular object with array printing")))
+;;(install-custom-print-funcs)
+;;;; (setq print-circle t)
+
+;;(let ((print-circle t))
+;;  (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)")
+;;      (error "circular object with array printing")))
 
- (let ((print-circle t))
-   (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)")
-       (error "circular object with array printing")))
+;;(let ((print-circle t))
+;;  (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)")
+;;      (error "circular object with array printing")))
 
- (let* ((print-circle t)
-	(x (list 'p 'q))
-	(y (list (list 'a 'b) x 'foo x)))
-   (setcdr (cdr (cdr (cdr y))) (cdr y))
-   (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))"
-	      )
-       (error "circular list example from CL manual")))
+;;(let* ((print-circle t)
+;;       (x (list 'p 'q))
+;;       (y (list (list 'a 'b) x 'foo x)))
+;;  (setcdr (cdr (cdr (cdr y))) (cdr y))
+;;  (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))"
+;;	     )
+;;      (error "circular list example from CL manual")))
 
- ;; There's no special handling of uninterned symbols in custom-print.
- (let ((print-circle nil))
-   (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)")
-       (error "uninterned symbols in list")))
- (let ((print-circle t))
-   (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)")
-       (error "circular uninterned symbols in list")))
-
- (uninstall-custom-print-funcs)
- )
+;;;; There's no special handling of uninterned symbols in custom-print.
+;;(let ((print-circle nil))
+;;  (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)")
+;;      (error "uninterned symbols in list")))
+;;(let ((print-circle t))
+;;  (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)")
+;;      (error "circular uninterned symbols in list")))
+;;(uninstall-custom-print-funcs)
 
 ;;; cust-print.el ends here