--- /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)
