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. --- /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 ,@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)) + ,@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))) + ,@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)