[slime-cvs] CVS update: slime/slime.el

[Luke Gorrie]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv8900

Modified Files:
	slime.el 
Log Message:
(slime-make-typeout-frame): New command to create a frame where
commands can print messages that would otherwise go to the echo area.

(slime-incidental-message): Function for printing "background"
messages. Uses the "typeout-frame" if it exists.

(slime-arglist): Print arglist with `slime-incidental-message'.

(slime-message): Use typeout frame if it exists, but only for
multi-line messages.

Date: Tue Nov 25 14:55:47 2003
Author: lgorrie

Index: slime/slime.el
diff -u slime/slime.el:1.107 slime/slime.el:1.108
--- slime/slime.el:1.107	Mon Nov 24 19:23:13 2003
+++ slime/slime.el	Tue Nov 25 14:55:34 2003
@@ -565,17 +565,19 @@
   (when (get-buffer-window buffer-name) (delete-windows-on buffer-name))
   (cond ((or (string-match "\n" message)
              (> (length message) (1- (frame-width))))
-         (lexical-let ((buffer (get-buffer-create buffer-name)))
-           (with-current-buffer buffer
-             (erase-buffer)
-             (insert message)
-             (goto-char (point-min))
-             (let ((win (slime-create-message-window)))
-               (set-window-buffer win (current-buffer))
-               (shrink-window-if-larger-than-buffer
-                (display-buffer (current-buffer)))))
-           (push (lambda () (delete-windows-on buffer) (bury-buffer buffer))
-                 slime-pre-command-actions)))
+         (if (slime-typeout-active-p)
+             (slime-typeout-message message)
+           (lexical-let ((buffer (get-buffer-create buffer-name)))
+             (with-current-buffer buffer
+               (erase-buffer)
+               (insert message)
+               (goto-char (point-min))
+               (let ((win (slime-create-message-window)))
+                 (set-window-buffer win (current-buffer))
+                 (shrink-window-if-larger-than-buffer
+                  (display-buffer (current-buffer)))))
+             (push (lambda () (delete-windows-on buffer) (bury-buffer buffer))
+                   slime-pre-command-actions))))
         (t (message "%s" message))))
 
 ;; defun slime-message
@@ -587,6 +589,15 @@
   (defun slime-message (fmt &rest args)
     (apply 'message fmt args)))
 
+(defun slime-incidental-message (format-string &rest format-args)
+  "Display a message in passing.
+This is like `slime-message', but less distracting because it
+will never pop up a buffer.
+It should be used for \"background\" messages such as argument lists."
+  (apply (if (slime-typeout-active-p) #'slime-typeout-message #'message)
+         format-string
+         format-args))
+
 (defun slime-set-truncate-lines ()
   "Set `truncate-lines' in the current buffer if
 `slime-truncate-lines' is non-nil."
@@ -2198,7 +2209,7 @@
      (lambda (arglist)
        (if show-fn
            (funcall show-fn arglist)
-         (message "%s" (slime-format-arglist symbol-name arglist)))))))
+         (slime-incidental-message "%s" (slime-format-arglist symbol-name arglist)))))))
 
 (defun slime-get-arglist (symbol-name)
   "Return the argument list for SYMBOL-NAME."
@@ -2283,6 +2294,38 @@
       (error
        (setq slime-autodoc-mode nil)
        (message "Error: %S; slime-autodoc-mode now disabled." err)))))
+
+
+;;; Typeout frame
+
+;; When a "typeout frame" is exists, it is used to display certain
+;; messages instead of the echo area or pop-up windows.
+
+(defvar slime-typeout-window nil
+  "The current typeout window.")
+
+(defvar slime-typeout-frame-properties
+  '((height . 16) (minibuffer . nil) (name . "SLIME Typeout"))
+  "The typeout frame properties (passed to `make-frame').")
+
+(defun slime-typeout-active-p ()
+  (and slime-typeout-window
+       (window-live-p slime-typeout-window)))
+
+(defun slime-typeout-message (format-string &rest format-args)
+  (assert (slime-typeout-active-p))
+  (with-current-buffer (window-buffer slime-typeout-window)
+    (erase-buffer)
+    (insert (apply #'format format-string format-args))))
+
+(defun slime-make-typeout-frame ()
+  "Create a frame for displaying messages (e.g. arglists)."
+  (interactive)
+  (let ((frame (make-frame slime-typeout-frame-properties)))
+    (save-selected-window
+      (select-window (frame-selected-window frame))
+      (switch-to-buffer "*SLIME-Typeout*")
+      (setq slime-typeout-window (selected-window)))))
 
 
 ;;; Completion