[slime-cvs] CVS slime

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv1192

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-recompute-modelines): Recompute modelines only
for visible buffers. Kludge: modeline can be out of sync if the buffer
becomes visible and no slime/lisp interaction took place yet.
Patch by Raymond Toy.
(slime-search-buffer-package): Revert, with the above
change caching shouldn't be necessary.


--- /project/slime/cvsroot/slime/ChangeLog	2010/08/21 06:42:14	1.2128
+++ /project/slime/cvsroot/slime/ChangeLog	2010/08/21 21:31:28	1.2129
@@ -1,3 +1,12 @@
+2010-08-21  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (slime-recompute-modelines): Recompute modelines only
+	for visible buffers. Kludge: modeline can be out of sync if the buffer
+	becomes visible and no slime/lisp interaction took place yet.
+	Patch by Raymond Toy.
+	(slime-search-buffer-package): Revert, with the above
+	change caching shouldn't be necessary.
+
 2010-08-21  Helmut Eller  <heller at common-lisp.net>
 
 	Add commands to enable/disable contribs.
--- /project/slime/cvsroot/slime/slime.el	2010/08/21 06:40:04	1.1334
+++ /project/slime/cvsroot/slime/slime.el	2010/08/21 21:31:28	1.1335
@@ -416,7 +416,8 @@
   nil
   slime-mode-indirect-map
   (slime-setup-command-hooks)
-  (slime-recompute-modelines))
+  (setq slime-modeline-string (slime-modeline-string)))
+
 
 
 ;;;;;; Modeline
@@ -470,13 +471,24 @@
                  ((zerop sldbs) (format " %s" pending))
                  (t (format " %s/%s" pending sldbs)))))))
 
-(defun slime-recompute-modelines ()
-  (when (featurep 'xemacs)
-    (dolist (buffer (buffer-list))
-      (with-current-buffer buffer
-        (when (or slime-mode slime-popup-buffer-mode)
-          (setq slime-modeline-string (slime-modeline-string)))))
-    (force-mode-line-update t)))
+(defmacro slime-recompute-modelines ()
+  ;; Avoid a needless runtime funcall on GNU Emacs:
+  (and (featurep 'xemacs) `(slime-xemacs-recompute-modelines)))
+
+(defun slime-xemacs-recompute-modelines ()
+  (let (redraw-modeline)
+    (walk-windows
+     (lambda (object)
+       (setq object (window-buffer object))
+       (when (or (symbol-value-in-buffer 'slime-mode object)
+                 (symbol-value-in-buffer 'slime-popup-buffer-mode object))
+         ;; Only do the unwind-protect of #'with-current-buffer if we're
+         ;; actually interested in this buffer
+         (with-current-buffer object
+           (setq slime-modeline-string (slime-modeline-string)
+                 redraw-modeline t))))
+     'never t)
+    (and redraw-modeline (redraw-modeline t))))
 
 
 ;;;;; Key bindings
@@ -2106,22 +2118,15 @@
 ;;  (in-package "CL")
 ;;  (in-package |CL|)
 ;;  (in-package #+ansi-cl :cl #-ansi-cl 'lisp)
+
 (defun slime-search-buffer-package ()
-  (flet ((search-package ()
-           (let ((case-fold-search t)
-                 (regexp (concat "^(\\(cl:\\|common-lisp:\\)?in-package\\>[ \t']*"
-                                 "\\([^)]+\\)[ \t]*)")))
-             (save-excursion
-               (when (or (re-search-backward regexp nil t)
-                         (re-search-forward regexp nil t))
-                 (match-string-no-properties 2))))))
-    (if (eql (car slime-package-cache) (buffer-modified-tick))
-        (cdr slime-package-cache)
-        (let ((package (search-package)))
-          (setf slime-package-cache
-                (cons (buffer-modified-tick)
-                      package))
-          package))))
+  (let ((case-fold-search t)
+        (regexp (concat "^(\\(cl:\\|common-lisp:\\)?in-package\\>[ \t']*"
+                        "\\([^)]+\\)[ \t]*)")))
+    (save-excursion
+      (when (or (re-search-backward regexp nil t)
+                (re-search-forward regexp nil t))
+        (match-string-no-properties 2)))))
 
 ;;; Synchronous requests are implemented in terms of asynchronous
 ;;; ones. We make an asynchronous request with a continuation function