macrostep.el (46334B)
1 ;;; macrostep.el --- Interactive macro expander -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2012-2015 Jon Oddie 4 ;; Copyright (C) 2020-2023 Free Software Foundation, Inc. 5 6 ;; Author: Jon Oddie <j.j.oddie@gmail.com> 7 ;; Url: https://github.com/emacsorphanage/macrostep 8 ;; Keywords: lisp, languages, macro, debugging 9 10 ;; Package-Version: 0.9.2 11 ;; Package-Requires: ((cl-lib "0.5")) 12 13 ;; SPDX-License-Identifier: GPL-3.0-or-later 14 15 ;; This file is free software: you can redistribute it and/or modify 16 ;; it under the terms of the GNU General Public License as published 17 ;; by the Free Software Foundation, either version 3 of the License, 18 ;; or (at your option) any later version. 19 ;; 20 ;; This file is distributed in the hope that it will be useful, 21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 ;; GNU General Public License for more details. 24 ;; 25 ;; You should have received a copy of the GNU General Public License 26 ;; along with this file. If not, see <https://www.gnu.org/licenses/>. 27 28 ;;; Commentary: 29 30 ;; `macrostep' is an Emacs minor mode for interactively stepping through 31 ;; the expansion of macros in Emacs Lisp source code. It lets you see 32 ;; exactly what happens at each step of the expansion process by 33 ;; pretty-printing the expanded forms inline in the source buffer, which is 34 ;; temporarily read-only while macro expansions are visible. You can 35 ;; expand and collapse macro forms one step at a time, and evaluate or 36 ;; instrument the expansions for debugging with Edebug as normal (but see 37 ;; "Bugs and known limitations", below). Single-stepping through the 38 ;; expansion is particularly useful for debugging macros that expand into 39 ;; another macro form. These can be difficult to debug with Emacs' 40 ;; built-in `macroexpand', which continues expansion until the top-level 41 ;; form is no longer a macro call. 42 43 ;; Both globally-visible macros as defined by `defmacro' and local macros 44 ;; bound by `(cl-)macrolet' or another macro-defining form can be expanded. 45 ;; Within macro expansions, calls to macros and compiler macros are 46 ;; fontified specially: macro forms using `macrostep-macro-face', and 47 ;; functions with compiler macros using `macrostep-compiler-macro-face'. 48 ;; Uninterned symbols (gensyms) are fontified based on which step in the 49 ;; expansion created them, to distinguish them both from normal symbols and 50 ;; from other gensyms with the same print name. 51 52 ;; As of version 0.9, it is also possible to extend `macrostep' to work 53 ;; with other languages with macro systems in addition to Emacs Lisp. An 54 ;; extension for Common Lisp (via SLIME) is in the works; contributions for 55 ;; other languages are welcome. See "Extending macrostep" below for 56 ;; details. 57 58 59 ;; 1 Key-bindings and usage 60 ;; ======================== 61 62 ;; The standard keybindings in `macrostep-mode' are the following: 63 64 ;; e, =, RET : expand the macro form following point one step 65 ;; c, u, DEL : collapse the form following point 66 ;; q, C-c C-c: collapse all expanded forms and exit macrostep-mode 67 ;; n, TAB : jump to the next macro form in the expansion 68 ;; p, M-TAB : jump to the previous macro form in the expansion 69 70 ;; It's not very useful to enable and disable macrostep-mode directly. 71 ;; Instead, bind `macrostep-expand' to a key in `emacs-lisp-mode-map', 72 ;; for example C-c e: 73 74 ;; ,---- 75 ;; | (define-key emacs-lisp-mode-map (kbd "C-c e") 'macrostep-expand) 76 ;; `---- 77 78 ;; You can then enter macrostep-mode and expand a macro form completely 79 ;; by typing `C-c e e e ...' as many times as necessary. 80 81 ;; Exit macrostep-mode by typing `q' or `C-c C-c', or by successively 82 ;; typing `c' to collapse all surrounding expansions. 83 84 85 ;; 2 Customization options 86 ;; ======================= 87 88 ;; Type `M-x customize-group RET macrostep RET' to customize options and 89 ;; faces. 90 91 ;; To display macro expansions in a separate window, instead of inline in 92 ;; the source buffer, customize `macrostep-expand-in-separate-buffer' to 93 ;; `t'. The default is `nil'. Whichever default behavior is selected, 94 ;; the alternative behavior can be obtained temporarily by giving a 95 ;; prefix argument to `macrostep-expand'. 96 97 ;; To have `macrostep' ignore compiler macros, customize 98 ;; `macrostep-expand-compiler-macros' to `nil'. The default is `t'. 99 100 ;; Customize the faces `macrostep-macro-face', 101 ;; `macrostep-compiler-macro-face', and `macrostep-gensym-1' through 102 ;; `macrostep-gensym-5' to alter the appearance of macro expansions. 103 104 105 ;; 3 Locally-bound macros 106 ;; ====================== 107 108 ;; As of version 0.9, `macrostep' can expand calls to a locally-bound 109 ;; macro, whether defined by a surrounding `(cl-)macrolet' form, or by 110 ;; another macro-defining macro. In other words, it is possible to 111 ;; expand the inner `local-macro' forms in both the following examples, 112 ;; whether `local-macro' is defined by an enclosing `cl-macrolet' -- 113 114 ;; ,---- 115 ;; | (cl-macrolet ((local-macro (&rest args) 116 ;; | `(expansion of ,args))) 117 ;; | (local-macro (do-something))) 118 ;; `---- 119 120 ;; -- or by a macro which expands into `cl-macrolet', provided that its 121 ;; definition of macro is evaluated prior to calling `macrostep-expand': 122 123 ;; ,---- 124 ;; | (defmacro with-local-macro (&rest body) 125 ;; | `(cl-macrolet ((local-macro (&rest args) 126 ;; | `(expansion of ,args))) 127 ;; | ,@body)) 128 ;; | 129 ;; | (with-local-macro 130 ;; | (local-macro (do something (else))) 131 ;; `---- 132 133 ;; See the `with-js' macro in Emacs's `js.el' for a real example of the 134 ;; latter kind of macro. 135 136 ;; Expansion of locally-bound macros is implemented by instrumenting 137 ;; Emacs Lisp's macro-expander to capture the environment at point. A 138 ;; similar trick is used to detect macro- and compiler-macro calls within 139 ;; expanded text so that they can be fontified accurately. 140 141 142 ;; 4 Expanding sub-forms 143 ;; ===================== 144 145 ;; By moving point around in the macro expansion using 146 ;; `macrostep-next-macro' and `macrostep-prev-macro' (bound to the `n' 147 ;; and `p' keys), it is possible to expand other macro calls within the 148 ;; expansion before expanding the outermost form. This can sometimes be 149 ;; useful, although it does not correspond to the real order of macro 150 ;; expansion in Emacs Lisp, which proceeds by fully expanding the outer 151 ;; form to a non-macro form before expanding sub-forms. 152 153 ;; The main reason to expand sub-forms out of order is to help with 154 ;; debugging macros which programmatically expand their arguments in 155 ;; order to rewrite them. Expanding the arguments of such a macro lets 156 ;; you visualise what the macro definition would compute via 157 ;; `macroexpand-all'. 158 159 160 ;; 5 Extending macrostep for other languages 161 ;; ========================================= 162 163 ;; Since version 0.9, it is possible to extend macrostep to work with 164 ;; other languages besides Emacs Lisp. In typical Emacs fashion, this is 165 ;; implemented by setting buffer-local variables to different function 166 ;; values. Six buffer-local variables define the language-specific part 167 ;; of the implementation: 168 169 ;; - `macrostep-sexp-bounds-function' 170 ;; - `macrostep-sexp-at-point-function' 171 ;; - `macrostep-environment-at-point-function' 172 ;; - `macrostep-expand-1-function' 173 ;; - `macrostep-print-function' 174 ;; - `macrostep-macro-form-p-function' 175 176 ;; Typically, an implementation for another language would set these 177 ;; variables in a major-mode hook. See the docstrings of each variable 178 ;; for details on how each one is called and what it should return. At a 179 ;; minimum, another language implementation needs to provide 180 ;; `macrostep-sexp-at-point-function', `macrostep-expand-1-function', and 181 ;; `macrostep-print-function'. Lisp-like languages may be able to reuse 182 ;; the default `macrostep-sexp-bounds-function' if they provide another 183 ;; implementation of `macrostep-macro-form-p-function'. Languages which 184 ;; do not implement locally-defined macros can set 185 ;; `macrostep-environment-at-point-function' to `ignore'. 186 187 ;; Note that the core `macrostep' machinery only interprets the return 188 ;; value of `macrostep-sexp-bounds-function', so implementations for 189 ;; other languages can use any internal representations of code and 190 ;; environments which is convenient. Although the terminology is 191 ;; Lisp-specific, there is no reason that implementations could not be 192 ;; provided for non-Lisp languages with macro systems, provided there is 193 ;; some way of identifying macro calls and calling the compiler / 194 ;; preprocessor to obtain their expansions. 195 196 197 ;; 6 Bugs and known limitations 198 ;; ============================ 199 200 ;; You can evaluate and edebug macro-expanded forms and step through the 201 ;; macro-expanded version, but the form that `eval-defun' and friends 202 ;; read from the buffer won't have the uninterned symbols of the real 203 ;; macro expansion. This will probably work OK with CL-style gensyms, 204 ;; but may cause problems with `make-symbol' symbols if they have the 205 ;; same print name as another symbol in the expansion. It's possible that 206 ;; using `print-circle' and `print-gensym' could get around this. 207 208 ;; Please send other bug reports and feature requests to the author. 209 210 211 ;; 7 Acknowledgements 212 ;; ================== 213 214 ;; Thanks to: 215 ;; - John Wiegley for fixing a bug with the face definitions under Emacs 216 ;; 24 & for plugging macrostep in his [EmacsConf presentation]! 217 ;; - George Kettleborough for bug reports, and patches to highlight the 218 ;; expanded region and properly handle backquotes. 219 ;; - Nic Ferrier for suggesting support for local definitions within 220 ;; macrolet forms 221 ;; - Luís Oliveira for suggesting and implementing SLIME support 222 223 ;; `macrostep' was originally inspired by J. V. Toups's 'Deep Emacs Lisp' 224 ;; articles ([part 1], [part 2], [screencast]). 225 226 ;; [EmacsConf presentation] http://youtu.be/RvPFZL6NJNQ 227 228 ;; [part 1] 229 ;; http://dorophone.blogspot.co.uk/2011/04/deep-emacs-part-1.html 230 231 ;; [part 2] 232 ;; http://dorophone.blogspot.co.uk/2011/04/deep-emacs-lisp-part-2.html 233 234 ;; [screencast] 235 ;; http://dorophone.blogspot.co.uk/2011/05/monadic-parser-combinators-in-elisp.html 236 237 238 ;; 8 Changelog 239 ;; =========== 240 241 ;; - v0.9.2, 2023-05-12: 242 ;; - name the keymap macrostep-mode-map, fixing a regression in v0.9.1 243 ;; - v0.9.1, 2023-03-12: 244 ;; - bug fixes, cleanup and modernization 245 ;; - v0.9, 2015-10-01: 246 ;; - separate into Elisp-specific and generic components 247 ;; - highlight and expand compiler macros 248 ;; - improve local macro expansion and macro form identification by 249 ;; instrumenting `macroexpand(-all)' 250 ;; - v0.8, 2014-05-29: fix a bug with printing the first element of lists 251 ;; - v0.7, 2014-05-11: expand locally-defined macros within 252 ;; `(cl-)macrolet' forms 253 ;; - v0.6, 2013-05-04: better handling of quote and backquote 254 ;; - v0.5, 2013-04-16: highlight region, maintain cleaner buffer state 255 ;; - v0.4, 2013-04-07: only enter macrostep-mode on successful 256 ;; macro-expansion 257 ;; - v0.3, 2012-10-30: print dotted lists correctly. autoload 258 ;; definitions. 259 260 ;;; Code: 261 262 (require 'pp) 263 (require 'ring) 264 (require 'cl-lib) 265 266 267 ;;; Constants and dynamically bound variables 268 (defvar macrostep-overlays nil 269 "List of all macro stepper overlays in the current buffer.") 270 (make-variable-buffer-local 'macrostep-overlays) 271 272 (defvar macrostep-gensym-depth nil 273 "Number of macro expansion levels that have introduced gensyms so far.") 274 (make-variable-buffer-local 'macrostep-gensym-depth) 275 276 (defvar macrostep-gensyms-this-level nil 277 "t if gensyms have been encountered during current level of macro expansion.") 278 (make-variable-buffer-local 'macrostep-gensyms-this-level) 279 280 (defvar macrostep-saved-undo-list nil 281 "Saved value of `buffer-undo-list' upon entering macrostep mode.") 282 (make-variable-buffer-local 'macrostep-saved-undo-list) 283 284 (defvar macrostep-saved-read-only nil 285 "Saved value of `buffer-read-only' upon entering macrostep mode.") 286 (make-variable-buffer-local 'macrostep-saved-read-only) 287 288 (defvar macrostep-expansion-buffer nil 289 "Non-nil if the current buffer is a macro-expansion buffer.") 290 (make-variable-buffer-local 'macrostep-expansion-buffer) 291 292 (defvar macrostep-outer-environment nil 293 "Outermost macro-expansion environment to use in macro-expansion buffers. 294 295 This variable is used to save information about any enclosing 296 `cl-macrolet' context when a macro form is expanded in a separate 297 buffer.") 298 (make-variable-buffer-local 'macrostep-outer-environment) 299 300 ;;; Customization options and faces 301 (defgroup macrostep nil 302 "Interactive macro stepper for Emacs Lisp." 303 :group 'lisp 304 :link '(emacs-commentary-link :tag "commentary" "macrostep.el") 305 :link '(emacs-library-link :tag "lisp file" "macrostep.el") 306 :link '(url-link :tag "web page" "https://github.com/joddie/macrostep")) 307 308 (defface macrostep-gensym-1 309 '((((min-colors 16581375)) :foreground "#8080c0" :box t :bold t) 310 (((min-colors 8)) :background "cyan") 311 (t :inverse-video t)) 312 "Face for gensyms created in the first level of macro expansion.") 313 314 (defface macrostep-gensym-2 315 '((((min-colors 16581375)) :foreground "#8fbc8f" :box t :bold t) 316 (((min-colors 8)) :background "#00cd00") 317 (t :inverse-video t)) 318 "Face for gensyms created in the second level of macro expansion.") 319 320 (defface macrostep-gensym-3 321 '((((min-colors 16581375)) :foreground "#daa520" :box t :bold t) 322 (((min-colors 8)) :background "yellow") 323 (t :inverse-video t)) 324 "Face for gensyms created in the third level of macro expansion.") 325 326 (defface macrostep-gensym-4 327 '((((min-colors 16581375)) :foreground "#cd5c5c" :box t :bold t) 328 (((min-colors 8)) :background "red") 329 (t :inverse-video t)) 330 "Face for gensyms created in the fourth level of macro expansion.") 331 332 (defface macrostep-gensym-5 333 '((((min-colors 16581375)) :foreground "#da70d6" :box t :bold t) 334 (((min-colors 8)) :background "magenta") 335 (t :inverse-video t)) 336 "Face for gensyms created in the fifth level of macro expansion.") 337 338 (defface macrostep-expansion-highlight-face 339 `((((min-colors 16581375) (background light)) 340 ,@(and (>= emacs-major-version 27) '(:extend t)) 341 :background "#eee8d5") 342 (((min-colors 16581375) (background dark)) 343 ,@(and (>= emacs-major-version 27) '(:extend t)) 344 :background "#222222")) 345 "Face for macro-expansion highlight.") 346 347 (defface macrostep-macro-face 348 '((t :underline t)) 349 "Face for macros in macro-expanded code.") 350 351 (defface macrostep-compiler-macro-face 352 '((t :slant italic)) 353 "Face for compiler macros in macro-expanded code.") 354 355 (defcustom macrostep-expand-in-separate-buffer nil 356 "When non-nil, show expansions in a separate buffer instead of inline." 357 :type 'boolean) 358 359 (defcustom macrostep-expand-compiler-macros t 360 "When non-nil, also expand compiler macros." 361 :type 'boolean) 362 363 ;; Need the following for making the ring of faces 364 (defun macrostep-make-ring (&rest items) 365 "Make a ring containing all of ITEMS with no empty slots." 366 (let ((ring (make-ring (length items)))) 367 (mapc (lambda (item) (ring-insert ring item)) (reverse items)) 368 ring)) 369 370 (defvar macrostep-gensym-faces 371 (macrostep-make-ring 372 'macrostep-gensym-1 'macrostep-gensym-2 'macrostep-gensym-3 373 'macrostep-gensym-4 'macrostep-gensym-5) 374 "Ring of all macrostepper faces for fontifying gensyms.") 375 376 ;; Other modes can enable macrostep by redefining these functions to 377 ;; language-specific versions. 378 (defvar macrostep-sexp-bounds-function 379 #'macrostep-sexp-bounds 380 "Function to return the bounds of the macro form nearest point. 381 382 It will be called with no arguments and should return a cons of 383 buffer positions, (START . END). It should use `save-excursion' 384 to avoid changing the position of point. 385 386 The default value, `macrostep-sexp-bounds', implements this for 387 Emacs Lisp, and may be suitable for other Lisp-like languages.") 388 (make-variable-buffer-local 'macrostep-sexp-bounds-function) 389 390 (defvar macrostep-sexp-at-point-function 391 #'macrostep-sexp-at-point 392 "Function to return the macro form at point for expansion. 393 394 It will be called with two arguments, the values of START and END 395 returned by `macrostep-sexp-bounds-function', and with point 396 positioned at START. It should return a value suitable for 397 passing as the first argument to `macrostep-expand-1-function'. 398 399 The default value, `macrostep-sexp-at-point', implements this for 400 Emacs Lisp, and may be suitable for other Lisp-like languages.") 401 (make-variable-buffer-local 'macrostep-sexp-at-point-function) 402 403 (defvar macrostep-environment-at-point-function 404 #'macrostep-environment-at-point 405 "Function to return the local macro-expansion environment at point. 406 407 It will be called with no arguments, and should return a value 408 suitable for passing as the second argument to 409 `macrostep-expand-1-function'. 410 411 The default value, `macrostep-environment-at-point', is specific 412 to Emacs Lisp. For languages which do not implement local 413 macro-expansion environments, this should be set to `ignore' 414 or `(lambda () nil)'.") 415 (make-variable-buffer-local 'macrostep-environment-at-point-function) 416 417 (defvar macrostep-expand-1-function 418 #'macrostep-expand-1 419 "Function to perform one step of macro-expansion. 420 421 It will be called with two arguments, FORM and ENVIRONMENT, the 422 return values of `macrostep-sexp-at-point-function' and 423 `macrostep-environment-at-point-function' respectively. It 424 should return the result of expanding FORM by one step as a value 425 which is suitable for passing as the argument to 426 `macrostep-print-function'. 427 428 The default value, `macrostep-expand-1', is specific to Emacs Lisp.") 429 (make-variable-buffer-local 'macrostep-expand-1-function) 430 431 (defvar macrostep-print-function 432 #'macrostep-pp 433 "Function to pretty-print macro expansions. 434 435 It will be called with two arguments, FORM and ENVIRONMENT, the 436 return values of `macrostep-sexp-at-point-function' and 437 `macrostep-environment-at-point-function' respectively. It 438 should insert a pretty-printed representation at point in the 439 current buffer, leaving point just after the inserted 440 representation, without altering any other text in the current 441 buffer. 442 443 The default value, `macrostep-pp', is specific to Emacs Lisp.") 444 (make-variable-buffer-local 'macrostep-print-function) 445 446 (defvar macrostep-macro-form-p-function 447 #'macrostep-macro-form-p 448 "Function to check whether a form is a macro call. 449 450 It will be called with two arguments, FORM and ENVIRONMENT -- the 451 return values of `macrostep-sexp-at-point-function' and 452 `macrostep-environment-at-point-function' respectively -- and 453 should return non-nil if FORM would undergo macro-expansion in 454 ENVIRONMENT. 455 456 This is called only from `macrostep-sexp-bounds', so it need not 457 be provided if a different value is used for 458 `macrostep-sexp-bounds-function'. 459 460 The default value, `macrostep-macro-form-p', is specific to Emacs Lisp.") 461 (make-variable-buffer-local 'macrostep-macro-form-p-function) 462 463 464 ;;; Define keymap and minor mode 465 (define-obsolete-variable-alias 'macrostep-mode-keymap 'macrostep-mode-map "2023") 466 (define-obsolete-variable-alias 'macrostep-keymap 'macrostep-mode-map "2022") 467 (defvar macrostep-mode-map 468 (let ((map (make-sparse-keymap))) 469 (define-key map (kbd "RET") #'macrostep-expand) 470 (define-key map "=" #'macrostep-expand) 471 (define-key map "e" #'macrostep-expand) 472 473 (define-key map (kbd "DEL") #'macrostep-collapse) 474 (define-key map "u" #'macrostep-collapse) 475 (define-key map "c" #'macrostep-collapse) 476 477 (define-key map (kbd "TAB") #'macrostep-next-macro) 478 (define-key map "n" #'macrostep-next-macro) 479 (define-key map (kbd "M-TAB") #'macrostep-prev-macro) 480 (define-key map "p" #'macrostep-prev-macro) 481 482 (define-key map "q" #'macrostep-collapse-all) 483 (define-key map (kbd "C-c C-c") #'macrostep-collapse-all) 484 map) 485 "Keymap for `macrostep-mode'.") 486 487 ;;;###autoload 488 (define-minor-mode macrostep-mode 489 "Minor mode for inline expansion of macros in Emacs Lisp source buffers. 490 491 \\<macrostep-mode-map>Progressively expand macro forms with \ 492 \\[macrostep-expand], collapse them with \\[macrostep-collapse], 493 and move back and forth with \\[macrostep-next-macro] and \ 494 \\[macrostep-prev-macro]. Use \\[macrostep-collapse-all] or collapse all 495 visible expansions to quit and return to normal editing. 496 497 \\{macrostep-mode-map}" 498 :lighter " Macro-Stepper" 499 :group 'macrostep 500 (if macrostep-mode 501 (progn 502 ;; Disable recording of undo information 503 (setq macrostep-saved-undo-list buffer-undo-list 504 buffer-undo-list t) 505 ;; Remember whether buffer was read-only 506 (setq macrostep-saved-read-only buffer-read-only 507 buffer-read-only t) 508 ;; Set up post-command hook to bail out on leaving read-only 509 (add-hook 'post-command-hook #'macrostep-command-hook nil t) 510 (message (substitute-command-keys "\ 511 \\<macrostep-mode-map>Entering macro stepper mode. \ 512 Use \\[macrostep-expand] to expand, \\[macrostep-collapse] to collapse, \ 513 \\[macrostep-collapse-all] to exit."))) 514 515 ;; Exiting mode 516 (if macrostep-expansion-buffer 517 ;; Kill dedicated expansion buffers 518 (quit-window t) 519 ;; Collapse any remaining overlays 520 (when macrostep-overlays (macrostep-collapse-all)) 521 ;; Restore undo info & read-only state 522 (setq buffer-undo-list macrostep-saved-undo-list 523 buffer-read-only macrostep-saved-read-only 524 macrostep-saved-undo-list nil) 525 ;; Remove our post-command hook 526 (remove-hook 'post-command-hook #'macrostep-command-hook t)))) 527 528 ;; Post-command hook: bail out of macrostep-mode if the user types C-x 529 ;; C-q to make the buffer writable again. 530 (defun macrostep-command-hook () 531 (if (not buffer-read-only) 532 (macrostep-mode 0))) 533 534 535 ;;; Interactive functions 536 ;;;###autoload 537 (defun macrostep-expand (&optional toggle-separate-buffer) 538 "Expand the macro form following point by one step. 539 540 Enters `macrostep-mode' if it is not already active, making the 541 buffer temporarily read-only. If `macrostep-mode' is active and the 542 form following point is not a macro form, search forward in the 543 buffer and expand the next macro form found, if any. 544 545 With a prefix argument, the expansion is displayed in a separate 546 buffer instead of inline in the current buffer. Setting 547 `macrostep-expand-in-separate-buffer' to non-nil swaps these two 548 behaviors." 549 (interactive "P") 550 (cl-destructuring-bind (start . end) 551 (funcall macrostep-sexp-bounds-function) 552 (goto-char start) 553 (let* ((sexp (funcall macrostep-sexp-at-point-function start end)) 554 (end (copy-marker end)) 555 (text (buffer-substring start end)) 556 (env (funcall macrostep-environment-at-point-function)) 557 (expansion (funcall macrostep-expand-1-function sexp env))) 558 559 ;; Create a dedicated macro-expansion buffer and copy the text to 560 ;; be expanded into it, if required 561 (let ((separate-buffer-p 562 (if toggle-separate-buffer 563 (not macrostep-expand-in-separate-buffer) 564 macrostep-expand-in-separate-buffer))) 565 (when (and separate-buffer-p (not macrostep-expansion-buffer)) 566 (let ((mode major-mode) 567 (buffer 568 (get-buffer-create (generate-new-buffer-name "*macro expansion*")))) 569 (set-buffer buffer) 570 (funcall mode) 571 (setq macrostep-expansion-buffer t) 572 (setq macrostep-outer-environment env) 573 (save-excursion 574 (setq start (point)) 575 (insert text) 576 (setq end (point-marker))) 577 (pop-to-buffer buffer)))) 578 579 (unless macrostep-mode (macrostep-mode t)) 580 (let ((existing-overlay (macrostep-overlay-at-point)) 581 (macrostep-gensym-depth macrostep-gensym-depth) 582 (macrostep-gensyms-this-level nil) 583 priority) 584 (if existing-overlay 585 (progn ; Expanding part of a previous macro-expansion 586 (setq priority (1+ (overlay-get existing-overlay 'priority))) 587 (setq macrostep-gensym-depth 588 (overlay-get existing-overlay 'macrostep-gensym-depth))) 589 ;; Expanding source buffer text 590 (setq priority 1) 591 (setq macrostep-gensym-depth -1)) 592 593 (with-silent-modifications 594 (atomic-change-group 595 (let ((inhibit-read-only t)) 596 (save-excursion 597 ;; Insert expansion 598 (funcall macrostep-print-function expansion env) 599 ;; Delete the original form 600 (macrostep-collapse-overlays-in (point) end) 601 (delete-region (point) end) 602 ;; Create a new overlay 603 (let* ((overlay 604 (make-overlay start 605 (if (looking-at "\n") 606 (1+ (point)) 607 (point)))) 608 (highlight-overlay (unless macrostep-expansion-buffer 609 (copy-overlay overlay)))) 610 (unless macrostep-expansion-buffer 611 ;; Highlight the overlay in original source buffers only 612 (overlay-put highlight-overlay 'face 'macrostep-expansion-highlight-face) 613 (overlay-put highlight-overlay 'priority -1) 614 (overlay-put overlay 'macrostep-highlight-overlay highlight-overlay)) 615 (overlay-put overlay 'priority priority) 616 (overlay-put overlay 'macrostep-original-text text) 617 (overlay-put overlay 'macrostep-gensym-depth macrostep-gensym-depth) 618 (push overlay macrostep-overlays)))))))))) 619 620 (defun macrostep-collapse () 621 "Collapse the innermost macro expansion near point to its source text. 622 623 If no more macro expansions are visible after this, exit 624 `macrostep-mode'." 625 (interactive) 626 (let ((overlay (macrostep-overlay-at-point))) 627 (when (not overlay) (error "No macro expansion at point")) 628 (let ((inhibit-read-only t)) 629 (with-silent-modifications 630 (atomic-change-group 631 (macrostep-collapse-overlay overlay))))) 632 (if (not macrostep-overlays) 633 (macrostep-mode 0))) 634 635 (defun macrostep-collapse-all () 636 "Collapse all visible macro expansions and exit `macrostep-mode'." 637 (interactive) 638 (let ((inhibit-read-only t)) 639 (with-silent-modifications 640 (dolist (overlay macrostep-overlays) 641 (let ((outermost (= (overlay-get overlay 'priority) 1))) 642 ;; We only need restore the original text for the outermost 643 ;; overlays 644 (macrostep-collapse-overlay overlay (not outermost)))))) 645 (setq macrostep-overlays nil) 646 (macrostep-mode 0)) 647 648 (defun macrostep-next-macro () 649 "Move point forward to the next macro form in macro-expanded text." 650 (interactive) 651 (let* ((start (if (get-text-property (point) 'macrostep-macro-start) 652 (1+ (point)) 653 (point))) 654 (next (next-single-property-change start 'macrostep-macro-start))) 655 (if next 656 (goto-char next) 657 (error "No more macro forms found")))) 658 659 (defun macrostep-prev-macro () 660 "Move point back to the previous macro form in macro-expanded text." 661 (interactive) 662 (let (prev) 663 (save-excursion 664 (while 665 (progn 666 (setq prev (previous-single-property-change 667 (point) 'macrostep-macro-start)) 668 (if (or (not prev) 669 (get-text-property (1- prev) 'macrostep-macro-start)) 670 nil 671 (prog1 t (goto-char prev)))))) 672 (if prev 673 (goto-char (1- prev)) 674 (error "No previous macro form found")))) 675 676 677 ;;; Utility functions (not language-specific) 678 679 (defun macrostep-overlay-at-point () 680 "Return the innermost macro stepper overlay at point." 681 (cdr (get-char-property-and-overlay (point) 'macrostep-original-text))) 682 683 (defun macrostep-collapse-overlay (overlay &optional no-restore-p) 684 "Collapse a macro-expansion overlay and restore the unexpanded source text. 685 686 As a minor optimization, does not restore the original source 687 text if NO-RESTORE-P is non-nil. This is safe to do when 688 collapsing all the sub-expansions of an outer overlay, since the 689 outer overlay will restore the original source itself. 690 691 Also removes the overlay from `macrostep-overlays'." 692 (with-current-buffer (overlay-buffer overlay) 693 ;; If we're cleaning up we don't need to bother restoring text 694 ;; or checking for inner overlays to delete 695 (unless no-restore-p 696 (let* ((start (overlay-start overlay)) 697 (end (overlay-end overlay)) 698 (text (overlay-get overlay 'macrostep-original-text)) 699 (sexp-end 700 (copy-marker 701 (if (equal (char-before end) ?\n) (1- end) end)))) 702 (macrostep-collapse-overlays-in start end) 703 (goto-char (overlay-start overlay)) 704 (save-excursion 705 (insert text) 706 (delete-region (point) sexp-end)))) 707 ;; Remove overlay from the list and delete it 708 (setq macrostep-overlays 709 (delq overlay macrostep-overlays)) 710 (let ((highlight-overlay (overlay-get overlay 'macrostep-highlight-overlay))) 711 (when highlight-overlay (delete-overlay highlight-overlay))) 712 (delete-overlay overlay))) 713 714 (defun macrostep-collapse-overlays-in (start end) 715 "Collapse all macrostepper overlays that are strictly between START and END. 716 717 Will not collapse overlays that begin at START and end at END." 718 (dolist (ol (overlays-in start end)) 719 (when (and (overlay-buffer ol) ; collapsing may delete other overlays 720 (> (overlay-start ol) start) 721 (< (overlay-end ol) end) 722 (overlay-get ol 'macrostep-original-text)) 723 (macrostep-collapse-overlay ol t)))) 724 725 726 ;;; Emacs Lisp implementation 727 728 (defun macrostep-sexp-bounds () 729 "Find the bounds of the macro form nearest point. 730 731 If point is not before an open-paren, moves up to the nearest 732 enclosing list. If the form at point is not a macro call, 733 attempts to move forward to the next macro form as determined by 734 `macrostep-macro-form-p-function'. 735 736 Returns a cons of buffer positions, (START . END)." 737 (save-excursion 738 (if (not (looking-at "[(`]")) 739 (backward-up-list 1)) 740 (if (equal (char-before) ?`) 741 (backward-char)) 742 (let ((sexp (funcall macrostep-sexp-at-point-function)) 743 (env (funcall macrostep-environment-at-point-function))) 744 ;; If this isn't a macro form, try to find the next one in the buffer 745 (unless (funcall macrostep-macro-form-p-function sexp env) 746 (condition-case nil 747 (macrostep-next-macro) 748 (error 749 (if (consp sexp) 750 (error "(%s ...) is not a macro form" (car sexp)) 751 (error "Text at point is not a macro form")))))) 752 (cons (point) (scan-sexps (point) 1)))) 753 754 (defun macrostep-sexp-at-point (&rest _ignore) 755 "Return the sexp near point for purposes of macro-stepper expansion. 756 757 If the sexp near point is part of a macro expansion, returns the 758 saved text of the macro expansion, and does not read from the 759 buffer. This preserves uninterned symbols in the macro 760 expansion, so that they can be fontified consistently. (See 761 `macrostep-print-sexp'.)" 762 (or (get-text-property (point) 'macrostep-expanded-text) 763 (sexp-at-point))) 764 765 (defun macrostep-macro-form-p (form environment) 766 "Return non-nil if FORM would be evaluated via macro expansion. 767 768 If FORM is an invocation of a macro defined by `defmacro' or an 769 enclosing `cl-macrolet' form, return the symbol `macro'. 770 771 If `macrostep-expand-compiler-macros' is non-nil and FORM is a 772 call to a function with a compiler macro, return the symbol 773 `compiler-macro'. 774 775 Otherwise, return nil." 776 (car (macrostep--macro-form-info form environment t))) 777 778 (defun macrostep--macro-form-info (form environment &optional inhibit-autoload) 779 "Return information about macro definitions that apply to FORM. 780 781 If no macros are involved in the evaluation of FORM within 782 ENVIRONMENT, returns nil. Otherwise, returns a cons (TYPE 783 . DEFINITION). 784 785 If FORM would be evaluated by a macro defined by `defmacro', 786 `cl-macrolet', etc., TYPE is the symbol `macro' and DEFINITION is 787 the macro definition, as a function. 788 789 If `macrostep-expand-compiler-macros' is non-nil and FORM would 790 be compiled using a compiler macro, TYPE is the symbol 791 `compiler-macro' and DEFINITION is the function that implements 792 the compiler macro. 793 794 If FORM is an invocation of an autoloaded macro, the behavior 795 depends on the value of INHIBIT-AUTOLOAD. If INHIBIT-AUTOLOAD is 796 nil, the file containing the macro definition will be loaded 797 using `load-library' and the macro definition returned as normal. 798 If INHIBIT-AUTOLOAD is non-nil, no files will be loaded, and the 799 value of DEFINITION in the result will be nil." 800 (if (not (and (consp form) 801 (symbolp (car form)))) 802 `(nil . nil) 803 (let* ((head (car form)) 804 (local-definition (assoc-default head environment #'eq))) 805 (if local-definition 806 `(macro . ,local-definition) 807 (let ((compiler-macro-definition 808 (and macrostep-expand-compiler-macros 809 (or (get head 'compiler-macro) 810 (get head 'cl-compiler-macro))))) 811 (if (and compiler-macro-definition 812 (not (eq form 813 (apply compiler-macro-definition form (cdr form))))) 814 `(compiler-macro . ,compiler-macro-definition) 815 (condition-case nil 816 (let ((fun (indirect-function head))) 817 (cl-case (car-safe fun) 818 ((macro) 819 `(macro . ,(cdr fun))) 820 ((autoload) 821 (when (memq (nth 4 fun) '(macro t)) 822 (if inhibit-autoload 823 `(macro . nil) 824 (load-library (nth 1 fun)) 825 (macrostep--macro-form-info form nil)))) 826 (t 827 `(nil . nil)))) 828 (void-function nil)))))))) 829 830 (defun macrostep-expand-1 (form environment) 831 "Return result of macro-expanding the top level of FORM by exactly one step. 832 Unlike `macroexpand', this function does not continue macro 833 expansion until a non-macro-call results." 834 (cl-destructuring-bind (type . definition) 835 (macrostep--macro-form-info form environment) 836 (cl-ecase type 837 ((nil) 838 form) 839 ((macro) 840 (apply definition (cdr form))) 841 ((compiler-macro) 842 (let ((expansion (apply definition form (cdr form)))) 843 (if (equal form expansion) 844 (error "Form left unchanged by compiler macro") 845 expansion)))))) 846 847 (put 'macrostep-grab-environment-failed 'error-conditions 848 '(macrostep-grab-environment-failed error)) 849 850 (defun macrostep-environment-at-point () 851 "Return the local macro-expansion environment at point, if any. 852 853 The local environment includes macros declared by any `macrolet' 854 or `cl-macrolet' forms surrounding point, as well as by any macro 855 forms which expand into a `macrolet'. 856 857 The return value is an alist of elements (NAME . FUNCTION), where 858 NAME is the symbol locally bound to the macro and FUNCTION is the 859 lambda expression that returns its expansion." 860 ;; If point is on a macro form within an expansion inserted by 861 ;; `macrostep-print-sexp', a local environment may have been 862 ;; previously saved as a text property. 863 (let ((saved-environment 864 (get-text-property (point) 'macrostep-environment))) 865 (if saved-environment 866 saved-environment 867 ;; Otherwise, we (ab)use the macro-expander to return the 868 ;; environment at point. If point is not at an evaluated 869 ;; position in the containing form, 870 ;; `macrostep-environment-at-point-1' will raise an error, and 871 ;; we back up progressively through the containing forms until 872 ;; it succeeds. 873 (save-excursion 874 (catch 'done 875 (while t 876 (condition-case nil 877 (throw 'done (macrostep-environment-at-point-1)) 878 (macrostep-grab-environment-failed 879 (condition-case nil 880 (backward-sexp) 881 (scan-error (backward-up-list))))))))))) 882 883 (defun macrostep-environment-at-point-1 () 884 "Attempt to extract the macro environment that would be active at point. 885 886 If point is not at an evaluated position within the containing 887 form, raise an error." 888 ;; Macro environments are extracted using Emacs Lisp's builtin 889 ;; macro-expansion machinery. The form containing point is copied 890 ;; to a temporary buffer, and a call to 891 ;; `--macrostep-grab-environment--' is inserted at point. This 892 ;; altered form is then fully macro-expanded, in an environment 893 ;; where `--macrostep-grab-environment--' is defined as a macro 894 ;; which throws the environment to a uniquely-generated tag. 895 (let* ((point-at-top-level 896 (save-excursion 897 (while (ignore-errors (backward-up-list) t)) 898 (point))) 899 (enclosing-form 900 (buffer-substring point-at-top-level 901 (scan-sexps point-at-top-level 1))) 902 (position (- (point) point-at-top-level)) 903 (tag (make-symbol "macrostep-grab-environment-tag")) 904 (grab-environment '--macrostep-grab-environment--)) 905 (if (= position 0) 906 nil 907 (with-temp-buffer 908 (emacs-lisp-mode) 909 (insert enclosing-form) 910 (goto-char (+ (point-min) position)) 911 (prin1 `(,grab-environment) (current-buffer)) 912 (let ((form (read (copy-marker (point-min))))) 913 (catch tag 914 (cl-letf (((symbol-function #'message) (symbol-function #'format))) 915 (with-no-warnings 916 (ignore-errors 917 (macroexpand-all 918 `(cl-macrolet ((,grab-environment (&environment env) 919 (throw ',tag env))) 920 ,form))))) 921 (signal 'macrostep-grab-environment-failed nil))))))) 922 923 (defun macrostep-collect-macro-forms (form &optional environment) 924 "Identify sub-forms of FORM which undergo macro-expansion. 925 926 FORM is an Emacs Lisp form. ENVIRONMENT is a local environment of 927 macro definitions. 928 929 The return value is a list of two elements, (MACRO-FORM-ALIST 930 COMPILER-MACRO-FORMS). 931 932 MACRO-FORM-ALIST is an alist of elements of the form (SUBFORM 933 . ENVIRONMENT), where SUBFORM is a form which undergoes 934 macro-expansion in the course of expanding FORM, and ENVIRONMENT 935 is the local macro environment in force when it is expanded. 936 937 COMPILER-MACRO-FORMS is a list of subforms which would be 938 compiled using a compiler macro. Since there is no standard way 939 to provide a local compiler-macro definition in Emacs Lisp, no 940 corresponding local environments are collected for these. 941 942 Forms and environments are extracted from FORM by instrumenting 943 Emacs's builtin `macroexpand' function and calling 944 `macroexpand-all'." 945 (let ((real-macroexpand (indirect-function #'macroexpand)) 946 (macro-form-alist '()) 947 (compiler-macro-forms '())) 948 (cl-letf 949 (((symbol-function #'macroexpand) 950 (lambda (form environment &rest args) 951 (let ((expansion 952 (apply real-macroexpand form environment args))) 953 (cond ((not (eq expansion form)) 954 (setq macro-form-alist 955 (cons (cons form environment) 956 macro-form-alist))) 957 ((and (consp form) 958 (symbolp (car form)) 959 macrostep-expand-compiler-macros 960 (not (eq form 961 (cl-compiler-macroexpand form)))) 962 (setq compiler-macro-forms 963 (cons form compiler-macro-forms)))) 964 expansion)))) 965 (ignore-errors 966 (macroexpand-all form environment))) 967 (list macro-form-alist compiler-macro-forms))) 968 969 (defvar macrostep-collected-macro-form-alist nil 970 "An alist of macro forms and environments. 971 Controls the printing of sub-forms in `macrostep-print-sexp'.") 972 973 (defvar macrostep-collected-compiler-macro-forms nil 974 "A list of compiler-macro forms to be highlighted in `macrostep-print-sexp'.") 975 976 (defun macrostep-pp (sexp environment) 977 "Pretty-print SEXP, fontifying macro forms and uninterned symbols." 978 (cl-destructuring-bind 979 (macrostep-collected-macro-form-alist 980 macrostep-collected-compiler-macro-forms) 981 (macrostep-collect-macro-forms sexp environment) 982 (let ((print-quoted t)) 983 (macrostep-print-sexp sexp) 984 ;; Point is now after the expanded form; pretty-print it 985 (save-restriction 986 (narrow-to-region (scan-sexps (point) -1) (point)) 987 (save-excursion 988 (pp-buffer) 989 ;; Remove the extra newline inserted by pp-buffer 990 (goto-char (point-max)) 991 (delete-region 992 (point) 993 (save-excursion (skip-chars-backward " \t\n") (point)))) 994 ;; Indent the newly-inserted form in context 995 (widen) 996 (save-excursion 997 (backward-sexp) 998 (indent-sexp)))))) 999 1000 ;; This must be defined before `macrostep-print-sexp': 1001 (defmacro macrostep-propertize (form &rest plist) 1002 "Evaluate FORM, applying syntax properties in PLIST to any inserted text." 1003 (declare (indent 1) 1004 (debug (&rest form))) 1005 (let ((start (make-symbol "start"))) 1006 `(let ((,start (point))) 1007 (prog1 1008 ,form 1009 ,@(cl-loop for (key value) on plist by #'cddr 1010 collect `(put-text-property ,start (point) 1011 ,key ,value)))))) 1012 1013 (defun macrostep-print-sexp (sexp) 1014 "Insert SEXP like `print', fontifying macro forms and uninterned symbols. 1015 1016 Fontifies uninterned symbols and macro forms using 1017 `font-lock-face' property, and saves the actual text of SEXP's 1018 sub-forms as the `macrostep-expanded-text' text property so that 1019 any uninterned symbols can be reused in macro expansions of the 1020 sub-forms. See also `macrostep-sexp-at-point'. 1021 1022 Macro and compiler-macro forms within SEXP are identified by 1023 comparison with the `macrostep-collected-macro-form-alist' and 1024 `macrostep-collected-compiler-macro-forms' variables, which 1025 should be dynamically let-bound around calls to this function." 1026 (cond 1027 ((symbolp sexp) 1028 ;; Fontify gensyms 1029 (if (not (eq sexp (intern-soft (symbol-name sexp)))) 1030 (macrostep-propertize 1031 (prin1 sexp (current-buffer)) 1032 'font-lock-face (macrostep-get-gensym-face sexp)) 1033 ;; Print other symbols as normal 1034 (prin1 sexp (current-buffer)))) 1035 1036 ((listp sexp) 1037 ;; Print quoted and quasiquoted forms nicely. 1038 (let ((head (car sexp))) 1039 (cond ((and (eq head 'quote) ; quote 1040 (= (length sexp) 2)) 1041 (insert "'") 1042 (macrostep-print-sexp (cadr sexp))) 1043 1044 ((and (eq head '\`) ; backquote 1045 (= (length sexp) 2)) 1046 (if (assq sexp macrostep-collected-macro-form-alist) 1047 (macrostep-propertize 1048 (insert "`") 1049 'macrostep-expanded-text sexp 1050 'macrostep-macro-start t 1051 'font-lock-face 'macrostep-macro-face) 1052 (insert "`")) 1053 (macrostep-print-sexp (cadr sexp))) 1054 1055 ((and (memq head '(\, \,@)) ; unquote 1056 (= (length sexp) 2)) 1057 (princ head (current-buffer)) 1058 (macrostep-print-sexp (cadr sexp))) 1059 1060 (t ; other list form 1061 (cl-destructuring-bind (macro? . environment) 1062 (or (assq sexp macrostep-collected-macro-form-alist) 1063 '(nil . nil)) 1064 (let 1065 ((compiler-macro? 1066 (memq sexp macrostep-collected-compiler-macro-forms))) 1067 (if (or macro? compiler-macro?) 1068 (progn 1069 ;; Save the real expansion as a text property on the 1070 ;; opening paren 1071 (macrostep-propertize 1072 (insert "(") 1073 'macrostep-macro-start t 1074 'macrostep-expanded-text sexp 1075 'macrostep-environment environment) 1076 ;; Fontify the head of the macro 1077 (macrostep-propertize 1078 (macrostep-print-sexp head) 1079 'font-lock-face 1080 (if macro? 1081 'macrostep-macro-face 1082 'macrostep-compiler-macro-face))) 1083 ;; Not a macro form 1084 (insert "(") 1085 (macrostep-print-sexp head)))) 1086 1087 ;; Print remaining list elements 1088 (setq sexp (cdr sexp)) 1089 (when sexp (insert " ")) 1090 (while sexp 1091 (if (listp sexp) 1092 (progn 1093 (macrostep-print-sexp (car sexp)) 1094 (when (cdr sexp) (insert " ")) 1095 (setq sexp (cdr sexp))) 1096 ;; Print tail of dotted list 1097 (insert ". ") 1098 (macrostep-print-sexp sexp) 1099 (setq sexp nil))) 1100 (insert ")"))))) 1101 1102 ;; Print everything except symbols and lists as normal 1103 (t (prin1 sexp (current-buffer))))) 1104 1105 (defun macrostep-get-gensym-face (symbol) 1106 "Return the face to use in fontifying SYMBOL in printed macro expansions. 1107 1108 All symbols introduced in the same level of macro expansion are 1109 fontified using the same face (modulo the number of faces; see 1110 `macrostep-gensym-faces')." 1111 (or (get symbol 'macrostep-gensym-face) 1112 (progn 1113 (if (not macrostep-gensyms-this-level) 1114 (setq macrostep-gensym-depth (1+ macrostep-gensym-depth) 1115 macrostep-gensyms-this-level t)) 1116 (let ((face (ring-ref macrostep-gensym-faces macrostep-gensym-depth))) 1117 (put symbol 'macrostep-gensym-face face) 1118 face)))) 1119 1120 1121 (provide 'macrostep) 1122 ;; Local Variables: 1123 ;; indent-tabs-mode: nil 1124 ;; End: 1125 ;;; macrostep.el ends here