129 lines
4.8 KiB
EmacsLisp
129 lines
4.8 KiB
EmacsLisp
;;; slime-macrostep.el -- fancy macro-expansion via macrostep.el
|
||
|
||
;; Authors: Luís Oliveira <luismbo@gmail.com>
|
||
;; Jon Oddie <j.j.oddie@gmail.com
|
||
;;
|
||
;; License: GNU GPL (same license as Emacs)
|
||
|
||
;;; Description:
|
||
|
||
;; Fancier in-place macro-expansion using macrostep.el (originally
|
||
;; written for Emacs Lisp). To use, position point before the
|
||
;; open-paren of the macro call in a SLIME source or REPL buffer, and
|
||
;; type `C-c M-e' or `M-x macrostep-expand'. The pretty-printed
|
||
;; result of `macroexpand-1' will be inserted inline in the current
|
||
;; buffer, which is temporarily read-only while macro expansions are
|
||
;; visible. If the expansion is itself a macro call, expansion can be
|
||
;; continued by typing `e'. Expansions are collapsed to their
|
||
;; original macro forms by typing `c' or `q'. Other macro- and
|
||
;; compiler-macro calls in the expansion will be font-locked
|
||
;; differently, and point can be moved there quickly by typing `n' or
|
||
;; `p'. For more details, see the documentation of
|
||
;; `macrostep-expand'.
|
||
|
||
;;; Code:
|
||
|
||
(require 'slime)
|
||
(eval-and-compile
|
||
(require 'macrostep nil t)
|
||
;; Use bundled version if not separately installed
|
||
(require 'macrostep "../lib/macrostep"))
|
||
(eval-when-compile (require 'cl-lib))
|
||
|
||
(defvar slime-repl-mode-hook)
|
||
(defvar slime-repl-mode-map)
|
||
|
||
(define-slime-contrib slime-macrostep
|
||
"Interactive macro expansion via macrostep.el."
|
||
(:authors "Luís Oliveira <luismbo@gmail.com>"
|
||
"Jon Oddie <j.j.oddie@gmail.com>")
|
||
(:license "GPL")
|
||
(:swank-dependencies swank-macrostep)
|
||
(:on-load
|
||
(easy-menu-add-item slime-mode-map '(menu-bar SLIME Debugging)
|
||
["Macro stepper..." macrostep-expand (slime-connected-p)]
|
||
"Create Trace Buffer")
|
||
(add-hook 'slime-mode-hook #'macrostep-slime-mode-hook)
|
||
(define-key slime-mode-map (kbd "C-c M-e") #'macrostep-expand)
|
||
(eval-after-load 'slime-repl
|
||
'(progn
|
||
(add-hook 'slime-repl-mode-hook #'macrostep-slime-mode-hook)
|
||
(define-key slime-repl-mode-map (kbd "C-c M-e") #'macrostep-expand)))))
|
||
|
||
(defun macrostep-slime-mode-hook ()
|
||
(setq macrostep-sexp-at-point-function #'macrostep-slime-sexp-at-point)
|
||
(setq macrostep-environment-at-point-function #'macrostep-slime-context)
|
||
(setq macrostep-expand-1-function #'macrostep-slime-expand-1)
|
||
(setq macrostep-print-function #'macrostep-slime-insert)
|
||
(setq macrostep-macro-form-p-function #'macrostep-slime-macro-form-p))
|
||
|
||
(defun macrostep-slime-sexp-at-point (&rest _ignore)
|
||
(slime-sexp-at-point))
|
||
|
||
(defun macrostep-slime-context ()
|
||
(let (defun-start defun-end)
|
||
(save-excursion
|
||
(while
|
||
(condition-case nil
|
||
(progn (backward-up-list) t)
|
||
(scan-error nil)))
|
||
(setq defun-start (point))
|
||
(setq defun-end (scan-sexps (point) 1)))
|
||
(list (buffer-substring-no-properties
|
||
defun-start (point))
|
||
(buffer-substring-no-properties
|
||
(scan-sexps (point) 1) defun-end))))
|
||
|
||
(defun macrostep-slime-expand-1 (string context)
|
||
(slime-dcase
|
||
(slime-eval
|
||
`(swank-macrostep:macrostep-expand-1
|
||
,string ,macrostep-expand-compiler-macros ',context))
|
||
((:error error-message)
|
||
(error "%s" error-message))
|
||
((:ok expansion positions)
|
||
(list expansion positions))))
|
||
|
||
(defun macrostep-slime-insert (result _ignore)
|
||
"Insert RESULT at point, indenting to match the current column."
|
||
(cl-destructuring-bind (expansion positions) result
|
||
(let ((start (point))
|
||
(column-offset (current-column)))
|
||
(insert expansion)
|
||
(macrostep-slime--propertize-macros start positions)
|
||
(indent-rigidly start (point) column-offset))))
|
||
|
||
(defun macrostep-slime--propertize-macros (start-offset positions)
|
||
"Put text properties on macro forms."
|
||
(dolist (position positions)
|
||
(cl-destructuring-bind (operator type start)
|
||
position
|
||
(let ((open-paren-position
|
||
(+ start-offset start)))
|
||
(put-text-property open-paren-position
|
||
(1+ open-paren-position)
|
||
'macrostep-macro-start
|
||
t)
|
||
;; this assumes that the operator starts right next to the
|
||
;; opening parenthesis. We could probably be more robust.
|
||
(let ((op-start (1+ open-paren-position)))
|
||
(put-text-property op-start
|
||
(+ op-start (length operator))
|
||
'font-lock-face
|
||
(if (eq type :macro)
|
||
'macrostep-macro-face
|
||
'macrostep-compiler-macro-face)))))))
|
||
|
||
(defun macrostep-slime-macro-form-p (string context)
|
||
(slime-dcase
|
||
(slime-eval
|
||
`(swank-macrostep:macro-form-p
|
||
,string ,macrostep-expand-compiler-macros ',context))
|
||
((:error error-message)
|
||
(error "%s" error-message))
|
||
((:ok result)
|
||
result)))
|
||
|
||
|
||
|
||
(provide 'slime-macrostep)
|