[climacs-cvs] CVS esa

[thenriksen]

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

Modified Files:
	esa.lisp 
Log Message:
Added minimum display time for minibuffer messages.


--- /project/climacs/cvsroot/esa/esa.lisp	2006/03/26 14:29:42	1.3
+++ /project/climacs/cvsroot/esa/esa.lisp	2006/03/26 20:59:36	1.4
@@ -37,8 +37,13 @@
 ;;; 
 ;;; Minibuffer pane
 
+(defvar *minimum-message-time* 1
+  "The minimum number of seconds a minibuffer message will be
+  displayed." )
+
 (defclass minibuffer-pane (application-pane)
-  ((message :initform nil :accessor message))
+  ((message :initform nil :accessor message)
+   (message-time :initform 0 :accessor message-time))
   (:default-initargs
       :scroll-bars nil
       :display-function 'display-minibuffer))
@@ -48,7 +53,9 @@
   (with-slots (message) pane
     (unless (null message)
     (princ message pane)
-    (setf message nil))))
+    (when (> (get-universal-time)
+             (+ *minimum-message-time* (message-time pane)))
+      (setf message nil)))))
 
 (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args)
   (declare (ignore type args))
@@ -56,7 +63,9 @@
 
 (defun display-message (format-string &rest format-args)
   (setf (message *standard-input*)
-	(apply #'format nil format-string format-args)))
+	(apply #'format nil format-string format-args))
+  (setf (message-time *standard-input*)
+        (get-universal-time)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;