[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/cust-print.el

[Miles Bader]

Index: emacs/lisp/emacs-lisp/cust-print.el
diff -c emacs/lisp/emacs-lisp/cust-print.el:2.4 
emacs/lisp/emacs-lisp/cust-print.el:2.5
*** emacs/lisp/emacs-lisp/cust-print.el:2.4     Mon Jul 16 08:22:59 2001
--- emacs/lisp/emacs-lisp/cust-print.el Tue Feb  4 07:53:34 2003
***************
*** 34,40 ****
  ;; print-length since the standard routines are being replaced.  Also,
  ;; to print custom types constructed from lists and vectors, use
  ;; custom-print-list and custom-print-vector.  See the documentation
! ;; strings of these variables for more details.  
  
  ;; If the results of your expressions contain circular references to
  ;; other parts of the same structure, the standard Emacs print
--- 34,40 ----
  ;; print-length since the standard routines are being replaced.  Also,
  ;; to print custom types constructed from lists and vectors, use
  ;; custom-print-list and custom-print-vector.  See the documentation
! ;; strings of these variables for more details.
  
  ;; If the results of your expressions contain circular references to
  ;; other parts of the same structure, the standard Emacs print
***************
*** 131,137 ****
  ;;This is defined by emacs.")
  
  (defcustom print-level nil
!   "*Controls how many levels deep a nested data object will print.  
  
  If nil, printing proceeds recursively and may lead to
  max-lisp-eval-depth being exceeded or an error may occur:
--- 131,137 ----
  ;;This is defined by emacs.")
  
  (defcustom print-level nil
!   "*Controls how many levels deep a nested data object will print.
  
  If nil, printing proceeds recursively and may lead to
  max-lisp-eval-depth being exceeded or an error may occur:
***************
*** 147,153 ****
  
  
  (defcustom print-circle nil
!   "*Controls the printing of recursive structures.  
  
  If nil, printing proceeds recursively and may lead to
  `max-lisp-eval-depth' being exceeded or an error may occur:
--- 147,153 ----
  
  
  (defcustom print-circle nil
!   "*Controls the printing of recursive structures.
  
  If nil, printing proceeds recursively and may lead to
  `max-lisp-eval-depth' being exceeded or an error may occur:
***************
*** 196,202 ****
  (defun add-custom-printer (pred printer)
    "Add a pair of PREDICATE and PRINTER to `custom-printers'.
  Any pair that has the same PREDICATE is first removed."
!   (setq custom-printers (cons (cons pred printer) 
                              (delq (assq pred custom-printers)
                                    custom-printers)))
    ;; Rather than updating here, we could wait until cust-print-top-level is 
called.
--- 196,202 ----
  (defun add-custom-printer (pred printer)
    "Add a pair of PREDICATE and PRINTER to `custom-printers'.
  Any pair that has the same PREDICATE is first removed."
!   (setq custom-printers (cons (cons pred printer)
                              (delq (assq pred custom-printers)
                                    custom-printers)))
    ;; Rather than updating here, we could wait until cust-print-top-level is 
called.
***************
*** 220,228 ****
      ;; (byte-compile
      `(lambda (object)
         (cond
!       ,@(mapcar (function 
                   (lambda (pair)
!                    `((,(car pair) object) 
                       (,(cdr pair) object))))
                  custom-printers)
        ;; Otherwise return nil.
--- 220,228 ----
      ;; (byte-compile
      `(lambda (object)
         (cond
!       ,@(mapcar (function
                   (lambda (pair)
!                    `((,(car pair) object)
                       (,(cdr pair) object))))
                  custom-printers)
        ;; Otherwise return nil.
***************
*** 236,242 ****
  ;;====================================================
  
  (defun cust-print-set-function-cell (symbol-pair)
!   (defalias (car symbol-pair) 
      (symbol-function (car (cdr symbol-pair)))))
  
  (defun cust-print-original-princ (object &optional stream)) ; dummy def
--- 236,242 ----
  ;;====================================================
  
  (defun cust-print-set-function-cell (symbol-pair)
!   (defalias (car symbol-pair)
      (symbol-function (car (cdr symbol-pair)))))
  
  (defun cust-print-original-princ (object &optional stream)) ; dummy def
***************
*** 268,274 ****
            (error custom-error)
            ))
    t)
!   
  (defun custom-print-uninstall ()
    "Reset print functions to their emacs subroutines."
    (interactive)
--- 268,274 ----
            (error custom-error)
            ))
    t)
! 
  (defun custom-print-uninstall ()
    "Reset print functions to their emacs subroutines."
    (interactive)
***************
*** 335,341 ****
  
  This is the custom-print replacement for the standard `prin1-to-string'."
    (let ((buf (get-buffer-create " *custom-print-temp*")))
!     ;; We must erase the buffer before printing in case an error 
      ;; occurred during the last prin1-to-string and we are in debugger.
      (save-excursion
        (set-buffer buf)
--- 335,341 ----
  
  This is the custom-print replacement for the standard `prin1-to-string'."
    (let ((buf (get-buffer-create " *custom-print-temp*")))
!     ;; We must erase the buffer before printing in case an error
      ;; occurred during the last prin1-to-string and we are in debugger.
      (save-excursion
        (set-buffer buf)
***************
*** 364,370 ****
  
  
  (defun custom-format (fmt &rest args)
!   "Format a string out of a control-string and arguments.  
  The first argument is a control string.  It, and subsequent arguments
  substituted into it, become the value, which is a string.
  It may contain %s or %d or %c to substitute successive following arguments.
--- 364,370 ----
  
  
  (defun custom-format (fmt &rest args)
!   "Format a string out of a control-string and arguments.
  The first argument is a control string.  It, and subsequent arguments
  substituted into it, become the value, which is a string.
  It may contain %s or %d or %c to substitute successive following arguments.
***************
*** 385,392 ****
                                 (custom-prin1-to-string arg)
                               arg)))
                 args)))
!           
!   
  (defun custom-message (fmt &rest args)
    "Print a one-line message at the bottom of the screen.
  The first argument is a control string.
--- 385,392 ----
                                 (custom-prin1-to-string arg)
                               arg)))
                 args)))
! 
! 
  (defun custom-message (fmt &rest args)
    "Print a one-line message at the bottom of the screen.
  The first argument is a control string.
***************
*** 401,407 ****
    ;; It doesn't work to princ the result of custom-format as in:
    ;; (cust-print-original-princ (apply 'custom-format fmt args))
    ;; because the echo area requires special handling
!   ;; to avoid duplicating the output.  
    ;; cust-print-original-message does it right.
    (apply 'cust-print-original-message  fmt
         (mapcar (function (lambda (arg)
--- 401,407 ----
    ;; It doesn't work to princ the result of custom-format as in:
    ;; (cust-print-original-princ (apply 'custom-format fmt args))
    ;; because the echo area requires special handling
!   ;; to avoid duplicating the output.
    ;; cust-print-original-message does it right.
    (apply 'cust-print-original-message  fmt
         (mapcar (function (lambda (arg)
***************
*** 409,415 ****
                                 (custom-prin1-to-string arg)
                               arg)))
                 args)))
!           
  
  (defun custom-error (fmt &rest args)
    "Signal an error, making error message by passing all args to `format'.
--- 409,415 ----
                                 (custom-prin1-to-string arg)
                               arg)))
                 args)))
! 
  
  (defun custom-error (fmt &rest args)
    "Signal an error, making error message by passing all args to `format'.
***************
*** 435,446 ****
    ;; Set up for printing.
    (let ((standard-output (or stream standard-output))
        ;; circle-table will be non-nil if anything is circular.
!       (circle-table (and print-circle 
                           (cust-print-preprocess-circle-tree object)))
        (cust-print-current-level (or print-level -1)))
  
      (defalias 'cust-print-original-printer emacs-printer)
!     (defalias 'cust-print-low-level-prin 
        (cond
         ((or custom-printers
            circle-table
--- 435,446 ----
    ;; Set up for printing.
    (let ((standard-output (or stream standard-output))
        ;; circle-table will be non-nil if anything is circular.
!       (circle-table (and print-circle
                           (cust-print-preprocess-circle-tree object)))
        (cust-print-current-level (or print-level -1)))
  
      (defalias 'cust-print-original-printer emacs-printer)
!     (defalias 'cust-print-low-level-prin
        (cond
         ((or custom-printers
            circle-table
***************
*** 451,457 ****
                (or print-level print-length)))
        'cust-print-print-object)
         (t 'cust-print-original-printer)))
!     (defalias 'cust-print-prin 
        (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin))
  
      (cust-print-prin object)
--- 451,457 ----
                (or print-level print-length)))
        'cust-print-print-object)
         (t 'cust-print-original-printer)))
!     (defalias 'cust-print-prin
        (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin))
  
      (cust-print-prin object)
***************
*** 461,467 ****
  (defun cust-print-print-object (object)
    ;; Test object type and print accordingly.
    ;; Could be called as either cust-print-low-level-prin or cust-print-prin.
!   (cond 
     ((null object) (cust-print-original-printer object))
     ((cust-print-use-custom-printer object) object)
     ((consp object) (cust-print-list object))
--- 461,467 ----
  (defun cust-print-print-object (object)
    ;; Test object type and print accordingly.
    ;; Could be called as either cust-print-low-level-prin or cust-print-prin.
!   (cond
     ((null object) (cust-print-original-printer object))
     ((cust-print-use-custom-printer object) object)
     ((consp object) (cust-print-list object))
***************
*** 561,567 ****
  ;;==================================
  
  (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> )
--- 561,567 ----
  ;;==================================
  
  (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> )
***************
*** 600,607 ****
  (defun cust-print-walk-circle-tree (object)
    (let (read-equivalent-p tag)
      (while object
!       (setq read-equivalent-p 
!           (or (numberp object) 
                (and (symbolp object)
                     ;; Check if it is uninterned.
                     (eq object (intern-soft (symbol-name object)))))
--- 600,607 ----
  (defun cust-print-walk-circle-tree (object)
    (let (read-equivalent-p tag)
      (while object
!       (setq read-equivalent-p
!           (or (numberp object)
                (and (symbolp object)
                     ;; Check if it is uninterned.
                     (eq object (intern-soft (symbol-name object)))))
***************
*** 617,623 ****
                     (cons (list object)
                           (cdr circle-table)))))
        (setq object
!           (cond 
             (tag ;; No need to descend since we have already.
              nil)
  
--- 617,623 ----
                     (cons (list object)
                           (cdr circle-table)))))
        (setq object
!           (cond
             (tag ;; No need to descend since we have already.
              nil)