Klimi's new dotfiles with stow.
Du kannst nicht mehr als 25 Themen auswählen Themen müssen entweder mit einem Buchstaben oder einer Ziffer beginnen. Sie können Bindestriche („-“) enthalten und bis zu 35 Zeichen lang sein.

1129 Zeilen
45 KiB

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