[slime-cvs] CVS slime

mbaringer mbaringer at common-lisp.net
Mon Apr 16 14:28:47 UTC 2007


Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv10844

Modified Files:
	slime.el 
Log Message:
Pressing `q' in *compiler notes* after a `C-c C-k' or
`C-c M-k' would not probably restore the original window
configuration. Fix that.

(slime-get-temp-buffer-create): New &key arg WINDOW-CONFIGURATION.
(slime-with-xref-buffer): Likewise.

(slime-compilation-finished): New &optional arg WINDOW-CONFIG.
(slime-maybe-show-xrefs-for-notes): Likewise.
(slime-show-xrefs) Likewise.
(slime-maybe-list-compiler-notes): Likewise.
(slime-list-compiler-notes): Likewise.

(slime-compilation-finished-continuation): Renamed to
SLIME-MAKE-COMPILATION-FINISHED-CONTINUATION.

(slime-make-compilation-finished-continuation): Now takes two
args, the current buffer and optionally the current window config
to be restored.

(slime-compile-file): Save current window configuration before
popping up the REPL for compilation output, pass it down.
(slime-easy-menu): Add entry for SLIME-UNTRACE-ALL.


--- /project/slime/cvsroot/slime/slime.el	2007/04/16 14:26:23	1.782
+++ /project/slime/cvsroot/slime/slime.el	2007/04/16 14:28:46	1.783
@@ -254,7 +254,7 @@
   :group 'slime-mode
   :type 'hook
   :options '(slime-maybe-list-compiler-notes
-             slime-list-compiler-notes 
+             slime-list-compiler-notes
              slime-maybe-show-xrefs-for-notes))
 
 (defcustom slime-goto-first-note-after-compilation nil
@@ -1201,7 +1201,8 @@
    "The window config \"fingerprint\" after displaying the buffer."))
 
 ;; Interface
-(defun* slime-get-temp-buffer-create (name &key mode noselectp reusep)
+(defun* slime-get-temp-buffer-create (name &key mode noselectp reusep 
+                                           window-configuration)
   "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
@@ -1211,8 +1212,14 @@
 otherwise it is shown and selected by `pop-to-buffer'.
 
 If REUSEP is true and a buffer does already exist with name NAME,
-then the buffer will be reused instead of being killed."
-  (let ((window-config (current-window-configuration))
+then the buffer will be reused instead of being killed.
+
+If WINDOW-CONFIGURATION is non-NIL, it's used to restore the
+original window configuration after closing the temporary
+buffer. Otherwise, the current configuration will be saved and
+that one used for restoration then.
+"
+  (let ((window-config (or window-configuration (current-window-configuration)))
         (buffer (get-buffer name)))
     (when (and buffer (not reusep))
       (kill-buffer name)
@@ -4465,7 +4472,7 @@
               (slime-eval-async 
                `(swank:compile-file-if-needed 
                  ,(slime-to-lisp-filename filename) t)
-               (slime-compilation-finished-continuation))))
+               (slime-make-compilation-finished-continuation (current-buffer)))))
   (:one-liner "Compile (if neccessary) and load a lisp file."))
 
 (defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
@@ -4621,15 +4628,18 @@
              (y-or-n-p (format "Save file %s? " (buffer-file-name))))
     (save-buffer))
   (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max))
-  (let ((lisp-filename (slime-to-lisp-filename (buffer-file-name))))
+  (let ((lisp-filename (slime-to-lisp-filename (buffer-file-name)))
+        (window-config (current-window-configuration)))
     (slime-insert-transcript-delimiter
      (format "Compile file %s" lisp-filename))
+    ;; The following may alter the current window-config, so we saved
+    ;; it, to pass it on for it to be restored!
     (when slime-display-compilation-output
       (slime-display-output-buffer))
     (slime-eval-async
      `(swank:compile-file-for-emacs 
        ,lisp-filename ,(if load t nil))
-     (slime-compilation-finished-continuation))
+     (slime-make-compilation-finished-continuation (current-buffer) window-config))
     (message "Compiling %s.." lisp-filename)))
 
 (defun slime-find-asd (system-names)
@@ -4676,7 +4686,7 @@
            system)
   (slime-eval-async
    `(swank:operate-on-system-for-emacs ,system ,operation , at keyword-args)
-   (slime-compilation-finished-continuation)))
+   (slime-make-compilation-finished-continuation (current-buffer))))
 
 (defun slime-compile-defun ()
   "Compile the current toplevel form."
@@ -4696,7 +4706,7 @@
      ,(buffer-name)
      ,start-offset
      ,(if (buffer-file-name) (file-name-directory (buffer-file-name))))
-   (slime-compilation-finished-continuation)))
+   (slime-make-compilation-finished-continuation (current-buffer))))
 
 (defun slime-note-count-string (severity count &optional suppress-if-zero)
   (cond ((and (zerop count) suppress-if-zero)
@@ -4752,7 +4762,7 @@
     (decf n))
   list)
 
-(defun slime-compilation-finished (result buffer)
+(defun slime-compilation-finished (result buffer &optional window-config)
   (let ((notes (slime-compiler-notes)))
     (with-current-buffer buffer
       (setf slime-compilation-just-finished t)
@@ -4760,12 +4770,12 @@
         (slime-show-note-counts notes secs)
         (when slime-highlight-compiler-notes
           (slime-highlight-notes notes))))
-    (run-hook-with-args 'slime-compilation-finished-hook notes)))
+    (run-hook-with-args 'slime-compilation-finished-hook notes window-config)))
 
-(defun slime-compilation-finished-continuation ()
-  (lexical-let ((buffer (current-buffer)))
+(defun slime-make-compilation-finished-continuation (current-buffer &optional window-config)
+  (lexical-let ((buffer current-buffer) (config window-config))
     (lambda (result)
-      (slime-compilation-finished result buffer))))
+      (slime-compilation-finished result buffer config))))
 
 (defun slime-highlight-notes (notes)
   "Highlight compiler notes, warnings, and errors in the buffer."
@@ -4847,31 +4857,33 @@
 
 ;;;;; Compiler notes list
 
-(defun slime-maybe-show-xrefs-for-notes (&optional notes)
+(defun slime-maybe-show-xrefs-for-notes (&optional notes window-config)
   "Show the compiler notes NOTES if they come from more than one file."
   (let* ((notes (or notes (slime-compiler-notes))) 
          (xrefs (slime-xrefs-for-notes notes)))
     (when (> (length xrefs) 1)          ; >1 file
       (slime-show-xrefs
-       xrefs 'definition "Compiler notes" (slime-current-package)))))
+       xrefs 'definition "Compiler notes" (slime-current-package)
+       window-config))))
 
 (defun slime-note-has-location-p (note)
   (not (eq ':error (car (slime-note.location note)))))
 
-(defun slime-maybe-list-compiler-notes (notes)
+(defun slime-maybe-list-compiler-notes (notes &optional window-config)
   "Show the compiler notes if appropriate."
   ;; don't pop up a buffer if all notes will are already annotated in
   ;; the buffer itself
   (unless (every #'slime-note-has-location-p notes)
-    (slime-list-compiler-notes notes)))
+    (slime-list-compiler-notes notes window-config)))
 
-(defun slime-list-compiler-notes (notes)
+(defun slime-list-compiler-notes (notes &optional window-config)
   "Show the compiler notes NOTES in tree view."
   (interactive (list (slime-compiler-notes)))
   (with-temp-message "Preparing compiler note tree..."
     (with-current-buffer
         (slime-get-temp-buffer-create "*compiler notes*"
-                                      :mode 'slime-compiler-notes-mode)
+                                      :mode 'slime-compiler-notes-mode
+                                      :window-configuration window-config)
       (let ((inhibit-read-only t))
         (erase-buffer)
         (when (null notes)
@@ -7741,7 +7753,8 @@
       (select-window (display-buffer buffer t))
       (shrink-window-if-larger-than-buffer))))
 
-(defmacro* slime-with-xref-buffer ((package ref-type symbol) &body body)
+(defmacro* slime-with-xref-buffer ((package ref-type symbol &key window-configuration) 
+                                   &body body)
   "Execute BODY in a xref buffer, then show that buffer."
   (let ((type (gensym)) (sym (gensym)) (pkg (gensym)))
     `(let ((,type ,ref-type) (,sym ,symbol) (,pkg ,package))
@@ -7751,7 +7764,7 @@
                   (slime-init-xref-buffer ,pkg ,type ,sym)
                   (make-local-variable 'slime-xref-saved-window-configuration)
                   (setq slime-xref-saved-window-configuration
-                        (current-window-configuration)))
+                        (or window-configuration (current-window-configuration))))
              (progn , at body)
            (setq buffer-read-only t)
            (select-window (or (get-buffer-window (current-buffer) t)
@@ -7783,12 +7796,12 @@
   (backward-char 1)
   (delete-char 1))
 
-(defun slime-show-xrefs (xrefs type symbol package)
+(defun slime-show-xrefs (xrefs type symbol package &optional window-config)
   "Show the results of an XREF query."
   (if (null xrefs)
       (message "No references found for %s." symbol)
     (setq slime-next-location-function 'slime-goto-next-xref)
-    (slime-with-xref-buffer (package type symbol)
+    (slime-with-xref-buffer (package type symbol :window-configuration window-config)
       (slime-insert-xrefs xrefs)
       (goto-char (point-min))
       (forward-line)




More information about the slime-cvs mailing list