[slime-cvs] CVS slime/contrib

heller heller at common-lisp.net
Tue Aug 5 18:19:34 UTC 2008


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

Modified Files:
	ChangeLog slime-typeout-frame.el 
Log Message:
Prevent typeout messages to be scribbled into random buffers.
Patch from Michael Weber.

* slime-typeout-frame.el (slime-typeout-message-aux): prevent
typeout messages from scribbling into any buffer which happens to
be in the typeout window
(slime-typeout-buffer): new function; changed buffer name to
"*SLIME Typeout*"
(slime-make-typeout-frame): use it
(slime-ensure-typeout-frame): ensure typeout buffer is visible

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/08/04 20:25:57	1.114
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/08/05 18:19:34	1.115
@@ -1,3 +1,13 @@
+2008-08-05  Michael Weber  <michaelw+slime at foldr.org>
+
+	* slime-typeout-frame.el (slime-typeout-message-aux): prevent
+	typeout messages from scribbling into any buffer which happens to
+	be in the typeout window
+	(slime-typeout-buffer): new function; changed buffer name to
+	"*SLIME Typeout*"
+	(slime-make-typeout-frame): use it
+	(slime-ensure-typeout-frame): ensure typeout buffer is visible
+
 2008-08-04  Adam Bozanich <adam.boz at gmail.com>
 
 	* slime-asdf.el: Load swank-asdf.
--- /project/slime/cvsroot/slime/contrib/slime-typeout-frame.el	2008/01/27 10:17:34	1.6
+++ /project/slime/cvsroot/slime/contrib/slime-typeout-frame.el	2008/08/05 18:19:34	1.7
@@ -8,8 +8,7 @@
 ;; Add something like this to your .emacs: 
 ;;
 ;;   (add-to-list 'load-path "<directory-of-this-file>")
-;;   (add-hook 'slime-load-hook (lambda () (require 'slime-typeout-frame)))
-;;
+;;   (slime-setup '(slime-typeout-frame))
 
 
 ;;;; Typeout frame
@@ -24,14 +23,20 @@
   '((height . 10) (minibuffer . nil))
   "The typeout frame properties (passed to `make-frame').")
 
+(defun slime-typeout-buffer ()
+  (with-current-buffer (get-buffer-create "*SLIME Typeout*")
+    (setq buffer-read-only t)
+    (current-buffer)))
+
 (defun slime-typeout-active-p ()
   (and slime-typeout-window
        (window-live-p slime-typeout-window)))
 
 (defun slime-typeout-message-aux (format-string &rest format-args)
   (slime-ensure-typeout-frame)
-  (with-current-buffer (window-buffer slime-typeout-window)
-    (let ((msg (apply #'format format-string format-args)))
+  (with-current-buffer (slime-typeout-buffer)
+    (let ((inhibit-read-only t)
+          (msg (apply #'format format-string format-args)))
       (unless (string= msg "")
 	(erase-buffer)
 	(insert msg)))))
@@ -50,13 +55,16 @@
   (let ((frame (make-frame slime-typeout-frame-properties)))
     (save-selected-window
       (select-window (frame-selected-window frame))
-      (switch-to-buffer "*SLIME-Typeout*")
+      (switch-to-buffer (slime-typeout-buffer))
       (setq slime-typeout-window (selected-window)))))
 
 (defun slime-ensure-typeout-frame ()
   "Create the typeout frame unless it already exists."
   (interactive)
-  (unless (slime-typeout-active-p)
+  (if (slime-typeout-active-p)
+      (save-selected-window
+        (select-window slime-typeout-window)
+        (switch-to-buffer (slime-typeout-buffer)))
     (slime-make-typeout-frame)))
 
 (defun slime-typeout-autodoc-message (doc)




More information about the slime-cvs mailing list