From f4c3f919c62f3aa91a29889478984dcf66ea66ac Mon Sep 17 00:00:00 2001
From: Travis Cross <tc@traviscross.com>
Date: Sat, 24 May 2008 03:04:31 +0000
Subject: [PATCH] Improvements to slime-selector window handling.

After selecting help from the slime selector, then selecting another
option, emacs windows are now restored.  Also, temporary buffers
selected from the slime-selector are now buried in the window list.
---
 contrib/slime-scratch.el |    2 +-
 slime.el                 |   71 +++++++++++++++++++++++++++++++++------------
 2 files changed, 53 insertions(+), 20 deletions(-)

diff --git a/contrib/slime-scratch.el b/contrib/slime-scratch.el
index 0121208..a54a1de 100644
--- a/contrib/slime-scratch.el
+++ b/contrib/slime-scratch.el
@@ -42,7 +42,7 @@
 
 (defun slime-scratch-init ()
   (def-slime-selector-method ?s
-    "*slime-scratch* buffer."
+      ("*slime-scratch* buffer." :buryp t)
     (slime-scratch-buffer)))
 
 (provide 'slime-scratch)
\ No newline at end of file
diff --git a/slime.el b/slime.el
index c73756b..1891aaa 100644
--- a/slime.el
+++ b/slime.el
@@ -7684,6 +7684,19 @@ If ARG is negative, move forwards."
 Each element is a list (KEY DESCRIPTION FUNCTION).
 DESCRIPTION is a one-line description of what the key selects.")
 
+(defvar slime-selector-saved-emacs-snapshot nil
+  "The snapshot of the current state in Emacs before slime selector help was
+activated.")
+
+(defvar slime-selector-bury-buffers nil
+  "A list of buffers to bury after switching to the next selector method.")
+
+(defvar slime-selector-kill-buffers nil
+  "A list of buffers to kill after switching to the next selector method.")
+
+(defvar slime-help-buffer-name "*Select Help*"
+  "The name of the slime help buffer.")
+
 (defun slime-selector ()
   "Select a new buffer by type, indicated by a single character.
 The user is prompted for a single character indicating the method by
@@ -7707,7 +7720,7 @@ See `def-slime-selector-method' for defining new methods."
           (t
            (funcall (third method))))))
 
-(defmacro def-slime-selector-method (key description &rest body)
+(defmacro* def-slime-selector-method (key (description &key buryp killp) &rest body)
   "Define a new `slime-select' buffer selection method.
 
 KEY is the key the user will enter to choose this method.
@@ -7721,63 +7734,83 @@ switch-to-buffer."
   `(setq slime-selector-methods
          (sort* (cons (list ,key ,description
                             (lambda () 
-                              (let ((buffer (progn ,@body)))
-                                (cond ((get-buffer buffer)
-                                       (switch-to-buffer buffer))
-                                      (t
-                                       (message "No such buffer: %S" buffer)
-                                       (ding))))))
+                              ,@(unless (= key ??)
+                                `((let ((help-buffer (get-buffer slime-help-buffer-name)))
+                                    (when (and slime-selector-saved-emacs-snapshot help-buffer)
+                                      (slime-set-emacs-snapshot slime-selector-saved-emacs-snapshot))
+                                    (when slime-selector-saved-emacs-snapshot
+                                      (setq slime-selector-saved-emacs-snapshot nil))
+                                    (when help-buffer
+                                      (ignore-errors (kill-buffer help-buffer))))))
+                              (let* ((buffer-or-name (progn ,@body))
+                                     (buffer (get-buffer buffer-or-name)))
+                                (if buffer
+                                    (progn
+                                      (switch-to-buffer buffer)
+                                      (loop for b = (pop slime-selector-bury-buffers)
+                                         while b do (ignore-errors (bury-buffer b)))
+                                      (loop for b = (pop slime-selector-kill-buffers)
+                                         while b do (ignore-errors (kill-buffer b)))
+                                      ,@(when buryp `((bury-buffer buffer)
+                                                      (push buffer slime-selector-bury-buffers)))
+                                      ,@(when killp `((push buffer slime-selector-kill-buffers))))
+                                    (progn
+                                      (message "No such buffer: %S" buffer)
+                                      (ding))))))
                       (remove* ,key slime-selector-methods :key #'car))
                 #'< :key #'car)))
 
-(def-slime-selector-method ?? "Selector help buffer."
-  (ignore-errors (kill-buffer "*Select Help*"))
-  (with-current-buffer (get-buffer-create "*Select Help*")
+(def-slime-selector-method ?? ("Selector help buffer." :buryp t)
+  (ignore-errors (kill-buffer slime-help-buffer-name))
+  (unless slime-selector-saved-emacs-snapshot
+    (setq slime-selector-saved-emacs-snapshot (slime-current-emacs-snapshot)))
+  (with-current-buffer (get-buffer-create slime-help-buffer-name)
     (insert "Select Methods:\n\n")
     (loop for (key line function) in slime-selector-methods
           do (insert (format "%c:\t%s\n" key line)))
     (help-mode)
     (display-buffer (current-buffer) t)
     (shrink-window-if-larger-than-buffer 
-     (get-buffer-window (current-buffer))))
+     (get-buffer-window (current-buffer)))
+    (bury-buffer (current-buffer)))
   (slime-selector)
   (current-buffer))
 
 (def-slime-selector-method ?r
-  "SLIME Read-Eval-Print-Loop."
+    ("SLIME Read-Eval-Print-Loop." :buryp t)
   (slime-output-buffer))
 
 (def-slime-selector-method ?i
-  "*inferior-lisp* buffer."
+    ("*inferior-lisp* buffer." :buryp t)
   (cond ((and (slime-connected-p) (slime-process))
          (process-buffer (slime-process)))
         (t
          "*inferior-lisp*")))
 
 (def-slime-selector-method ?v
-  "*slime-events* buffer."
+    ("*slime-events* buffer." :buryp t)
   slime-event-buffer-name)
 
 (def-slime-selector-method ?l
-  "most recently visited lisp-mode buffer."
+    ("most recently visited lisp-mode buffer." :buryp nil)
   (slime-recently-visited-buffer 'lisp-mode))
 
 (def-slime-selector-method ?d
-  "*sldb* buffer for the current connection."
+    ("*sldb* buffer for the current connection." :buryp t)
   (or (sldb-get-default-buffer)
       (error "No debugger buffer")))
 
 (def-slime-selector-method ?e
-  "most recently visited emacs-lisp-mode buffer."
+    ("most recently visited emacs-lisp-mode buffer." :buryp nil)
   (slime-recently-visited-buffer 'emacs-lisp-mode))
 
 (def-slime-selector-method ?c
-  "SLIME connections buffer."
+    ("SLIME connections buffer." :buryp t)
   (slime-list-connections)
   "*SLIME connections*")
 
 (def-slime-selector-method ?t
-  "SLIME threads buffer."
+    ("SLIME threads buffer." :buryp t)
   (slime-list-threads)
   "*slime-threads*")
 
-- 
1.5.5.1

