Function: cust-print-preprocess-circle-tree

cust-print-preprocess-circle-tree is a byte-compiled function defined in cust-print.el.gz.

Signature

(cust-print-preprocess-circle-tree OBJECT)

Source Code

;; Defined in /usr/src/emacs/lisp/obsolete/cust-print.el.gz
;; Circular structure preprocessing
;;==================================

(defun cust-print-preprocess-circle-tree (object)
  ;; Fill up the table.
  (let (;; Table of tags for each object in an object to be printed.
	;; A tag is of the form:
	;; ( <object> <nil-t-or-id-number> )
	;; The id-number is generated after the entire table has been computed.
	;; During walk through, the real circle-table lives in the cdr so we
	;; can use setcdr to add new elements instead of having to setq the
	;; variable sometimes (poor man's locf).
	(circle-table (list nil)))
    (cust-print-walk-circle-tree object)

    ;; Reverse table so it is in the order that the objects will be printed.
    ;; This pass could be avoided if we always added to the end of the
    ;; table with setcdr in walk-circle-tree.
    (setcdr circle-table (nreverse (cdr circle-table)))

    ;; Walk through the table, assigning id-numbers to those
    ;; objects which will be printed using #N= syntax.  Delete those
    ;; objects which will be printed only once (to speed up assq later).
    (let ((rest circle-table)
	  (id -1))
      (while (cdr rest)
	(let ((tag (car (cdr rest))))
	  (cond ((cdr tag)
		 (setcdr tag id)
		 (setq id (1- id))
		 (setq rest (cdr rest)))
		;; Else delete this object.
		(t (setcdr rest (cdr (cdr rest))))))
	))
    ;; Drop the car.
    (cdr circle-table)
    ))