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)) + ,@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 ()