;;; pp.el --- pretty printer for Emacs Lisp
-;; Copyright (C) 1989, 1993 Free Software Foundation, Inc.
-;; Author: Randal Schwartz <merlyn@ora.com>
+;; 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.
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
;;; Code:
-(defvar pp-escape-newlines t
- "*Value of print-escape-newlines used by pp-* functions.")
+(defgroup pp nil
+ "Pretty printer for Emacs Lisp."
+ :prefix "pp-"
+ :group 'lisp)
+(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
(progn
- (lisp-mode-variables t)
- (let ((print-escape-newlines pp-escape-newlines))
+ (lisp-mode-variables nil)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (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
- ((looking-at "\\s\(")
- (while (looking-at "\\s(")
- (forward-char 1)))
- ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)")
- (> (match-beginning 1) 1)
- (= ?\( (char-after (1- (match-beginning 1))))
- ;; Make sure this is a two-element list.
- (save-excursion
- (goto-char (match-beginning 2))
- (forward-sexp)
- ;; (looking-at "[ \t]*\)")
- ;; Avoid mucking with match-data; does this test work?
- (char-equal ?\) (char-after (point)))))
- ;; -1 gets the paren preceding the quote as well.
- (delete-region (1- (match-beginning 1)) (match-end 1))
- (insert "'")
- (forward-sexp 1)
- (if (looking-at "[ \t]*\)")
- (delete-region (match-beginning 0) (match-end 0))
- (error "Malformed quote"))
- (backward-sexp 1))
- ((condition-case err-var
- (prog1 t (down-list 1))
- (error nil))
- (backward-char 1)
- (skip-chars-backward " \t")
- (delete-region
- (point)
- (progn (skip-chars-forward " \t") (point)))
- (if (not (char-equal ?' (char-after (1- (point)))))
- (insert ?\n)))
- ((condition-case err-var
- (prog1 t (up-list 1))
- (error nil))
- (while (looking-at "\\s)")
- (forward-char 1))
- (skip-chars-backward " \t")
- (delete-region
- (point)
- (progn (skip-chars-forward " \t") (point)))
- (if (not (char-equal ?' (char-after (1- (point)))))
- (insert ?\n)))
- (t (goto-char (point-max)))))
- (goto-char (point-min))
- (indent-sexp)
+ (pp-buffer)
(buffer-string))
(kill-buffer (current-buffer)))))
+;;;###autoload
+(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)))
(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)
(goto-char (point-min))
(end-of-line 1)
(if (or (< (1+ (point)) (point-max))
- (>= (- (point) (point-min)) (screen-width)))
+ (>= (- (point) (point-min)) (frame-width)))
(let ((temp-buffer-show-function old-show-function)
(old-selected (selected-window))
(window (display-buffer buf)))
(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))))
+ (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)
(provide 'pp) ; so (require 'pp) works
-;;; pp.el ends here.
+;;; arch-tag: b0f7c65b-02c7-42bb-9ee3-508a59b8fbb9
+;;; pp.el ends here