cgit.sxemacs.org Git - packages/blob - xemacs-packages/xemacs-devel/pretty-print.el

   1 ;;; pretty-print.el --- Emacs Lisp pretty printer and macro expander
   2
   3 ;; Copyright (C) 1992,1993 Guido Bosch <Guido.Bosch@loria.fr>
   4
   5 ;; Author: Guido Bosch
   6 ;; Maintainer: None
   7 ;; Keywords: lisp, internal
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24 ;; 02111-1307, USA.
  25
  26 ;;; Synched up with:  Not in FSF.
  27
  28 ;;; Commentary:
  29
  30 ;; Please send bugs and comments to the author.
  31 ;;
  32 ;; <DISCLAIMER>
  33 ;; This program is still under development.  Neither the author nor
  34 ;; CRIN-INRIA accepts responsibility to anyone for the consequences of
  35 ;; using it or for whether it serves any particular purpose or works
  36 ;; at all.
  37 ;;
  38 ;; The package has been developed under Lucid Emacs 19, but also runs
  39 ;; on Emacs 18, if it is compiled with the version 19 byte compiler
  40 ;; (function `compiled-function-p' lacking).
  41 ;;
  42 \f
  43 ;; Installation and Usage
  44 ;; ----------------------
  45 ;;
  46 ;; This package provides an Emacs Lisp sexpression pretty printer and
  47 ;; macroexpander.  To install it, put the following line in your .emacs,
  48 ;; default.el or site-init.el/site-run.el (for Lucid Emacs):
  49 ;; (require 'pp)
  50 ;;
  51 ;; The package can also be made autoloadable, with the following entry
  52 ;; points:
  53 ;; (autoload 'pp-function "pp" nil t)
  54 ;; (autoload 'pp-variable "pp" nil t)
  55 ;; (autoload 'pp-plist     "pp" nil t)
  56 ;; (autoload 'macroexpand-sexp "pp" nil t)
  57 ;; (autoload 'macroexpand-all-sexp "pp" nil t)
  58 ;; (autoload 'prettyexpand-sexp "pp" nil t)
  59 ;; (autoload 'prettyexpand-all-sexp "pp" nil t)
  60 ;;
  61 ;;(define-key emacs-lisp-mode-map '(control meta m) 'macroexpand-sexp)
  62 ;;(define-key emacs-lisp-mode-map '(control meta M) 'macroexpand-all-sexp)
  63 ;;(define-key emacs-lisp-mode-map '(control symbol m) 'prettyexpand-sexp)
  64 ;;(define-key emacs-lisp-mode-map '(control symbol M) 'prettyexpand-all-sexp)
  65 ;;
  66 ;;(define-key lisp-interaction-mode-map '(control meta m) 'macroexpand-sexp)
  67 ;;(define-key lisp-interaction-mode-map '(control meta M) 'macroexpand-all-sexp)
  68 ;;(define-key lisp-interaction-mode-map '(control symbol m) 'prettyexpand-sexp)
  69 ;;(define-key lisp-interaction-mode-map '(control symbol M) 'prettyexpand-all-sexp)
  70 ;;
  71
  72 ;; Pretty printing of the different cells of a symbol is done with the
  73 ;; commands:
  74 ;;
  75 ;;              M-x pp-function
  76 ;;              M-x pp-variable
  77 ;;              M-x pp-plist
  78 ;;
  79 ;; They print a symbol's function definition, variable value and
  80 ;; property list, respectively.  These commands pop up a separate
  81 ;; window in which the pretty printed lisp object is displayed.
  82 ;; Completion for function and variable symbols is provided. If a
  83 ;; function is byte compiled, `pp-function' proposes to call the Emacs
  84 ;; Lisp disassembler (this feature only works for Emacs 19, as it
  85 ;; needs the `compiled-function-p' predicate).
  86 ;;
  87 ;; To use the macro expander, put the cursor at the beginning of the
  88 ;; form to be expanded, then type
  89 ;;
  90 ;;              C-M-m           (macroexpand-sexp)
  91 ;; or           C-M-Sh-M        (macroexpand-all-sexp)
  92 ;;
  93 ;; Both commands will pop up a temporary window containing the
  94 ;; macroexpanded code. The only difference is that the second command
  95 ;; expands recursively all containing macro calls, while the first one
  96 ;; does it only for the uppermost sexpression.
  97 ;;      With a prefix argument, the macro expansion isn't displayed in a
  98 ;; separate buffer but replaces the original code in the current
  99 ;; buffer. Be aware: Comments will be lost.
 100 ;;      You can get back the original sexpression using the `undo'
 101 ;;      command on `C-x u'.
 102 ;;
 103 ;; There is also a prettyfied version of the macroexpander:
 104 ;;
 105 ;;              C-Sym-m         (prettyexpand-sexp)
 106 ;; or           C-Sym-M         (prettyexpand-all-sexp)
 107 ;;
 108 ;; The only difference with the corresponding macroexpand commands is
 109 ;; that calls to macros specified in the variable
 110 ;; `pp-shadow-expansion-list' are not expanded, in order to make the
 111 ;; code look nicer. This is only useful for Lucid Emacs or code that
 112 ;; uses Dave Gillespies cl package, as it inhibits expansion of the
 113 ;; following macros: block, eval-when, defun*, defmacro*, function*,
 114 ;; setf.
 115 \f
 116 ; Change History
 117 ;
 118 ; $Log: pretty-print.el,v $
 119 ; Revision 1.3  2000-10-06 09:35:05  youngs
 120 ; Martin's Monster Mega typo patch
 121 ;
 122 ; Revision 1.2  1998/02/10 16:23:33  steveb
 123 ; pretty-print fixes
 124 ;
 125 ; Revision 1.4  1993/03/25  14:09:52  bosch
 126 ; Commands `prettyexpand-sexp' and `prettyexpand-all-sexp' and
 127 ; corresponding key bindings added.  Commands pp-{function, variable}
 128 ; rewritten. `pp-plist' added. Function `pp-internal-loop' (for Dave
 129 ; Gillespies CL loop macro) added.
 130 ;
 131 ; Revision 1.3  1993/03/03  12:24:13  bosch
 132 ; Macroexpander rewritten. Function `pp-macroexpand-all' added (snarfed
 133 ; from Dave Gillespies cl-extra.el). Pretty printing for top level
 134 ; defining forms added (`pp-internal-def'). Key bindings for
 135 ; `emacs-lisp-mode-map' and `lisp-interaction-mode-map' added.  Built-in
 136 ; variable `print-gensym' set for printinng uninterned symbols. Started
 137 ; adding support for cl-dg (defun*, defmacro*, ...).  Minor bug fixes.
 138 ;
 139 ; Revision 1.2  1993/02/25  17:35:02  bosch
 140 ; Comments about Emacs 18 compatibility added.
 141 ;
 142 ; Revision 1.1  1993/02/25  16:55:01  bosch
 143 ; Initial revision
 144 ;
 145 ;
 146 ;;; Code:
 147 \f
 148 ;; TO DO LIST
 149 ;; ----------
 150 ;; Provide full Emacs 18 compatibility.
 151 \f
 152 ;; Popper support
 153 (defvar pp-buffer-name "*Pretty Print*")
 154 (defvar pp-macroexpand-buffer-name "*Macro Expansion*")
 155 (if (featurep 'popper)
 156     (or (eq popper-pop-buffers 't)
 157         (setq popper-pop-buffers
 158               (cons pp-buffer-name
 159                     (cons pp-macroexpand-buffer-name
 160                           popper-pop-buffers)))))
 161
 162 ;; User level functions
 163 ;;;###autoload
 164 (defun pp-function (symbol)
 165   "Pretty print the function definition of SYMBOL in a separate buffer"
 166   (interactive
 167    (list (pp-read-symbol 'fboundp "Pretty print function definition of: ")))
 168   (if (compiled-function-p (symbol-function symbol))
 169       (if (y-or-n-p
 170            (format "Function %s is byte compiled. Disassemble? " symbol))
 171           (disassemble (symbol-function symbol))
 172         (pp-symbol-cell symbol 'symbol-function))
 173     (pp-symbol-cell symbol 'symbol-function)))
 174
 175 ;;;###autoload
 176 (defun pp-variable (symbol)
 177   "Pretty print the variable value of SYMBOL in a separate buffer"
 178   (interactive
 179    (list (pp-read-symbol 'boundp "Pretty print variable value of: ")))
 180   (pp-symbol-cell symbol 'symbol-value))
 181
 182 ;;;###autoload
 183 (defun pp-plist (symbol)
 184   "Pretty print the property list of SYMBOL in a separate buffer"
 185   (interactive
 186    (list (pp-read-symbol 'symbol-plist "Pretty print property list of: ")))
 187   (pp-symbol-cell symbol 'symbol-plist))
 188
 189 (defun pp-read-symbol (predicate prompt)
 190   "Read a symbol for which  PREDICATE is true, promptiong with PROMPT."
 191   (let (symbol)
 192     (while (or (not symbol) (not (funcall predicate symbol)))
 193       (setq symbol
 194             (intern-soft
 195              (completing-read
 196               prompt
 197               obarray
 198               predicate
 199               t
 200               (and symbol (symbol-name symbol))))))
 201     symbol))
 202
 203 (defun pp-symbol-cell (symbol accessor)
 204   "Pretty print the contents of the cell of SYMBOL that can be reached
 205 with the function ACCESSOR."
 206   (with-output-to-temp-buffer pp-buffer-name
 207     (set-buffer pp-buffer-name)
 208     (emacs-lisp-mode)
 209     (erase-buffer)
 210     (pp-internal
 211      (funcall accessor symbol)
 212      (format "%s's %s is:\n" symbol accessor))
 213     (terpri)))
 214
 215 \f
 216
 217 ;; Macro expansion (user level)
 218
 219 ;;;###autoload
 220 (defun macroexpand-sexp (&optional replace)
 221   "Macro expand the sexpression following point. Pretty print expansion in a
 222 temporary buffer. With prefix argument, replace the original
 223 sexpression by its expansion in the current buffer."
 224   (interactive "P")
 225   (pp-macroexpand-internal 'macroexpand replace t))
 226
 227 ;;;###autoload
 228 (defun macroexpand-all-sexp (&optional replace)
 229   "Macro expand recursively the sexpression following point. Pretty print
 230 expansion in a temporary buffer. With prefix argument, replace the
 231 original sexpression by its expansion in the current buffer."
 232   (interactive "P")
 233   (pp-macroexpand-internal 'pp-macroexpand-all replace t))
 234
 235 ;;;###autoload
 236 (defun prettyexpand-sexp (&optional replace)
 237   "Macro expand the sexpression following point. Pretty print expansion
 238 in a temporary buffer. With prefix argument, replace the original
 239 sexpression by its expansion in the current buffer.
 240         However, calls to macros specified in the variable
 241 `pp-shadow-expansion-list' are not expanded, in order to make the code
 242 look nicer."
 243
 244   (interactive "P")
 245   (pp-macroexpand-internal 'macroexpand replace))
 246
 247 ;;;###autoload
 248 (defun prettyexpand-all-sexp (&optional replace)
 249   "Macro expand recursively the sexpression following point. Pretty print
 250 expansion in a temporary buffer. With prefix argument, replace the
 251 original sexpression by its expansion in the current buffer.
 252         However, calls to macros specified in the variable
 253 `pp-shadow-expansion-list' are not expanded, in order to make the code
 254 look nicer."
 255   (interactive "P")
 256   (pp-macroexpand-internal 'pp-macroexpand-all replace))
 257
 258 ;; XEmacs: don't do this at load time.
 259 ;;(define-key emacs-lisp-mode-map '(control meta m) 'macroexpand-sexp)
 260 ;;(define-key emacs-lisp-mode-map '(control meta M) 'macroexpand-all-sexp)
 261 ;;(define-key emacs-lisp-mode-map '(control symbol m) 'prettyexpand-sexp)
 262 ;;(define-key emacs-lisp-mode-map '(control symbol M) 'prettyexpand-all-sexp)
 263
 264 ;;(define-key lisp-interaction-mode-map '(control meta m) 'macroexpand-sexp)
 265 ;;(define-key lisp-interaction-mode-map '(control meta M) 'macroexpand-all-sexp)
 266 ;;(define-key lisp-interaction-mode-map '(control symbol m) 'prettyexpand-sexp)
 267 ;;(define-key lisp-interaction-mode-map '(control symbol M) 'prettyexpand-all-sexp)
 268
 269 \f
 270 ;; Macro expansion (internals)