[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/cust-print.el
From: |
Juanma Barranquero |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/cust-print.el |
Date: |
Tue, 04 Feb 2003 07:53:42 -0500 |
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)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/emacs-lisp/cust-print.el,
Juanma Barranquero <=