X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/15b605aea89b34651452edf4d16af07e262b50b7..d6b8bb8ef4af4b5ae5350626a3358b652779b3b0:/lisp/emacs-lisp/pp.el diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 34c8857aec..93e30fb0f5 100644 --- 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 +;; Keywords: lisp ;; This file is part of GNU Emacs. @@ -21,79 +22,73 @@ ;; 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 nil) (set-syntax-table emacs-lisp-mode-syntax-table) - (let ((print-escape-newlines pp-escape-newlines)) + (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(\\|#\\s(") - (while (looking-at "\\s(\\|#\\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))) @@ -102,8 +97,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) @@ -132,12 +127,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) @@ -179,4 +172,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