[climacs-cvs] CVS esa

[thenriksen]

Update of /project/climacs/cvsroot/esa
In directory clnet:/tmp/cvs-serv22755

Modified Files:
	packages.lisp esa.lisp 
Log Message:
Added `with-minibuffer-stream' and switched implementation of
minibuffer to use an output record instead of a string.


--- /project/climacs/cvsroot/esa/packages.lisp	2006/03/25 00:08:07	1.1.1.1
+++ /project/climacs/cvsroot/esa/packages.lisp	2006/04/08 23:36:44	1.2
@@ -1,6 +1,7 @@
 (defpackage :esa
   (:use :clim-lisp :clim)
   (:export #:minibuffer-pane #:display-message
+           #:with-minibuffer-stream
            #:esa-pane-mixin #:previous-command
            #:info-pane #:master-pane
            #:esa-frame-mixin #:windows #:recordingp #:executingp
--- /project/climacs/cvsroot/esa/esa.lisp	2006/03/27 15:38:19	1.5
+++ /project/climacs/cvsroot/esa/esa.lisp	2006/04/08 23:36:44	1.6
@@ -42,30 +42,49 @@
   displayed." )
 
 (defclass minibuffer-pane (application-pane)
-  ((message :initform nil :accessor message)
-   (message-time :initform 0 :accessor message-time))
+  ((message :initform nil
+            :accessor message
+            :documentation "An output record containing whatever
+            message is supposed to be displayed in the
+            minibuffer.")
+   (message-time :initform 0
+                 :accessor message-time
+                 :documentation "The universal time at which the
+                 current message was set."))
   (:default-initargs
-      :scroll-bars nil
-      :display-function 'display-minibuffer))
-
-(defun display-minibuffer (frame pane)
-  (declare (ignore frame))
-  (with-slots (message) pane
-    (unless (null message)
-    (princ message pane)
-    (when (> (get-universal-time)
-             (+ *minimum-message-time* (message-time pane)))
-      (setf message nil)))))
+   :scroll-bars nil
+    :display-function 'display-minibuffer))
 
 (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args)
   (declare (ignore type args))
   (window-clear pane))
 
+(defun display-minibuffer (frame pane)
+  (declare (ignore frame))
+  (when (message pane)
+    (if (> (get-universal-time)
+           (+ *minimum-message-time* (message-time pane)))
+        (setf (message pane) nil)
+        (replay-output-record (message pane) pane))))
+
+(defmacro with-minibuffer-stream ((stream-symbol)
+                                  &body body)
+  "Bind `stream-symbol' to the minibuffer stream and evaluate
+  `body'. This macro makes sure to setup the initial blanking of
+  the minibuffer as well as taking care of for how long the
+  message should be displayed."
+  `(let ((,stream-symbol *standard-input*))
+     (setf (message ,stream-symbol)
+           (with-output-to-output-record (,stream-symbol)
+             (window-clear ,stream-symbol)
+             (setf (message-time ,stream-symbol) (get-universal-time))
+             , at body))))
+
 (defun display-message (format-string &rest format-args)
-  (setf (message *standard-input*)
-	(apply #'format nil format-string format-args))
-  (setf (message-time *standard-input*)
-        (get-universal-time)))
+  "Display a message in the minibuffer. Composes the string based
+on the `format-string' and the `format-args'."
+  (with-minibuffer-stream (minibuffer)
+    (apply #'format minibuffer format-string format-args)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
@@ -323,6 +342,7 @@
                     ;; for presentation-to-command-translators,
                     ;; which are searched for in
                     ;; (frame-command-table *application-frame*)
+                    (redisplay-frame-pane frame (frame-standard-input frame) :force-p t)
                     (setf (frame-command-table frame) command-table)
                     (process-gestures-or-command frame command-table))
                 (abort-gesture ()