X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/56388398e7a1251497f002072c061002ec9d9e81..410c42c57059efda8f347751bcc6876893176595:/lisp/emacs-lisp/pp.el diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 181c3eb229..2d1b8860a3 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -1,17 +1,16 @@ ;;; pp.el --- pretty printer for Emacs Lisp -;; Copyright (C) 1989, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc. ;; Author: Randal Schwartz ;; Keywords: lisp ;; 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 @@ -19,9 +18,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 . ;;; Commentary: @@ -35,7 +32,7 @@ :group 'lisp) (defcustom pp-escape-newlines t - "*Value of `print-escape-newlines' used by pp-* functions." + "Value of `print-escape-newlines' used by pp-* functions." :type 'boolean :group 'pp) @@ -44,8 +41,7 @@ "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")) + (with-current-buffer (generate-new-buffer " pp-to-string") (unwind-protect (progn (lisp-mode-variables nil) @@ -96,15 +92,10 @@ 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))) -;;;###autoload -(defun pp-eval-expression (expression) - "Evaluate EXPRESSION and pretty-print its value. -Also add the value to the front of the list in the variable `values'." - (interactive - (list (read-from-minibuffer "Eval: " nil read-expression-map t - 'read-expression-history))) - (message "Evaluating...") - (setq values (cons (eval expression) values)) +(defun pp-display-expression (expression out-buffer-name) + "Prettify and display EXPRESSION in an appropriate way, depending on length. +If a temporary buffer is needed for representation, it will be named +after OUT-BUFFER-NAME." (let* ((old-show-function temp-buffer-show-function) ;; Use this function to display the buffer. ;; This function either decides not to display it at all @@ -112,8 +103,7 @@ Also add the value to the front of the list in the variable `values'." (temp-buffer-show-function (function (lambda (buf) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (goto-char (point-min)) (end-of-line 1) (if (or (< (1+ (point)) (point-max)) @@ -128,23 +118,37 @@ Also add the value to the front of the list in the variable `values'." (select-window window) (run-hooks 'temp-buffer-show-hook)) (select-window old-selected) - (message "Evaluating...done. \ -See buffer *Pp Eval Output*."))) + (message "See buffer %s." out-buffer-name))) (message "%s" (buffer-substring (point-min) (point))) )))))) - (with-output-to-temp-buffer "*Pp Eval Output*" - (pp (car values)) + (with-output-to-temp-buffer out-buffer-name + (pp expression) (with-current-buffer standard-output (emacs-lisp-mode) (setq buffer-read-only nil) (set (make-local-variable 'font-lock-verbose) nil))))) ;;;###autoload -(defun pp-eval-last-sexp (arg) - "Run `pp-eval-expression' on sexp before point (which see). -With argument, pretty-print output into current buffer. -Ignores leading comment characters." - (interactive "P") +(defun pp-eval-expression (expression) + "Evaluate EXPRESSION and pretty-print its value. +Also add the value to the front of the list in the variable `values'." + (interactive + (list (read-from-minibuffer "Eval: " nil read-expression-map t + 'read-expression-history))) + (message "Evaluating...") + (setq values (cons (eval expression) values)) + (pp-display-expression (car values) "*Pp Eval Output*")) + +;;;###autoload +(defun pp-macroexpand-expression (expression) + "Macroexpand EXPRESSION and pretty-print its value." + (interactive + (list (read-from-minibuffer "Macroexpand: " nil read-expression-map t + 'read-expression-history))) + (pp-display-expression (macroexpand expression) "*Pp Macroexpand Output*")) + +(defun pp-last-sexp () + "Read sexp before point. Ignores leading comment characters." (let ((stab (syntax-table)) (pt (point)) start exp) (set-syntax-table emacs-lisp-mode-syntax-table) (save-excursion @@ -160,9 +164,27 @@ Ignores leading comment characters." (setq exp (read exp))) (setq exp (read (current-buffer))))) (set-syntax-table stab) - (if arg - (insert (pp-to-string (eval exp))) - (pp-eval-expression exp)))) + exp)) + +;;;###autoload +(defun pp-eval-last-sexp (arg) + "Run `pp-eval-expression' on sexp before point. +With argument, pretty-print output into current buffer. +Ignores leading comment characters." + (interactive "P") + (if arg + (insert (pp-to-string (eval (pp-last-sexp)))) + (pp-eval-expression (pp-last-sexp)))) + +;;;###autoload +(defun pp-macroexpand-last-sexp (arg) + "Run `pp-macroexpand-expression' on sexp before point. +With argument, pretty-print output into current buffer. +Ignores leading comment characters." + (interactive "P") + (if arg + (insert (pp-to-string (macroexpand (pp-last-sexp)))) + (pp-macroexpand-expression (pp-last-sexp)))) ;;; Test cases for quote ;; (pp-eval-expression ''(quote quote)) @@ -179,5 +201,4 @@ Ignores leading comment characters." (provide 'pp) ; so (require 'pp) works -;;; arch-tag: b0f7c65b-02c7-42bb-9ee3-508a59b8fbb9 ;;; pp.el ends here