[slime-devel] [patch] Improvements to slime-selector window handling

Travis Cross tc at travislists.com
Sun May 25 20:17:21 EDT 2008


Greetings,

The slime selector help feature does not restore emacs windows to their 
prior configuration after it is used.  This seems suboptimal to me.  The 
attached patch corrects this issue.

The patch also provides for automatically burying 'transactional' 
buffers when using the slime selector.  This may be a personal 
preference, but I don't like the top of my buffer list filling up with 
temporary buffers.

patches (1):
   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(-)


Cheers,

-- Travis
-------------- next part --------------
From f4c3f919c62f3aa91a29889478984dcf66ea66ac Mon Sep 17 00:00:00 2001
From: Travis Cross <tc at 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 , at 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 , at 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


More information about the slime-devel mailing list