Nelze vybrat více než 25 témat
Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.
1129 řádky
45 KiB
1129 řádky
45 KiB
;;; macrostep.el --- interactive macro expander
|
|
|
|
;; Copyright (C) 2012-2015 Jon Oddie <j.j.oddie@gmail.com>
|
|
|
|
;; Author: joddie <j.j.oddie@gmail.com>
|
|
;; Maintainer: joddie <j.j.oddie@gmail.com>
|
|
;; Created: 16 January 2012
|
|
;; Updated: 07 December 2015
|
|
;; Version: 0.9
|
|
;; Keywords: lisp, languages, macro, debugging
|
|
;; Url: https://github.com/joddie/macrostep
|
|
;; Package-Requires: ((cl-lib "0.5"))
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;; This program 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 of the
|
|
;; License, or (at your option) any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful, but
|
|
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;; General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see `http://www.gnu.org/licenses/'.
|
|
|
|
;;; Commentary:
|
|
|
|
;; `macrostep' is an Emacs minor mode for interactively stepping through
|
|
;; the expansion of macros in Emacs Lisp source code. It lets you see
|
|
;; exactly what happens at each step of the expansion process by
|
|
;; pretty-printing the expanded forms inline in the source buffer, which is
|
|
;; temporarily read-only while macro expansions are visible. You can
|
|
;; expand and collapse macro forms one step at a time, and evaluate or
|
|
;; instrument the expansions for debugging with Edebug as normal (but see
|
|
;; "Bugs and known limitations", below). Single-stepping through the
|
|
;; expansion is particularly useful for debugging macros that expand into
|
|
;; another macro form. These can be difficult to debug with Emacs'
|
|
;; built-in `macroexpand', which continues expansion until the top-level
|
|
;; form is no longer a macro call.
|
|
|
|
;; Both globally-visible macros as defined by `defmacro' and local macros
|
|
;; bound by `(cl-)macrolet' or another macro-defining form can be expanded.
|
|
;; Within macro expansions, calls to macros and compiler macros are
|
|
;; fontified specially: macro forms using `macrostep-macro-face', and
|
|
;; functions with compiler macros using `macrostep-compiler-macro-face'.
|
|
;; Uninterned symbols (gensyms) are fontified based on which step in the
|
|
;; expansion created them, to distinguish them both from normal symbols and
|
|
;; from other gensyms with the same print name.
|
|
|
|
;; As of version 0.9, it is also possible to extend `macrostep' to work
|
|
;; with other languages with macro systems in addition to Emacs Lisp. An
|
|
;; extension for Common Lisp (via SLIME) is in the works; contributions for
|
|
;; other languages are welcome. See "Extending macrostep" below for
|
|
;; details.
|
|
|
|
|
|
;; 1 Key-bindings and usage
|
|
;; ========================
|
|
|
|
;; The standard keybindings in `macrostep-mode' are the following:
|
|
|
|
;; e, =, RET : expand the macro form following point one step
|
|
;; c, u, DEL : collapse the form following point
|
|
;; q, C-c C-c: collapse all expanded forms and exit macrostep-mode
|
|
;; n, TAB : jump to the next macro form in the expansion
|
|
;; p, M-TAB : jump to the previous macro form in the expansion
|
|
|
|
;; It's not very useful to enable and disable macrostep-mode directly.
|
|
;; Instead, bind `macrostep-expand' to a key in `emacs-lisp-mode-map',
|
|
;; for example C-c e:
|
|
|
|
;; ,----
|
|
;; | (define-key emacs-lisp-mode-map (kbd "C-c e") 'macrostep-expand)
|
|
;; `----
|
|
|
|
;; You can then enter macrostep-mode and expand a macro form completely
|
|
;; by typing `C-c e e e ...' as many times as necessary.
|
|
|
|
;; Exit macrostep-mode by typing `q' or `C-c C-c', or by successively
|
|
;; typing `c' to collapse all surrounding expansions.
|
|
|
|
|
|
;; 2 Customization options
|
|
;; =======================
|
|
|
|
;; Type `M-x customize-group RET macrostep RET' to customize options and
|
|
;; faces.
|
|
|
|
;; To display macro expansions in a separate window, instead of inline in
|
|
;; the source buffer, customize `macrostep-expand-in-separate-buffer' to
|
|
;; `t'. The default is `nil'. Whichever default behavior is selected,
|
|
;; the alternative behavior can be obtained temporarily by giving a
|
|
;; prefix argument to `macrostep-expand'.
|
|
|
|
;; To have `macrostep' ignore compiler macros, customize
|
|
;; `macrostep-expand-compiler-macros' to `nil'. The default is `t'.
|
|
|
|
;; Customize the faces `macrostep-macro-face',
|
|
;; `macrostep-compiler-macro-face', and `macrostep-gensym-1' through
|
|
;; `macrostep-gensym-5' to alter the appearance of macro expansions.
|
|
|
|
|
|
;; 3 Locally-bound macros
|
|
;; ======================
|
|
|
|
;; As of version 0.9, `macrostep' can expand calls to a locally-bound
|
|
;; macro, whether defined by a surrounding `(cl-)macrolet' form, or by
|
|
;; another macro-defining macro. In other words, it is possible to
|
|
;; expand the inner `local-macro' forms in both the following examples,
|
|
;; whether `local-macro' is defined by an enclosing `cl-macrolet' --
|
|
|
|
;; ,----
|
|
;; | (cl-macrolet ((local-macro (&rest args)
|
|
;; | `(expansion of ,args)))
|
|
;; | (local-macro (do-something)))
|
|
;; `----
|
|
|
|
;; -- or by a macro which expands into `cl-macrolet', provided that its
|
|
;; definition of macro is evaluated prior to calling `macrostep-expand':
|
|
|
|
;; ,----
|
|
;; | (defmacro with-local-macro (&rest body)
|
|
;; | `(cl-macrolet ((local-macro (&rest args)
|
|
;; | `(expansion of ,args)))
|
|
;; | ,@body))
|
|
;; |
|
|
;; | (with-local-macro
|
|
;; | (local-macro (do something (else)))
|
|
;; `----
|
|
|
|
;; See the `with-js' macro in Emacs's `js.el' for a real example of the
|
|
;; latter kind of macro.
|
|
|
|
;; Expansion of locally-bound macros is implemented by instrumenting
|
|
;; Emacs Lisp's macro-expander to capture the environment at point. A
|
|
;; similar trick is used to detect macro- and compiler-macro calls within
|
|
;; expanded text so that they can be fontified accurately.
|
|
|
|
|
|
;; 4 Expanding sub-forms
|
|
;; =====================
|
|
|
|
;; By moving point around in the macro expansion using
|
|
;; `macrostep-next-macro' and `macrostep-prev-macro' (bound to the `n'
|
|
;; and `p' keys), it is possible to expand other macro calls within the
|
|
;; expansion before expanding the outermost form. This can sometimes be
|
|
;; useful, although it does not correspond to the real order of macro
|
|
;; expansion in Emacs Lisp, which proceeds by fully expanding the outer
|
|
;; form to a non-macro form before expanding sub-forms.
|
|
|
|
;; The main reason to expand sub-forms out of order is to help with
|
|
;; debugging macros which programmatically expand their arguments in
|
|
;; order to rewrite them. Expanding the arguments of such a macro lets
|
|
;; you visualise what the macro definition would compute via
|
|
;; `macroexpand-all'.
|
|
|
|
|
|
;; 5 Extending macrostep for other languages
|
|
;; =========================================
|
|
|
|
;; Since version 0.9, it is possible to extend macrostep to work with
|
|
;; other languages besides Emacs Lisp. In typical Emacs fashion, this is
|
|
;; implemented by setting buffer-local variables to different function
|
|
;; values. Six buffer-local variables define the language-specific part
|
|
;; of the implementation:
|
|
|
|
;; - `macrostep-sexp-bounds-function'
|
|
;; - `macrostep-sexp-at-point-function'
|
|
;; - `macrostep-environment-at-point-function'
|
|
;; - `macrostep-expand-1-function'
|
|
;; - `macrostep-print-function'
|
|
;; - `macrostep-macro-form-p-function'
|
|
|
|
;; Typically, an implementation for another language would set these
|
|
;; variables in a major-mode hook. See the docstrings of each variable
|
|
;; for details on how each one is called and what it should return. At a
|
|
;; minimum, another language implementation needs to provide
|
|
;; `macrostep-sexp-at-point-function', `macrostep-expand-1-function', and
|
|
;; `macrostep-print-function'. Lisp-like languages may be able to reuse
|
|
;; the default `macrostep-sexp-bounds-function' if they provide another
|
|
;; implementation of `macrostep-macro-form-p-function'. Languages which
|
|
;; do not implement locally-defined macros can set
|
|
;; `macrostep-environment-at-point-function' to `ignore'.
|
|
|
|
;; Note that the core `macrostep' machinery only interprets the return
|
|
;; value of `macrostep-sexp-bounds-function', so implementations for
|
|
;; other languages can use any internal representations of code and
|
|
;; environments which is convenient. Although the terminology is
|
|
;; Lisp-specific, there is no reason that implementations could not be
|
|
;; provided for non-Lisp languages with macro systems, provided there is
|
|
;; some way of identifying macro calls and calling the compiler /
|
|
;; preprocessor to obtain their expansions.
|
|
|
|
|
|
;; 6 Bugs and known limitations
|
|
;; ============================
|
|
|
|
;; You can evaluate and edebug macro-expanded forms and step through the
|
|
;; macro-expanded version, but the form that `eval-defun' and friends
|
|
;; read from the buffer won't have the uninterned symbols of the real
|
|
;; macro expansion. This will probably work OK with CL-style gensyms,
|
|
;; but may cause problems with `make-symbol' symbols if they have the
|
|
;; same print name as another symbol in the expansion. It's possible that
|
|
;; using `print-circle' and `print-gensym' could get around this.
|
|
|
|
;; Please send other bug reports and feature requests to the author.
|
|
|
|
|
|
;; 7 Acknowledgements
|
|
;; ==================
|
|
|
|
;; Thanks to:
|
|
;; - John Wiegley for fixing a bug with the face definitions under Emacs
|
|
;; 24 & for plugging macrostep in his [EmacsConf presentation]!
|
|
;; - George Kettleborough for bug reports, and patches to highlight the
|
|
;; expanded region and properly handle backquotes.
|
|
;; - Nic Ferrier for suggesting support for local definitions within
|
|
;; macrolet forms
|
|
;; - Luís Oliveira for suggesting and implementing SLIME support
|
|
|
|
;; `macrostep' was originally inspired by J. V. Toups's 'Deep Emacs Lisp'
|
|
;; articles ([part 1], [part 2], [screencast]).
|
|
|
|
;; [EmacsConf presentation] http://youtu.be/RvPFZL6NJNQ
|
|
|
|
;; [part 1]
|
|
;; http://dorophone.blogspot.co.uk/2011/04/deep-emacs-part-1.html
|
|
|
|
;; [part 2]
|
|
;; http://dorophone.blogspot.co.uk/2011/04/deep-emacs-lisp-part-2.html
|
|
|
|
;; [screencast]
|
|
;; http://dorophone.blogspot.co.uk/2011/05/monadic-parser-combinators-in-elisp.html
|
|
|
|
|
|
;; 8 Changelog
|
|
;; ===========
|
|
|
|
;; - v0.9, 2015-10-01:
|
|
;; - separate into Elisp-specific and generic components
|
|
;; - highlight and expand compiler macros
|
|
;; - improve local macro expansion and macro form identification by
|
|
;; instrumenting `macroexpand(-all)'
|
|
;; - v0.8, 2014-05-29: fix a bug with printing the first element of lists
|
|
;; - v0.7, 2014-05-11: expand locally-defined macros within
|
|
;; `(cl-)macrolet' forms
|
|
;; - v0.6, 2013-05-04: better handling of quote and backquote
|
|
;; - v0.5, 2013-04-16: highlight region, maintain cleaner buffer state
|
|
;; - v0.4, 2013-04-07: only enter macrostep-mode on successful
|
|
;; macro-expansion
|
|
;; - v0.3, 2012-10-30: print dotted lists correctly. autoload
|
|
;; definitions.
|
|
|
|
;;; Code:
|
|
|
|
(require 'pp)
|
|
(require 'ring)
|
|
(eval-and-compile
|
|
(require 'cl-lib nil t)
|
|
(require 'cl-lib "lib/cl-lib"))
|
|
|
|
|
|
;;; Constants and dynamically bound variables
|
|
(defvar macrostep-overlays nil
|
|
"List of all macro stepper overlays in the current buffer.")
|
|
(make-variable-buffer-local 'macrostep-overlays)
|
|
|
|
(defvar macrostep-gensym-depth nil
|
|
"Number of macro expansion levels that have introduced gensyms so far.")
|
|
(make-variable-buffer-local 'macrostep-gensym-depth)
|
|
|
|
(defvar macrostep-gensyms-this-level nil
|
|
"t if gensyms have been encountered during current level of macro expansion.")
|
|
(make-variable-buffer-local 'macrostep-gensyms-this-level)
|
|
|
|
(defvar macrostep-saved-undo-list nil
|
|
"Saved value of buffer-undo-list upon entering macrostep mode.")
|
|
(make-variable-buffer-local 'macrostep-saved-undo-list)
|
|
|
|
(defvar macrostep-saved-read-only nil
|
|
"Saved value of buffer-read-only upon entering macrostep mode.")
|
|
(make-variable-buffer-local 'macrostep-saved-read-only)
|
|
|
|
(defvar macrostep-expansion-buffer nil
|
|
"Non-nil if the current buffer is a macro-expansion buffer.")
|
|
(make-variable-buffer-local 'macrostep-expansion-buffer)
|
|
|
|
(defvar macrostep-outer-environment nil
|
|
"Outermost macro-expansion environment to use in a dedicated macro-expansion buffers.
|
|
|
|
This variable is used to save information about any enclosing
|
|
`cl-macrolet' context when a macro form is expanded in a separate
|
|
buffer.")
|
|
(make-variable-buffer-local 'macrostep-outer-environment)
|
|
|
|
;;; Customization options and faces
|
|
(defgroup macrostep nil
|
|
"Interactive macro stepper for Emacs Lisp."
|
|
:group 'lisp
|
|
:link '(emacs-commentary-link :tag "commentary" "macrostep.el")
|
|
:link '(emacs-library-link :tag "lisp file" "macrostep.el")
|
|
:link '(url-link :tag "web page" "https://github.com/joddie/macrostep"))
|
|
|
|
(defface macrostep-gensym-1
|
|
'((((min-colors 16581375)) :foreground "#8080c0" :box t :bold t)
|
|
(((min-colors 8)) :background "cyan")
|
|
(t :inverse-video t))
|
|
"Face for gensyms created in the first level of macro expansion."
|
|
:group 'macrostep)
|
|
|
|
(defface macrostep-gensym-2
|
|
'((((min-colors 16581375)) :foreground "#8fbc8f" :box t :bold t)
|
|
(((min-colors 8)) :background "#00cd00")
|
|
(t :inverse-video t))
|
|
"Face for gensyms created in the second level of macro expansion."
|
|
:group 'macrostep)
|
|
|
|
(defface macrostep-gensym-3
|
|
'((((min-colors 16581375)) :foreground "#daa520" :box t :bold t)
|
|
(((min-colors 8)) :background "yellow")
|
|
(t :inverse-video t))
|
|
"Face for gensyms created in the third level of macro expansion."
|
|
:group 'macrostep)
|
|
|
|
(defface macrostep-gensym-4
|
|
'((((min-colors 16581375)) :foreground "#cd5c5c" :box t :bold t)
|
|
(((min-colors 8)) :background "red")
|
|
(t :inverse-video t))
|
|
"Face for gensyms created in the fourth level of macro expansion."
|
|
:group 'macrostep)
|
|
|
|
(defface macrostep-gensym-5
|
|
'((((min-colors 16581375)) :foreground "#da70d6" :box t :bold t)
|
|
(((min-colors 8)) :background "magenta")
|
|
(t :inverse-video t))
|
|
"Face for gensyms created in the fifth level of macro expansion."
|
|
:group 'macrostep)
|
|
|
|
(defface macrostep-expansion-highlight-face
|
|
'((((min-colors 16581375) (background light)) :background "#eee8d5")
|
|
(((min-colors 16581375) (background dark)) :background "#222222"))
|
|
"Face for macro-expansion highlight."
|
|
:group 'macrostep)
|
|
|
|
(defface macrostep-macro-face
|
|
'((t :underline t))
|
|
"Face for macros in macro-expanded code."
|
|
:group 'macrostep)
|
|
|
|
(defface macrostep-compiler-macro-face
|
|
'((t :slant italic))
|
|
"Face for compiler macros in macro-expanded code."
|
|
:group 'macrostep)
|
|
|
|
(defcustom macrostep-expand-in-separate-buffer nil
|
|
"When non-nil, show expansions in a separate buffer instead of inline."
|
|
:group 'macrostep
|
|
:type 'boolean)
|
|
|
|
(defcustom macrostep-expand-compiler-macros t
|
|
"When non-nil, expand compiler macros as well as `defmacro' and `macrolet' macros."
|
|
:group 'macrostep
|
|
:type 'boolean)
|
|
|
|
;; Need the following for making the ring of faces
|
|
(defun macrostep-make-ring (&rest items)
|
|
"Make a ring containing all of ITEMS with no empty slots."
|
|
(let ((ring (make-ring (length items))))
|
|
(mapc (lambda (item) (ring-insert ring item)) (reverse items))
|
|
ring))
|
|
|
|
(defvar macrostep-gensym-faces
|
|
(macrostep-make-ring
|
|
'macrostep-gensym-1 'macrostep-gensym-2 'macrostep-gensym-3
|
|
'macrostep-gensym-4 'macrostep-gensym-5)
|
|
"Ring of all macrostepper faces for fontifying gensyms.")
|
|
|
|
;; Other modes can enable macrostep by redefining these functions to
|
|
;; language-specific versions.
|
|
(defvar macrostep-sexp-bounds-function
|
|
#'macrostep-sexp-bounds
|
|
"Function to return the bounds of the macro form nearest point.
|
|
|
|
It will be called with no arguments and should return a cons of
|
|
buffer positions, (START . END). It should use `save-excursion'
|
|
to avoid changing the position of point.
|
|
|
|
The default value, `macrostep-sexp-bounds', implements this for
|
|
Emacs Lisp, and may be suitable for other Lisp-like languages.")
|
|
(make-variable-buffer-local 'macrostep-sexp-bounds-function)
|
|
|
|
(defvar macrostep-sexp-at-point-function
|
|
#'macrostep-sexp-at-point
|
|
"Function to return the macro form at point for expansion.
|
|
|
|
It will be called with two arguments, the values of START and END
|
|
returned by `macrostep-sexp-bounds-function', and with point
|
|
positioned at START. It should return a value suitable for
|
|
passing as the first argument to `macrostep-expand-1-function'.
|
|
|
|
The default value, `macrostep-sexp-at-point', implements this for
|
|
Emacs Lisp, and may be suitable for other Lisp-like languages.")
|
|
(make-variable-buffer-local 'macrostep-sexp-at-point-function)
|
|
|
|
(defvar macrostep-environment-at-point-function
|
|
#'macrostep-environment-at-point
|
|
"Function to return the local macro-expansion environment at point.
|
|
|
|
It will be called with no arguments, and should return a value
|
|
suitable for passing as the second argument to
|
|
`macrostep-expand-1-function'.
|
|
|
|
The default value, `macrostep-environment-at-point', is specific
|
|
to Emacs Lisp. For languages which do not implement local
|
|
macro-expansion environments, this should be set to `ignore'
|
|
or `(lambda () nil)'.")
|
|
(make-variable-buffer-local 'macrostep-environment-at-point-function)
|
|
|
|
(defvar macrostep-expand-1-function
|
|
#'macrostep-expand-1
|
|
"Function to perform one step of macro-expansion.
|
|
|
|
It will be called with two arguments, FORM and ENVIRONMENT, the
|
|
return values of `macrostep-sexp-at-point-function' and
|
|
`macrostep-environment-at-point-function' respectively. It
|
|
should return the result of expanding FORM by one step as a value
|
|
which is suitable for passing as the argument to
|
|
`macrostep-print-function'.
|
|
|
|
The default value, `macrostep-expand-1', is specific to Emacs Lisp.")
|
|
(make-variable-buffer-local 'macrostep-expand-1-function)
|
|
|
|
(defvar macrostep-print-function
|
|
#'macrostep-pp
|
|
"Function to pretty-print macro expansions.
|
|
|
|
It will be called with two arguments, FORM and ENVIRONMENT, the
|
|
return values of `macrostep-sexp-at-point-function' and
|
|
`macrostep-environment-at-point-function' respectively. It
|
|
should insert a pretty-printed representation at point in the
|
|
current buffer, leaving point just after the inserted
|
|
representation, without altering any other text in the current
|
|
buffer.
|
|
|
|
The default value, `macrostep-pp', is specific to Emacs Lisp.")
|
|
(make-variable-buffer-local 'macrostep-print-function)
|
|
|
|
(defvar macrostep-macro-form-p-function
|
|
#'macrostep-macro-form-p
|
|
"Function to check whether a form is a macro call.
|
|
|
|
It will be called with two arguments, FORM and ENVIRONMENT -- the
|
|
return values of `macrostep-sexp-at-point-function' and
|
|
`macrostep-environment-at-point-function' respectively -- and
|
|
should return non-nil if FORM would undergo macro-expansion in
|
|
ENVIRONMENT.
|
|
|
|
This is called only from `macrostep-sexp-bounds', so it need not
|
|
be provided if a different value is used for
|
|
`macrostep-sexp-bounds-function'.
|
|
|
|
The default value, `macrostep-macro-form-p', is specific to Emacs Lisp.")
|
|
(make-variable-buffer-local 'macrostep-macro-form-p-function)
|
|
|
|
|
|
;;; Define keymap and minor mode
|
|
(defvar macrostep-keymap
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (kbd "RET") 'macrostep-expand)
|
|
(define-key map "=" 'macrostep-expand)
|
|
(define-key map "e" 'macrostep-expand)
|
|
|
|
(define-key map (kbd "DEL") 'macrostep-collapse)
|
|
(define-key map "u" 'macrostep-collapse)
|
|
(define-key map "c" 'macrostep-collapse)
|
|
|
|
(define-key map (kbd "TAB") 'macrostep-next-macro)
|
|
(define-key map "n" 'macrostep-next-macro)
|
|
(define-key map (kbd "M-TAB") 'macrostep-prev-macro)
|
|
(define-key map "p" 'macrostep-prev-macro)
|
|
|
|
(define-key map "q" 'macrostep-collapse-all)
|
|
(define-key map (kbd "C-c C-c") 'macrostep-collapse-all)
|
|
map)
|
|
"Keymap for `macrostep-mode'.")
|
|
|
|
;;;###autoload
|
|
(define-minor-mode macrostep-mode
|
|
"Minor mode for inline expansion of macros in Emacs Lisp source buffers.
|
|
|
|
\\<macrostep-keymap>Progressively expand macro forms with \\[macrostep-expand], collapse them with \\[macrostep-collapse],
|
|
and move back and forth with \\[macrostep-next-macro] and \\[macrostep-prev-macro].
|
|
Use \\[macrostep-collapse-all] or collapse all visible expansions to
|
|
quit and return to normal editing.
|
|
|
|
\\{macrostep-keymap}"
|
|
nil " Macro-Stepper"
|
|
:keymap macrostep-keymap
|
|
:group macrostep
|
|
(if macrostep-mode
|
|
(progn
|
|
;; Disable recording of undo information
|
|
(setq macrostep-saved-undo-list buffer-undo-list
|
|
buffer-undo-list t)
|
|
;; Remember whether buffer was read-only
|
|
(setq macrostep-saved-read-only buffer-read-only
|
|
buffer-read-only t)
|
|
;; Set up post-command hook to bail out on leaving read-only
|
|
(add-hook 'post-command-hook 'macrostep-command-hook nil t)
|
|
(message
|
|
(substitute-command-keys
|
|
"\\<macrostep-keymap>Entering macro stepper mode. Use \\[macrostep-expand] to expand, \\[macrostep-collapse] to collapse, \\[macrostep-collapse-all] to exit.")))
|
|
|
|
;; Exiting mode
|
|
(if macrostep-expansion-buffer
|
|
;; Kill dedicated expansion buffers
|
|
(quit-window t)
|
|
;; Collapse any remaining overlays
|
|
(when macrostep-overlays (macrostep-collapse-all))
|
|
;; Restore undo info & read-only state
|
|
(setq buffer-undo-list macrostep-saved-undo-list
|
|
buffer-read-only macrostep-saved-read-only
|
|
macrostep-saved-undo-list nil)
|
|
;; Remove our post-command hook
|
|
(remove-hook 'post-command-hook 'macrostep-command-hook t))))
|
|
|
|
;; Post-command hook: bail out of macrostep-mode if the user types C-x
|
|
;; C-q to make the buffer writable again.
|
|
(defun macrostep-command-hook ()
|
|
(if (not buffer-read-only)
|
|
(macrostep-mode 0)))
|
|
|
|
|
|
;;; Interactive functions
|
|
;;;###autoload
|
|
(defun macrostep-expand (&optional toggle-separate-buffer)
|
|
"Expand the macro form following point by one step.
|
|
|
|
Enters `macrostep-mode' if it is not already active, making the
|
|
buffer temporarily read-only. If macrostep-mode is active and the
|
|
form following point is not a macro form, search forward in the
|
|
buffer and expand the next macro form found, if any.
|
|
|
|
With a prefix argument, the expansion is displayed in a separate
|
|
buffer instead of inline in the current buffer. Setting
|
|
`macrostep-expand-in-separate-buffer' to non-nil swaps these two
|
|
behaviors."
|
|
(interactive "P")
|
|
(cl-destructuring-bind (start . end)
|
|
(funcall macrostep-sexp-bounds-function)
|
|
(goto-char start)
|
|
(let* ((sexp (funcall macrostep-sexp-at-point-function start end))
|
|
(end (copy-marker end))
|
|
(text (buffer-substring start end))
|
|
(env (funcall macrostep-environment-at-point-function))
|
|
(expansion (funcall macrostep-expand-1-function sexp env)))
|
|
|
|
;; Create a dedicated macro-expansion buffer and copy the text to
|
|
;; be expanded into it, if required
|
|
(let ((separate-buffer-p
|
|
(if toggle-separate-buffer
|
|
(not macrostep-expand-in-separate-buffer)
|
|
macrostep-expand-in-separate-buffer)))
|
|
(when (and separate-buffer-p (not macrostep-expansion-buffer))
|
|
(let ((mode major-mode)
|
|
(buffer
|
|
(get-buffer-create (generate-new-buffer-name "*macro expansion*"))))
|
|
(set-buffer buffer)
|
|
(funcall mode)
|
|
(setq macrostep-expansion-buffer t)
|
|
(setq macrostep-outer-environment env)
|
|
(save-excursion
|
|
(setq start (point))
|
|
(insert text)
|
|
(setq end (point-marker)))
|
|
(pop-to-buffer buffer))))
|
|
|
|
(unless macrostep-mode (macrostep-mode t))
|
|
(let ((existing-overlay (macrostep-overlay-at-point))
|
|
(macrostep-gensym-depth macrostep-gensym-depth)
|
|
(macrostep-gensyms-this-level nil)
|
|
priority)
|
|
(if existing-overlay
|
|
(progn ; Expanding part of a previous macro-expansion
|
|
(setq priority (1+ (overlay-get existing-overlay 'priority)))
|
|
(setq macrostep-gensym-depth
|
|
(overlay-get existing-overlay 'macrostep-gensym-depth)))
|
|
;; Expanding source buffer text
|
|
(setq priority 1)
|
|
(setq macrostep-gensym-depth -1))
|
|
|
|
(with-silent-modifications
|
|
(atomic-change-group
|
|
(let ((inhibit-read-only t))
|
|
(save-excursion
|
|
;; Insert expansion
|
|
(funcall macrostep-print-function expansion env)
|
|
;; Delete the original form
|
|
(macrostep-collapse-overlays-in (point) end)
|
|
(delete-region (point) end)
|
|
;; Create a new overlay
|
|
(let* ((overlay
|
|
(make-overlay start
|
|
(if (looking-at "\n")
|
|
(1+ (point))
|
|
(point))))
|
|
(highlight-overlay (unless macrostep-expansion-buffer
|
|
(copy-overlay overlay))))
|
|
(unless macrostep-expansion-buffer
|
|
;; Highlight the overlay in original source buffers only
|
|
(overlay-put highlight-overlay 'face 'macrostep-expansion-highlight-face)
|
|
(overlay-put highlight-overlay 'priority -1)
|
|
(overlay-put overlay 'macrostep-highlight-overlay highlight-overlay))
|
|
(overlay-put overlay 'priority priority)
|
|
(overlay-put overlay 'macrostep-original-text text)
|
|
(overlay-put overlay 'macrostep-gensym-depth macrostep-gensym-depth)
|
|
(push overlay macrostep-overlays))))))))))
|
|
|
|
(defun macrostep-collapse ()
|
|
"Collapse the innermost macro expansion near point to its source text.
|
|
|
|
If no more macro expansions are visible after this, exit
|
|
`macrostep-mode'."
|
|
(interactive)
|
|
(let ((overlay (macrostep-overlay-at-point)))
|
|
(when (not overlay) (error "No macro expansion at point"))
|
|
(let ((inhibit-read-only t))
|
|
(with-silent-modifications
|
|
(atomic-change-group
|
|
(macrostep-collapse-overlay overlay)))))
|
|
(if (not macrostep-overlays)
|
|
(macrostep-mode 0)))
|
|
|
|
(defun macrostep-collapse-all ()
|
|
"Collapse all visible macro expansions and exit `macrostep-mode'."
|
|
(interactive)
|
|
(let ((inhibit-read-only t))
|
|
(with-silent-modifications
|
|
(dolist (overlay macrostep-overlays)
|
|
(let ((outermost (= (overlay-get overlay 'priority) 1)))
|
|
;; We only need restore the original text for the outermost
|
|
;; overlays
|
|
(macrostep-collapse-overlay overlay (not outermost))))))
|
|
(setq macrostep-overlays nil)
|
|
(macrostep-mode 0))
|
|
|
|
(defun macrostep-next-macro ()
|
|
"Move point forward to the next macro form in macro-expanded text."
|
|
(interactive)
|
|
(let* ((start
|
|
(if (get-text-property (point) 'macrostep-macro-start)
|
|
(1+ (point))
|
|
(point)))
|
|
(next (next-single-property-change start 'macrostep-macro-start)))
|
|
(if next
|
|
(goto-char next)
|
|
(error "No more macro forms found"))))
|
|
|
|
(defun macrostep-prev-macro ()
|
|
"Move point back to the previous macro form in macro-expanded text."
|
|
(interactive)
|
|
(let (prev)
|
|
(save-excursion
|
|
(while
|
|
(progn
|
|
(setq prev
|
|
(previous-single-property-change (point) 'macrostep-macro-start))
|
|
(if (or (not prev)
|
|
(get-text-property (1- prev) 'macrostep-macro-start))
|
|
nil
|
|
(prog1 t (goto-char prev))))))
|
|
(if prev
|
|
(goto-char (1- prev))
|
|
(error "No previous macro form found"))))
|
|
|
|
|
|
;;; Utility functions (not language-specific)
|
|
|
|
(defun macrostep-overlay-at-point ()
|
|
"Return the innermost macro stepper overlay at point."
|
|
(let ((result
|
|
(get-char-property-and-overlay (point) 'macrostep-original-text)))
|
|
(cdr result)))
|
|
|
|
(defun macrostep-collapse-overlay (overlay &optional no-restore-p)
|
|
"Collapse a macro-expansion overlay and restore the unexpanded source text.
|
|
|
|
As a minor optimization, does not restore the original source
|
|
text if NO-RESTORE-P is non-nil. This is safe to do when
|
|
collapsing all the sub-expansions of an outer overlay, since the
|
|
outer overlay will restore the original source itself.
|
|
|
|
Also removes the overlay from `macrostep-overlays'."
|
|
(with-current-buffer (overlay-buffer overlay)
|
|
;; If we're cleaning up we don't need to bother restoring text
|
|
;; or checking for inner overlays to delete
|
|
(unless no-restore-p
|
|
(let* ((start (overlay-start overlay))
|
|
(end (overlay-end overlay))
|
|
(text (overlay-get overlay 'macrostep-original-text))
|
|
(sexp-end
|
|
(copy-marker
|
|
(if (equal (char-before end) ?\n) (1- end) end))))
|
|
(macrostep-collapse-overlays-in start end)
|
|
(goto-char (overlay-start overlay))
|
|
(save-excursion
|
|
(insert text)
|
|
(delete-region (point) sexp-end))))
|
|
;; Remove overlay from the list and delete it
|
|
(setq macrostep-overlays
|
|
(delq overlay macrostep-overlays))
|
|
(let ((highlight-overlay (overlay-get overlay 'macrostep-highlight-overlay)))
|
|
(when highlight-overlay (delete-overlay highlight-overlay)))
|
|
(delete-overlay overlay)))
|
|
|
|
(defun macrostep-collapse-overlays-in (start end)
|
|
"Collapse all macrostepper overlays that are strictly between START and END.
|
|
|
|
Will not collapse overlays that begin at START and end at END."
|
|
(dolist (ol (overlays-in start end))
|
|
(when (and (overlay-buffer ol) ; collapsing may delete other overlays
|
|
(> (overlay-start ol) start)
|
|
(< (overlay-end ol) end)
|
|
(overlay-get ol 'macrostep-original-text))
|
|
(macrostep-collapse-overlay ol t))))
|
|
|
|
|
|
;;; Emacs Lisp implementation
|
|
|
|
(defun macrostep-sexp-bounds ()
|
|
"Find the bounds of the macro form nearest point.
|
|
|
|
If point is not before an open-paren, moves up to the nearest
|
|
enclosing list. If the form at point is not a macro call,
|
|
attempts to move forward to the next macro form as determined by
|
|
`macrostep-macro-form-p-function'.
|
|
|
|
Returns a cons of buffer positions, (START . END)."
|
|
(save-excursion
|
|
(if (not (looking-at "[(`]"))
|
|
(backward-up-list 1))
|
|
(if (equal (char-before) ?`)
|
|
(backward-char))
|
|
(let ((sexp (funcall macrostep-sexp-at-point-function))
|
|
(env (funcall macrostep-environment-at-point-function)))
|
|
;; If this isn't a macro form, try to find the next one in the buffer
|
|
(unless (funcall macrostep-macro-form-p-function sexp env)
|
|
(condition-case nil
|
|
(macrostep-next-macro)
|
|
(error
|
|
(if (consp sexp)
|
|
(error "(%s ...) is not a macro form" (car sexp))
|
|
(error "Text at point is not a macro form."))))))
|
|
(cons (point) (scan-sexps (point) 1))))
|
|
|
|
(defun macrostep-sexp-at-point (&rest ignore)
|
|
"Return the sexp near point for purposes of macro-stepper expansion.
|
|
|
|
If the sexp near point is part of a macro expansion, returns the
|
|
saved text of the macro expansion, and does not read from the
|
|
buffer. This preserves uninterned symbols in the macro
|
|
expansion, so that they can be fontified consistently. (See
|
|
`macrostep-print-sexp'.)"
|
|
(or (get-text-property (point) 'macrostep-expanded-text)
|
|
(sexp-at-point)))
|
|
|
|
(defun macrostep-macro-form-p (form environment)
|
|
"Return non-nil if FORM would be evaluated via macro expansion.
|
|
|
|
If FORM is an invocation of a macro defined by `defmacro' or an
|
|
enclosing `cl-macrolet' form, return the symbol `macro'.
|
|
|
|
If `macrostep-expand-compiler-macros' is non-nil and FORM is a
|
|
call to a function with a compiler macro, return the symbol
|
|
`compiler-macro'.
|
|
|
|
Otherwise, return nil."
|
|
(car (macrostep--macro-form-info form environment t)))
|
|
|
|
(defun macrostep--macro-form-info (form environment &optional inhibit-autoload)
|
|
"Return information about macro definitions that apply to FORM.
|
|
|
|
If no macros are involved in the evaluation of FORM within
|
|
ENVIRONMENT, returns nil. Otherwise, returns a cons (TYPE
|
|
. DEFINITION).
|
|
|
|
If FORM would be evaluated by a macro defined by `defmacro',
|
|
`cl-macrolet', etc., TYPE is the symbol `macro' and DEFINITION is
|
|
the macro definition, as a function.
|
|
|
|
If `macrostep-expand-compiler-macros' is non-nil and FORM would
|
|
be compiled using a compiler macro, TYPE is the symbol
|
|
`compiler-macro' and DEFINITION is the function that implements
|
|
the compiler macro.
|
|
|
|
If FORM is an invocation of an autoloaded macro, the behavior
|
|
depends on the value of INHIBIT-AUTOLOAD. If INHIBIT-AUTOLOAD is
|
|
nil, the file containing the macro definition will be loaded
|
|
using `load-library' and the macro definition returned as normal.
|
|
If INHIBIT-AUTOLOAD is non-nil, no files will be loaded, and the
|
|
value of DEFINITION in the result will be nil."
|
|
(if (not (and (consp form)
|
|
(symbolp (car form))))
|
|
`(nil . nil)
|
|
(let* ((head (car form))
|
|
(local-definition (assoc-default head environment #'eq)))
|
|
(if local-definition
|
|
`(macro . ,local-definition)
|
|
(let ((compiler-macro-definition
|
|
(and macrostep-expand-compiler-macros
|
|
(or (get head 'compiler-macro)
|
|
(get head 'cl-compiler-macro)))))
|
|
(if (and compiler-macro-definition
|
|
(not (eq form
|
|
(apply compiler-macro-definition form (cdr form)))))
|
|
`(compiler-macro . ,compiler-macro-definition)
|
|
(condition-case nil
|
|
(let ((fun (indirect-function head)))
|
|
(cl-case (car-safe fun)
|
|
((macro)
|
|
`(macro . ,(cdr fun)))
|
|
((autoload)
|
|
(when (memq (nth 4 fun) '(macro t))
|
|
(if inhibit-autoload
|
|
`(macro . nil)
|
|
(load-library (nth 1 fun))
|
|
(macrostep--macro-form-info form nil))))
|
|
(t
|
|
`(nil . nil))))
|
|
(void-function nil))))))))
|
|
|
|
(defun macrostep-expand-1 (form environment)
|
|
"Return result of macro-expanding the top level of FORM by exactly one step.
|
|
Unlike `macroexpand', this function does not continue macro
|
|
expansion until a non-macro-call results."
|
|
(cl-destructuring-bind (type . definition)
|
|
(macrostep--macro-form-info form environment)
|
|
(cl-ecase type
|
|
((nil)
|
|
form)
|
|
((macro)
|
|
(apply definition (cdr form)))
|
|
((compiler-macro)
|
|
(let ((expansion
|
|
(apply definition form (cdr form))))
|
|
(if (equal form expansion)
|
|
(error "Form left unchanged by compiler macro")
|
|
expansion))))))
|
|
|
|
(put 'macrostep-grab-environment-failed 'error-conditions
|
|
'(macrostep-grab-environment-failed error))
|
|
|
|
(defun macrostep-environment-at-point ()
|
|
"Return the local macro-expansion environment at point, if any.
|
|
|
|
The local environment includes macros declared by any `macrolet'
|
|
or `cl-macrolet' forms surrounding point, as well as by any macro
|
|
forms which expand into a `macrolet'.
|
|
|
|
The return value is an alist of elements (NAME . FUNCTION), where
|
|
NAME is the symbol locally bound to the macro and FUNCTION is the
|
|
lambda expression that returns its expansion."
|
|
;; If point is on a macro form within an expansion inserted by
|
|
;; `macrostep-print-sexp', a local environment may have been
|
|
;; previously saved as a text property.
|
|
(let ((saved-environment
|
|
(get-text-property (point) 'macrostep-environment)))
|
|
(if saved-environment
|
|
saved-environment
|
|
;; Otherwise, we (ab)use the macro-expander to return the
|
|
;; environment at point. If point is not at an evaluated
|
|
;; position in the containing form,
|
|
;; `macrostep-environment-at-point-1' will raise an error, and
|
|
;; we back up progressively through the containing forms until
|
|
;; it succeeds.
|
|
(save-excursion
|
|
(catch 'done
|
|
(while t
|
|
(condition-case nil
|
|
(throw 'done (macrostep-environment-at-point-1))
|
|
(macrostep-grab-environment-failed
|
|
(condition-case nil
|
|
(backward-sexp)
|
|
(scan-error (backward-up-list)))))))))))
|
|
|
|
(defun macrostep-environment-at-point-1 ()
|
|
"Attempt to extract the macro environment that would be active at point.
|
|
|
|
If point is not at an evaluated position within the containing
|
|
form, raise an error."
|
|
;; Macro environments are extracted using Emacs Lisp's builtin
|
|
;; macro-expansion machinery. The form containing point is copied
|
|
;; to a temporary buffer, and a call to
|
|
;; `--macrostep-grab-environment--' is inserted at point. This
|
|
;; altered form is then fully macro-expanded, in an environment
|
|
;; where `--macrostep-grab-environment--' is defined as a macro
|
|
;; which throws the environment to a uniquely-generated tag.
|
|
(let* ((point-at-top-level
|
|
(save-excursion
|
|
(while (ignore-errors (backward-up-list) t))
|
|
(point)))
|
|
(enclosing-form
|
|
(buffer-substring point-at-top-level
|
|
(scan-sexps point-at-top-level 1)))
|
|
(position (- (point) point-at-top-level))
|
|
(tag (make-symbol "macrostep-grab-environment-tag"))
|
|
(grab-environment '--macrostep-grab-environment--))
|
|
(if (= position 0)
|
|
nil
|
|
(with-temp-buffer
|
|
(emacs-lisp-mode)
|
|
(insert enclosing-form)
|
|
(goto-char (+ (point-min) position))
|
|
(prin1 `(,grab-environment) (current-buffer))
|
|
(let ((form (read (copy-marker (point-min)))))
|
|
(catch tag
|
|
(cl-letf (((symbol-function #'message) (symbol-function #'format)))
|
|
(with-no-warnings
|
|
(ignore-errors
|
|
(macroexpand-all
|
|
`(cl-macrolet ((,grab-environment (&environment env)
|
|
(throw ',tag env)))
|
|
,form)))))
|
|
(signal 'macrostep-grab-environment-failed nil)))))))
|
|
|
|
(defun macrostep-collect-macro-forms (form &optional environment)
|
|
"Identify sub-forms of FORM which undergo macro-expansion.
|
|
|
|
FORM is an Emacs Lisp form. ENVIRONMENT is a local environment of
|
|
macro definitions.
|
|
|
|
The return value is a list of two elements, (MACRO-FORM-ALIST
|
|
COMPILER-MACRO-FORMS).
|
|
|
|
MACRO-FORM-ALIST is an alist of elements of the form (SUBFORM
|
|
. ENVIRONMENT), where SUBFORM is a form which undergoes
|
|
macro-expansion in the course of expanding FORM, and ENVIRONMENT
|
|
is the local macro environment in force when it is expanded.
|
|
|
|
COMPILER-MACRO-FORMS is a list of subforms which would be
|
|
compiled using a compiler macro. Since there is no standard way
|
|
to provide a local compiler-macro definition in Emacs Lisp, no
|
|
corresponding local environments are collected for these.
|
|
|
|
Forms and environments are extracted from FORM by instrumenting
|
|
Emacs's builtin `macroexpand' function and calling
|
|
`macroexpand-all'."
|
|
(let ((real-macroexpand (indirect-function #'macroexpand))
|
|
(macro-form-alist '())
|
|
(compiler-macro-forms '()))
|
|
(cl-letf
|
|
(((symbol-function #'macroexpand)
|
|
(lambda (form environment &rest args)
|
|
(let ((expansion
|
|
(apply real-macroexpand form environment args)))
|
|
(cond ((not (eq expansion form))
|
|
(setq macro-form-alist
|
|
(cons (cons form environment)
|
|
macro-form-alist)))
|
|
((and (consp form)
|
|
(symbolp (car form))
|
|
macrostep-expand-compiler-macros
|
|
(not (eq form
|
|
(cl-compiler-macroexpand form))))
|
|
(setq compiler-macro-forms
|
|
(cons form compiler-macro-forms))))
|
|
expansion))))
|
|
(ignore-errors
|
|
(macroexpand-all form environment)))
|
|
(list macro-form-alist compiler-macro-forms)))
|
|
|
|
(defvar macrostep-collected-macro-form-alist nil
|
|
"An alist of macro forms and environments.
|
|
Controls the printing of sub-forms in `macrostep-print-sexp'.")
|
|
|
|
(defvar macrostep-collected-compiler-macro-forms nil
|
|
"A list of compiler-macro forms to be highlighted in `macrostep-print-sexp'.")
|
|
|
|
(defun macrostep-pp (sexp environment)
|
|
"Pretty-print SEXP, fontifying macro forms and uninterned symbols."
|
|
(cl-destructuring-bind
|
|
(macrostep-collected-macro-form-alist
|
|
macrostep-collected-compiler-macro-forms)
|
|
(macrostep-collect-macro-forms sexp environment)
|
|
(let ((print-quoted t))
|
|
(macrostep-print-sexp sexp)
|
|
;; Point is now after the expanded form; pretty-print it
|
|
(save-restriction
|
|
(narrow-to-region (scan-sexps (point) -1) (point))
|
|
(save-excursion
|
|
(pp-buffer)
|
|
;; Remove the extra newline inserted by pp-buffer
|
|
(goto-char (point-max))
|
|
(delete-region
|
|
(point)
|
|
(save-excursion (skip-chars-backward " \t\n") (point))))
|
|
;; Indent the newly-inserted form in context
|
|
(widen)
|
|
(save-excursion
|
|
(backward-sexp)
|
|
(indent-sexp))))))
|
|
|
|
;; This must be defined before `macrostep-print-sexp':
|
|
(defmacro macrostep-propertize (form &rest plist)
|
|
"Evaluate FORM, applying syntax properties in PLIST to any inserted text."
|
|
(declare (indent 1)
|
|
(debug (&rest form)))
|
|
(let ((start (make-symbol "start")))
|
|
`(let ((,start (point)))
|
|
(prog1
|
|
,form
|
|
,@(cl-loop for (key value) on plist by #'cddr
|
|
collect `(put-text-property ,start (point)
|
|
,key ,value))))))
|
|
|
|
(defun macrostep-print-sexp (sexp)
|
|
"Insert SEXP like `print', fontifying macro forms and uninterned symbols.
|
|
|
|
Fontifies uninterned symbols and macro forms using
|
|
`font-lock-face' property, and saves the actual text of SEXP's
|
|
sub-forms as the `macrostep-expanded-text' text property so that
|
|
any uninterned symbols can be reused in macro expansions of the
|
|
sub-forms. See also `macrostep-sexp-at-point'.
|
|
|
|
Macro and compiler-macro forms within SEXP are identified by
|
|
comparison with the `macrostep-collected-macro-form-alist' and
|
|
`macrostep-collected-compiler-macro-forms' variables, which
|
|
should be dynamically let-bound around calls to this function."
|
|
(cond
|
|
((symbolp sexp)
|
|
;; Fontify gensyms
|
|
(if (not (eq sexp (intern-soft (symbol-name sexp))))
|
|
(macrostep-propertize
|
|
(prin1 sexp (current-buffer))
|
|
'font-lock-face (macrostep-get-gensym-face sexp))
|
|
;; Print other symbols as normal
|
|
(prin1 sexp (current-buffer))))
|
|
|
|
((listp sexp)
|
|
;; Print quoted and quasiquoted forms nicely.
|
|
(let ((head (car sexp)))
|
|
(cond ((and (eq head 'quote) ; quote
|
|
(= (length sexp) 2))
|
|
(insert "'")
|
|
(macrostep-print-sexp (cadr sexp)))
|
|
|
|
((and (eq head '\`) ; backquote
|
|
(= (length sexp) 2))
|
|
(if (assq sexp macrostep-collected-macro-form-alist)
|
|
(macrostep-propertize
|
|
(insert "`")
|
|
'macrostep-expanded-text sexp
|
|
'macrostep-macro-start t
|
|
'font-lock-face 'macrostep-macro-face)
|
|
(insert "`"))
|
|
(macrostep-print-sexp (cadr sexp)))
|
|
|
|
((and (memq head '(\, \,@)) ; unquote
|
|
(= (length sexp) 2))
|
|
(princ head (current-buffer))
|
|
(macrostep-print-sexp (cadr sexp)))
|
|
|
|
(t ; other list form
|
|
(cl-destructuring-bind (macro? . environment)
|
|
(or (assq sexp macrostep-collected-macro-form-alist)
|
|
'(nil . nil))
|
|
(let
|
|
((compiler-macro?
|
|
(memq sexp macrostep-collected-compiler-macro-forms)))
|
|
(if (or macro? compiler-macro?)
|
|
(progn
|
|
;; Save the real expansion as a text property on the
|
|
;; opening paren
|
|
(macrostep-propertize
|
|
(insert "(")
|
|
'macrostep-macro-start t
|
|
'macrostep-expanded-text sexp
|
|
'macrostep-environment environment)
|
|
;; Fontify the head of the macro
|
|
(macrostep-propertize
|
|
(macrostep-print-sexp head)
|
|
'font-lock-face
|
|
(if macro?
|
|
'macrostep-macro-face
|
|
'macrostep-compiler-macro-face)))
|
|
;; Not a macro form
|
|
(insert "(")
|
|
(macrostep-print-sexp head))))
|
|
|
|
;; Print remaining list elements
|
|
(setq sexp (cdr sexp))
|
|
(when sexp (insert " "))
|
|
(while sexp
|
|
(if (listp sexp)
|
|
(progn
|
|
(macrostep-print-sexp (car sexp))
|
|
(when (cdr sexp) (insert " "))
|
|
(setq sexp (cdr sexp)))
|
|
;; Print tail of dotted list
|
|
(insert ". ")
|
|
(macrostep-print-sexp sexp)
|
|
(setq sexp nil)))
|
|
(insert ")")))))
|
|
|
|
;; Print everything except symbols and lists as normal
|
|
(t (prin1 sexp (current-buffer)))))
|
|
|
|
(defun macrostep-get-gensym-face (symbol)
|
|
"Return the face to use in fontifying SYMBOL in printed macro expansions.
|
|
|
|
All symbols introduced in the same level of macro expansion are
|
|
fontified using the same face (modulo the number of faces; see
|
|
`macrostep-gensym-faces')."
|
|
(or (get symbol 'macrostep-gensym-face)
|
|
(progn
|
|
(if (not macrostep-gensyms-this-level)
|
|
(setq macrostep-gensym-depth (1+ macrostep-gensym-depth)
|
|
macrostep-gensyms-this-level t))
|
|
(let ((face (ring-ref macrostep-gensym-faces macrostep-gensym-depth)))
|
|
(put symbol 'macrostep-gensym-face face)
|
|
face))))
|
|
|
|
|
|
(provide 'macrostep)
|
|
|
|
;;; macrostep.el ends here
|