Merge from emacs-23
[bpt/emacs.git] / lisp / emacs-lisp / cust-print.el
index 54ead36..5b8ce99 100644 (file)
@@ -1,7 +1,7 @@
 ;;; cust-print.el --- handles print-level and print-circle
 
-;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005,
-;;   2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;;   2009, 2010, 2011  Free Software Foundation, Inc.
 
 ;; Author: Daniel LaLiberte <liberte@holonexus.org>
 ;; Adapted-By: ESR
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -24,9 +24,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;This is defined by emacs.")
 
 (defcustom print-level nil
-  "*Controls how many levels deep a nested data object will print.
+  "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:
@@ -148,7 +146,7 @@ level 1."
 
 
 (defcustom print-circle nil
-  "*Controls the printing of recursive structures.
+  "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:
@@ -167,11 +165,7 @@ but if you need to do so, try the cl-read.el package."
 
 
 (defcustom custom-print-vectors nil
-  "*Non-nil if printing of vectors should obey print-level and print-length.
-
-For Emacs 18, setting print-level, or adding custom print list or
-vector handling will make this happen anyway.  Emacs 19 obeys
-print-level, but not for vectors."
+  "Non-nil if printing of vectors should obey `print-level' and `print-length'."
   :type 'boolean
   :group 'cust-print)
 
@@ -244,14 +238,14 @@ Any pair that has the same PREDICATE is first removed."
 
 ;; Save emacs routines.
 (if (not (fboundp 'cust-print-original-prin1))
-    (mapcar 'cust-print-set-function-cell
-           '((cust-print-original-prin1 prin1)
-             (cust-print-original-princ princ)
-             (cust-print-original-print print)
-             (cust-print-original-prin1-to-string prin1-to-string)
-             (cust-print-original-format format)
-             (cust-print-original-message message)
-             (cust-print-original-error error))))
+    (mapc 'cust-print-set-function-cell
+         '((cust-print-original-prin1 prin1)
+           (cust-print-original-princ princ)
+           (cust-print-original-print print)
+           (cust-print-original-prin1-to-string prin1-to-string)
+           (cust-print-original-format format)
+           (cust-print-original-message message)
+           (cust-print-original-error error))))
 
 
 (defun custom-print-install ()
@@ -259,29 +253,29 @@ Any pair that has the same PREDICATE is first removed."
 The Emacs subroutines are saved away, and you can reinstall them
 by running `custom-print-uninstall'."
   (interactive)
-  (mapcar 'cust-print-set-function-cell
-         '((prin1 custom-prin1)
-           (princ custom-princ)
-           (print custom-print)
-           (prin1-to-string custom-prin1-to-string)
-           (format custom-format)
-           (message custom-message)
-           (error custom-error)
-           ))
+  (mapc 'cust-print-set-function-cell
+       '((prin1 custom-prin1)
+         (princ custom-princ)
+         (print custom-print)
+         (prin1-to-string custom-prin1-to-string)
+         (format custom-format)
+         (message custom-message)
+         (error custom-error)
+         ))
   t)
 
 (defun custom-print-uninstall ()
   "Reset print functions to their Emacs subroutines."
   (interactive)
-  (mapcar 'cust-print-set-function-cell
-         '((prin1 cust-print-original-prin1)
-           (princ cust-print-original-princ)
-           (print cust-print-original-print)
-           (prin1-to-string cust-print-original-prin1-to-string)
-           (format cust-print-original-format)
-           (message cust-print-original-message)
-           (error cust-print-original-error)
-           ))
+  (mapc 'cust-print-set-function-cell
+       '((prin1 cust-print-original-prin1)
+         (princ cust-print-original-princ)
+         (print cust-print-original-print)
+         (prin1-to-string cust-print-original-prin1-to-string)
+         (format cust-print-original-format)
+         (message cust-print-original-message)
+         (error cust-print-original-error)
+         ))
   t)
 
 (defalias 'custom-print-funcs-installed-p 'custom-print-installed-p)
@@ -338,15 +332,13 @@ 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)
+    (with-current-buffer buf
       (erase-buffer))
     ;; We must be in the current-buffer when the print occurs.
     (if noescape
        (custom-princ object buf)
       (custom-prin1 object buf))
-    (save-excursion
-      (set-buffer buf)
+    (with-current-buffer buf
       (buffer-string)
       ;; We could erase the buffer again, but why bother?
       )))
@@ -689,5 +681,5 @@ See `custom-format' for the details."
 
 (provide 'cust-print)
 
-;;; arch-tag: 3a5a8650-622c-48c4-87d8-e01bf72ec580
+;; arch-tag: 3a5a8650-622c-48c4-87d8-e01bf72ec580
 ;;; cust-print.el ends here