[slime-devel] [Patch] Implementation of a macroexpansion stack.
Tobias C. Rittweiler
tcr at freebits.de
Thu May 11 12:43:02 EDT 2006
Hi Slime-hackers,
I implemented the macroexpansion stack that I talked about several month
ago. With the attached patch, it's possible to press `l' (for "last",
like in the inspector) to get to the same content as of the previous
macroexpansion buffer, for example, after an in-place expansion. It also
tries to use the highlighting-edits facility in the most reasonable way
I could make out.
It's cool, man! Try it out.
-T.
2006-05-11 Tobias Rittweiler <PUT-MY-ADDRESS-HERE>
* slime.el (slime-use-autodoc-mode): Fix typo in docstring.
* slime.el (slime-use-highlight-edits-mode): New variable,
analogous to SLIME-USE-AUTODOC-MODE.
(slime-setup, slime-lisp-mode-hook): Make above variable
work. Also, activates the HIGHLIGHT-EDITS-MODE in proper way (thus
avoiding the nasty "Toggling ... off; better pass an explicit
argument." message.)
* slime.el (with-struct-slots): Renamed from WITH-STRUCT. Also,
changed calling semantics slightly.
* slime.el (slime-get-temp-buffer-create): Added new keyword
ACTIVATOR that represents a function responsible for activating a
given buffer, supersedes the NOSELECTP keyword which got removed
because it wasn't used anywhere. Updated docstring.
(slime-with-output-to-temp-buffer): Likewise.
* slime.el: Fix typo in comment about communication protocol.
* slime.el (slime-macroexpansion-buffer-name): New variable,
contains the name of the macroexpansion buffer.
* slime.el: Implemented macroexpansion stack, for instance, for
going back from an in-place macroexpansion to its originated
expansion:
(slime-macroexpansion-minor-mode): Pressing `l' inside the
macroexpansion buffer, will bring the user back to the previous
macroexpansion, if possible.
(slime-macroexpansion-stack): New variable, the stack.
(slime-macroexpansion-struct): Structure representing one item in
the stack, an item contains all relevant information to restore
the macroexpansion buffer to its prior appearance.
(slime-eval-macroexpand-expression): Removed, because the same
information is now stored in the stack items.
(slime-macroexpansion-kill-buffer-finalizer): Responsible for
clearing the stack, when the macroexpansion buffer is killed.
(slime-update-macroexpansion-stack-top): New.
(slime-extend-macroexpansion-stack): New.
(with-macroexpansion-buffer): New macro, responsible for finding
respectively creating a macroexpansion buffer that's made the
current buffer within its scope.
(slime-eval-macroexpand, slime-eval-macroexpand-inplace):
Accomodated for the new macroexpansion stack.
(slime-macroexpansion-buffer-go-back): New function, responsible
for restoring the previous macroexpansion in the stack.
(slime-macroexpand-again): Accomodated to macroexpansion stack.
-------------- next part --------------
--- /home/tcr/src/from-upstream/slime/slime.el 2006-04-15 15:46:14.000000000 +0200
+++ slime.el 2006-05-11 18:09:30.000000000 +0200
@@ -65,7 +65,10 @@
(require 'easymenu)
(defvar slime-use-autodoc-mode nil
- "When non-nil always enabled slime-autodoc-mode in slime-mode.")
+ "When non-nil always enable slime-autodoc-mode in slime-mode.")
+
+(defvar slime-use-highlight-edits-mode nil
+ "When non-nil always enable slime-highlight-edits-mode in slime-mode")
(defun* slime-setup (&key autodoc typeout-frame highlight-edits)
"Setup Emacs so that lisp-mode buffers always use SLIME."
@@ -73,15 +76,16 @@
(when typeout-frame
(add-hook 'slime-connected-hook 'slime-ensure-typeout-frame))
(setq slime-use-autodoc-mode autodoc)
- (when highlight-edits
- (add-hook 'slime-mode-hook 'slime-highlight-edits-mode)))
+ (setq slime-use-highlight-edits-mode highlight-edits))
(defun slime-lisp-mode-hook ()
(slime-mode 1)
(set (make-local-variable 'lisp-indent-function)
'common-lisp-indent-function)
(when slime-use-autodoc-mode
- (slime-autodoc-mode 1)))
+ (slime-autodoc-mode 1))
+ (when slime-use-highlight-edits-mode
+ (slime-highlight-edits-mode 1)))
(eval-and-compile
(defvar slime-path
@@ -1003,9 +1007,10 @@
(put 'slime-define-keys 'lisp-indent-function 1)
-(defmacro* with-struct ((conc-name &rest slots) struct &body body)
- "Like with-slots but works only for structs.
-\(fn (CONC-NAME &rest SLOTS) STRUCT &body BODY)"
+(defmacro* with-struct-slots ((&rest slots) (struct &key conc-name) &body body)
+ "Similiar to Common Lisp's WITH-SLOTS but works only for
+structs. CONC-NAME is prepended to each slot-name in SLOTS to
+access the respective field within STRUCT."
(flet ((reader (slot) (intern (concat (symbol-name conc-name)
(symbol-name slot)))))
(let ((struct-var (gensym "struct")))
@@ -1019,7 +1024,7 @@
slots)
. ,body)))))
-(put 'with-struct 'lisp-indent-function 2)
+(put 'with-struct-slots 'lisp-indent-function 2)
;;;;; Very-commonly-used functions
@@ -1166,35 +1171,43 @@
"The window config \"fingerprint\" after displaying the buffer."))
;; Interface
-(defun* slime-get-temp-buffer-create (name &key mode noselectp)
+(defun* slime-get-temp-buffer-create (name &key mode activator)
"Return a fresh temporary buffer called NAME in MODE.
The buffer also uses the minor-mode `slime-temp-buffer-mode'. Pressing
`q' in the buffer will restore the window configuration to the way it
is when the buffer was created, i.e. when this function was called.
-If NOSELECTP is true then the buffer is shown by `display-buffer',
-otherwise it is shown and selected by `pop-to-buffer'."
+ACTIVATOR is a function that is responsible for activating
+(i.e. showing, selecting, whatever) the newly created buffer that
+is passed as argument. Exemplary candidates are `display-buffer',
+`pop-to-buffer' or `switch-to-buffer'.
+
+By default (that is when ACTIVATOR is NIL), the buffer is shown
+and selected by `pop-to-buffer'."
(let ((window-config (current-window-configuration)))
(when (get-buffer name) (kill-buffer name))
(with-current-buffer (get-buffer-create name)
(when mode (funcall mode))
(slime-temp-buffer-mode 1)
(setq slime-temp-buffer-saved-window-configuration window-config)
- (let ((window (if noselectp
- (display-buffer (current-buffer) t)
- (pop-to-buffer (current-buffer))
- (selected-window))))
- (setq slime-temp-buffer-fingerprint (slime-window-config-fingerprint)))
+ (if activator
+ (funcall activator (current-buffer))
+ (pop-to-buffer (current-buffer)))
+ (setq slime-temp-buffer-fingerprint (slime-window-config-fingerprint))
(current-buffer))))
;; Interface
-(defmacro* slime-with-output-to-temp-buffer ((name &optional mode)
+(defmacro* slime-with-output-to-temp-buffer ((name &optional mode activator)
package &rest body)
"Similar to `with-output-to-temp-buffer'.
Also saves the window configuration, and inherits the current
-`slime-connection' in a buffer-local variable."
+`slime-connection' in a buffer-local variable.
+
+MODE and ACTIVATOR are passed to `slime-get-temp-buffer-create',
+see there for an explanation."
`(let ((connection (slime-connection))
- (standard-output (slime-get-temp-buffer-create ,name :mode ',mode)))
+ (standard-output (slime-get-temp-buffer-create ,name :mode ',mode
+ :activator ,activator)))
(prog1 (with-current-buffer standard-output , at body)
(with-current-buffer standard-output
(setq slime-buffer-connection connection)
@@ -2281,8 +2294,8 @@
This is set only in buffers bound to specific packages."))
;;; `slime-rex' is the RPC primitive which is used to implement both
-;;; `slime-eval' and `slime-eval-async'. You can use it directly you
-;;; need to but the others are usually more convenient.
+;;; `slime-eval' and `slime-eval-async'. You can use it directly if
+;;; you need to, but the others are usually more convenient.
(defmacro* slime-rex ((&rest saved-vars)
(sexp &optional
@@ -4750,7 +4763,8 @@
(defun slime-tree-insert (tree prefix)
"Insert TREE prefixed with PREFIX at point."
- (with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
+ (with-struct-slots (print-fn kids collapsed-p start-mark end-mark)
+ (tree :conc-name slime-tree.)
(let ((line-start (line-beginning-position)))
(setf start-mark (point-marker))
(slime-tree-insert-decoration tree)
@@ -4775,7 +4789,8 @@
(defun slime-tree-toggle (tree)
"Toggle the visibility of TREE's children."
- (with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
+ (with-struct-slots (collapsed-p start-mark end-mark prefix)
+ (tree :conc-name slime-tree.)
(setf collapsed-p (not collapsed-p))
(slime-tree-delete tree)
(insert-before-markers " ") ; move parent's end-mark
@@ -7301,11 +7316,14 @@
;;;; Macroexpansion
+(defvar slime-macroexpansion-buffer-name "*SLIME macroexpansion*")
+
(define-minor-mode slime-macroexpansion-minor-mode
"SLIME mode for macroexpansion"
nil
" temp"
'(("q" . slime-temp-buffer-quit)
+ ("l" . slime-macroexpansion-buffer-go-back)
("g" . slime-macroexpand-again)))
(flet ((remap (from to)
@@ -7314,44 +7332,172 @@
(remap 'slime-macroexpand-1 'slime-macroexpand-1-inplace)
(remap 'slime-macroexpand-all 'slime-macroexpand-all-inplace))
-(defvar slime-eval-macroexpand-expression nil
- "Specifies the last macroexpansion preformed. This variable
- specifies both what was expanded and how.")
-
-(defun slime-eval-macroexpand (expander &optional string)
- (unless string
- (setf string (slime-sexp-at-point-or-error)))
- (setf slime-eval-macroexpand-expression `(,expander ,string))
- (lexical-let ((package (slime-current-package)))
- (slime-eval-async
- slime-eval-macroexpand-expression
+
+(defvar slime-macroexpansion-stack '()
+ "A stack that consists of SLIME-MACROEXPANSION-STRUCTs which
+ represent the last macroexpansions that have been done in the
+ current SLIME Macroexpansion Buffer")
+
+(defun slime-macroexpansion-kill-buffer-finalizer ()
+ (when (eq (current-buffer) (get-buffer slime-macroexpansion-buffer-name))
+ (setf slime-macroexpansion-stack nil)))
+
+(add-hook 'slime-mode-hook
+ (lambda () (add-hook 'kill-buffer-hook 'slime-macroexpansion-kill-buffer-finalizer)))
+
+(defstruct (slime-macroexpansion-struct (:conc-name slime-macroexpansion-struct.))
+ expander-expression ; s-expression that results in the macroexpansion.
+ expansion ; macroexpansion string returned from SWANK.
+ point ; last cursor position before new in-place expansion,
+ ; for restoring previous context on go-back.
+ highlight-region-start ; start position and end position for
+ highlight-region-end) ; highlight-edits-mode, for restoration as well.
+
+(defun* slime-update-macroexpansion-stack-top (&key expander-expression expansion point
+ highlight-region-start highlight-region-end)
+ "Set the respective struct-slot in the top item of
+SLIME-MACROEXPANSION-STACK to the given value."
+ (when slime-macroexpansion-stack
+ (macrolet ((maybe-setf (source target)
+ `(when ,target (setf ,source ,target))))
+ (with-struct-slots ((stack-top.expander expander-expression)
+ (stack-top.expansion expansion)
+ (stack-top.highlight-start highlight-region-start)
+ (stack-top.highlight-end highlight-region-end)
+ (stack-top.point point))
+ ((first slime-macroexpansion-stack) :conc-name slime-macroexpansion-struct.)
+ (maybe-setf stack-top.expander expander-expression)
+ (maybe-setf stack-top.expansion expansion)
+ (maybe-setf stack-top.point point)
+ (maybe-setf stack-top.highlight-start highlight-region-start)
+ (maybe-setf stack-top.highlight-end highlight-region-end))
+ t)))
+
+(defun* slime-extend-macroexpansion-stack (&rest args)
+ (let ((new-stack-item (apply #'make-slime-macroexpansion-struct args)))
+ (push new-stack-item slime-macroexpansion-stack)))
+
+(defmacro* with-macroexpansion-buffer ((&key reuse save-point buffer activator) &body body)
+ "Find or create the macroexpansion buffer and make it the
+current buffer and prepare it for insertion resp. modification.
+
+Unless BUFFER is explicitely given, a buffer is searched for that
+is named SLIME-MACROEXPANSION-BUFFER-NAME, and, if not found,
+it's created.
+
+ACTIVATOR is a function that takes the macroexpansion buffer
+buffer as argument and activates it. Candidates are, for
+instance, `display-buffer', `pop-to-buffer' or
+`switch-to-buffer'. By default, `pop-to-buffer' is used.
+
+If REUSE is T, keep the content of the macroexpansion buffer,
+otherwise make the buffer empty.
+
+If SAVE-POINT is T, save the current value of point in the top
+item of the SLIME-MACROEXPANSION-STACK before any modification is
+done to the buffer within the scope of this macro.
+"
+ (lexical-let ((macroexpansion-buffer-g (gensym "macroexpansion-buffer-"))
+ (activator-g (gensym "activator-")))
+ ;; Distinguish between the case when the buffer for marcoexpansion
+ ;; exists already and when not; the reason is that
+ ;; SLIME-WITH-OUTPUT-TO-TEMP-BUFFER kills an already existing
+ ;; buffer which would trigger the finalizer in KILL-BUFFER-HOOK
+ ;; (see above.)
+ `(if (or slime-macroexpansion-stack ,buffer)
+ (lexical-let ((,macroexpansion-buffer-g (or ,buffer (get-buffer slime-macroexpansion-buffer-name)))
+ (,activator-g (or ,activator 'pop-to-buffer)))
+ (assert ,macroexpansion-buffer-g) (funcall ,activator-g ,macroexpansion-buffer-g)
+ (with-current-buffer ,macroexpansion-buffer-g
+ (let ((buffer-read-only nil))
+ (when ,save-point (slime-update-macroexpansion-stack-top :point (point)))
+ (unless ,reuse (erase-buffer))
+ , at body)))
+ (slime-with-output-to-temp-buffer ; create new buffer for macroexpansion.
+ (slime-macroexpansion-buffer-name lisp-mode ,activator) (slime-current-package)
+ (slime-macroexpansion-minor-mode 1)
+ (when ,save-point
+ (slime-update-macroexpansion-stack-top :point (point)))
+ , at body))))
+
+(defun slime-eval-macroexpand (expander &optional string buffer-activator)
+ (unless string (setf string (slime-sexp-at-point-or-error)))
+ (lexical-let ((expand-expression `(,expander ,string))
+ (activator buffer-activator)) ; necessary for expansion of
+ (slime-eval-async expand-expression ; WITH-MACROEXPANSION-BUFFER
(lambda (expansion)
- (slime-with-output-to-temp-buffer
- ("*SLIME macroexpansion*" lisp-mode) package
- (slime-macroexpansion-minor-mode)
+ (with-macroexpansion-buffer (:reuse nil :save-point t :activator activator)
(insert expansion)
- (font-lock-fontify-buffer))))))
+ (font-lock-fontify-buffer)
+ (goto-char 0)
+ ;; On go-back, highlight the whole buffer because it got
+ ;; overwritten by the new macroexpansion EXPANSION.
+ (slime-update-macroexpansion-stack-top
+ :highlight-region-start (point-min)
+ :highlight-region-end (point-max))
+ (slime-extend-macroexpansion-stack ; FIXME: [*]
+ :expander-expression expand-expression
+ :expansion expansion :point 0
+ :highlight-region-start (point-min)
+ :highlight-region-end (point-max)))))))
+
+;; [*] Room for Improvement, actually: What if nothing new got
+;; expanded, i.e. if EXPANSION is equal to the expansion stored in the
+;; top of the stack -- create a new stack item or not? Currently, it's
+;; done. Of course, we could just compare the two strings, but that
+;; could be tedious and slow. Cool would be if it was possible to get
+;; an EXPANDED-P as additional value from the macroexpand functions in
+;; SWANK.
-(defun slime-eval-macroexpand-inplace (expander)
- "Substitutes the current sexp at place with its macroexpansion.
-NB: Does not affect *slime-eval-macroexpand-expression*"
+(defun slime-eval-macroexpand-inplace (expander)
+ "Substitutes the current sexp at place with its macroexpansion."
(interactive)
(lexical-let* ((string (slime-sexp-at-point-or-error))
- (package (slime-current-package))
(start (point))
(end (+ start (length string)))
- (buffer (current-buffer)))
- (slime-eval-async
- `(,expander ,string)
- (lambda (expansion)
- (with-current-buffer buffer
- (let ((buffer-read-only nil))
- (goto-char start)
- (delete-region start end)
- (insert expansion)
- (goto-char start)
- (indent-sexp)))))))
+ (buffer (current-buffer))
+ (expand-expression `(,expander ,string)))
+ (slime-eval-async expand-expression
+ (lambda (expansion)
+ (with-macroexpansion-buffer (:buffer buffer :reuse t :save-point t)
+ (when slime-use-highlight-edits-mode
+ (slime-remove-edits (point-min) (point-max)))
+ (goto-char start)
+ (delete-region start end)
+ (insert expansion)
+ (goto-char start)
+ (indent-sexp)
+ ;; On go-back, highlight the s-expression that just got
+ ;; expanded away.
+ (slime-update-macroexpansion-stack-top
+ :highlight-region-start start
+ :highlight-region-end end)
+ (slime-extend-macroexpansion-stack
+ :expander-expression expand-expression
+ :expansion (buffer-string) :point start
+ :highlight-region-start start
+ :highlight-region-end (+ start (length expansion))))))))
+
+
+(defun slime-macroexpansion-buffer-go-back ()
+ "Goes back to last macroexpansion by restoring its buffer content,
+point and highlighted edit regions."
+ (interactive)
+ (flet ((last-buffer-in-stack-p (stack) (not (cdr stack))))
+ (if (last-buffer-in-stack-p slime-macroexpansion-stack)
+ (message "Last macroexpansion in stack: Can't go back.")
+ (pop slime-macroexpansion-stack)
+ (with-struct-slots (expansion point highlight-region-start highlight-region-end)
+ ((first slime-macroexpansion-stack) :conc-name slime-macroexpansion-struct.)
+ (with-macroexpansion-buffer (:reuse nil)
+ (insert expansion)
+ (goto-char point)
+ (when slime-use-highlight-edits-mode
+ (slime-remove-edits (point-min) (point-max))
+ (slime-highlight-edits highlight-region-start
+ highlight-region-end)))))))
+
(defun slime-macroexpand-1 (&optional repeatedly)
"Display the macro expansion of the form at point. The form is
@@ -7389,8 +7535,9 @@
(defun slime-macroexpand-again ()
"Reperform the last macroexpansion."
(interactive)
- (slime-eval-macroexpand (first slime-eval-macroexpand-expression)
- (second slime-eval-macroexpand-expression)))
+ (lexical-let* ((stack-top (first slime-macroexpansion-stack))
+ (expr (slime-macroexpansion-struct.expander-expression stack-top)))
+ (slime-eval-macroexpand (first expr) (second expr) 'switch-to-buffer))) ; don't popup new buffer!
;;;; Subprocess control
@@ -9243,8 +9390,8 @@
(slime-unexpected-failures 0)
(slime-expected-failures 0))
(dolist (slime-current-test slime-tests)
- (with-struct (slime-test. name (function fname) inputs)
- slime-current-test
+ (with-struct-slots (name (function fname) inputs)
+ (slime-current-test :conc-name slime-test.)
(slime-test-heading 1 "%s" name)
(dolist (input inputs)
(incf slime-total-tests)
More information about the slime-devel
mailing list