(ewoc-create, ewoc-map, ewoc-locate, ewoc-invalidate, ewoc-collect):

[gnu-emacs] / lisp / emacs-lisp / pp.el

diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index beb79c745adea218030dcaa956784f3c62dbbbab..61d31921e57b8bbba6d17efaf85e47dc2e918f21 100644 (file)
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -1,8 +1,9 @@
 ;;; pp.el --- pretty printer for Emacs Lisp
 
-;; Copyright (C) 1989, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001, 2004  Free Software Foundation, Inc.
 
 ;; Author: Randal Schwartz <merlyn@stonehenge.com>
+;; Keywords: lisp
 
 ;; This file is part of GNU Emacs.
 
@@ -21,21 +22,25 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Commentary:
+
 ;;; Code:
+
 (defgroup pp nil
   "Pretty printer for Emacs Lisp."
   :prefix "pp-"
   :group 'lisp)
 
-(defcustom pp-escape-newlines t 
+(defcustom pp-escape-newlines t
   "*Value of `print-escape-newlines' used by pp-* functions."
   :type 'boolean
   :group 'pp)
 
+;;;###autoload
 (defun pp-to-string (object)
-  "Return a string containing the pretty-printed representation of OBJECT,
-any Lisp object.  Quoting characters are used when needed to make output
-that `read' can handle, whenever this is possible."
+  "Return a string containing the pretty-printed representation of OBJECT.
+OBJECT can be any Lisp object.  Quoting characters are used as needed
+to make output that `read' can handle, whenever this is possible."
   (save-excursion
     (set-buffer (generate-new-buffer " pp-to-string"))
     (unwind-protect
@@ -45,38 +50,44 @@ that `read' can handle, whenever this is possible."
          (let ((print-escape-newlines pp-escape-newlines)
                (print-quoted t))
            (prin1 object (current-buffer)))
-         (goto-char (point-min))
-         (while (not (eobp))
-           ;; (message "%06d" (- (point-max) (point)))
-           (cond
-            ((condition-case err-var
-                 (prog1 t (down-list 1))
-               (error nil))
-             (save-excursion
-               (backward-char 1)
-               (skip-chars-backward "'`#^")
-               (when (and (not (bobp)) (= ?\ (char-before)))
-                 (delete-char -1)
-                 (insert "\n"))))
-            ((condition-case err-var
-                 (prog1 t (up-list 1))
-               (error nil))
-             (while (looking-at "\\s)")
-               (forward-char 1))
-             (delete-region
-              (point)
-              (progn (skip-chars-forward " \t") (point)))
-             (insert ?\n))
-            (t (goto-char (point-max)))))
-         (goto-char (point-min))
-         (indent-sexp)
+          (pp-buffer)
          (buffer-string))
       (kill-buffer (current-buffer)))))
 
+(defun pp-buffer ()
+  "Prettify the current buffer with printed representation of a Lisp object."
+  (goto-char (point-min))
+  (while (not (eobp))
+    ;; (message "%06d" (- (point-max) (point)))
+    (cond
+     ((condition-case err-var
+          (prog1 t (down-list 1))
+        (error nil))
+      (save-excursion
+        (backward-char 1)
+        (skip-chars-backward "'`#^")
+        (when (and (not (bobp)) (memq (char-before) '(?\ ?\t ?\n)))
+          (delete-region
+           (point)
+           (progn (skip-chars-backward " \t\n") (point)))
+          (insert "\n"))))
+     ((condition-case err-var
+          (prog1 t (up-list 1))
+        (error nil))
+      (while (looking-at "\\s)")
+        (forward-char 1))
+      (delete-region
+       (point)
+       (progn (skip-chars-forward " \t\n") (point)))
+      (insert ?\n))
+     (t (goto-char (point-max)))))
+  (goto-char (point-min))
+  (indent-sexp))
+
 ;;;###autoload
 (defun pp (object &optional stream)
   "Output the pretty-printed representation of OBJECT, any Lisp object.
-Quoting characters are printed when needed to make output that `read'
+Quoting characters are printed as needed to make output that `read'
 can handle, whenever this is possible.
 Output stream is STREAM, or value of `standard-output' (which see)."
   (princ (pp-to-string object) (or stream standard-output)))
@@ -85,8 +96,8 @@ Output stream is STREAM, or value of `standard-output' (which see)."
 (defun pp-eval-expression (expression)
   "Evaluate EXPRESSION and pretty-print value into a new display buffer.
 If the pretty-printed value fits on one line, the message line is used
-instead.  Value is also consed on to front of variable  values 's
-value."
+instead.  The value is also consed onto the front of the list
+in the variable `values'."
   (interactive "xPp-eval: ")
   (setq values (cons (eval expression) values))
   (let* ((old-show-function temp-buffer-show-function)
@@ -115,12 +126,10 @@ value."
                 (message "%s" (buffer-substring (point-min) (point)))
                 ))))))
     (with-output-to-temp-buffer "*Pp Eval Output*"
-      (pp (car values)))
-    (save-excursion
-      (set-buffer "*Pp Eval Output*")
-      (emacs-lisp-mode)
-      (make-local-variable 'font-lock-verbose)
-      (setq font-lock-verbose nil))))
+      (pp (car values))
+      (with-current-buffer standard-output
+       (emacs-lisp-mode)
+       (set (make-local-variable 'font-lock-verbose) nil)))))
 
 ;;;###autoload
 (defun pp-eval-last-sexp (arg)
@@ -162,4 +171,5 @@ Ignores leading comment characters."
 
 (provide 'pp)                          ; so (require 'pp) works
 
-;;; pp.el ends here.
+;;; arch-tag: b0f7c65b-02c7-42bb-9ee3-508a59b8fbb9
+;;; pp.el ends here