Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv6356
Modified Files: input-editing-drei.lisp input-editing.lisp Log Message: Moved some input-editing functions around.
The typeout area is now cleared at the end of an input-editing session.
--- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 22:29:07 1.10 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/31 19:17:57 1.11 @@ -100,12 +100,9 @@ (define-condition rescan-condition (condition) ())
-(defgeneric finalize (editing-stream input-sensitizer) - (:documentation "Do any cleanup on an editing stream, like turning off the - cursor, etc.")) - (defmethod finalize ((stream drei:drei-input-editing-mixin) input-sensitizer) + (call-next-method) (setf (cursor-visibility stream) nil) (let ((real-stream (encapsulating-stream-stream stream)) (record (drei:drei-instance stream))) @@ -124,24 +121,6 @@ (setf (stream-cursor-position real-stream) (values 0 (nth-value 3 (input-editing-stream-bounding-rectangle stream))))))
-(defmethod invoke-with-input-editing :around ((stream extended-output-stream) - continuation - input-sensitizer - initial-contents - class) - (declare (ignore continuation input-sensitizer initial-contents class)) - (letf (((cursor-visibility (stream-text-cursor stream)) nil)) - (call-next-method))) - -(defmethod invoke-with-input-editing :around (stream - continuation - input-sensitizer - initial-contents - class) - (declare (ignore continuation input-sensitizer initial-contents class)) - (with-activation-gestures (*standard-activation-gestures*) - (call-next-method))) - ;; XXX: We are supposed to implement input editing for all ;; "interactive streams", but that's not really reasonable. We only ;; care about `clim-stream-pane's, at least for Drei, currently. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 23:39:19 1.62 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/31 19:17:57 1.63 @@ -2,7 +2,7 @@
;;; (c) copyright 2001 by ;;; Tim Moore (moore@bricoworks.com) -;;; (c) copyright 2006 by +;;; (c) copyright 2006-2008 by ;;; Troels Henriksen (athas@sigkill.dk)
;;; This library is free software; you can redistribute it and/or @@ -219,18 +219,47 @@ (stream-scan-pointer ,stream-var)))) ,@body)))
+(defmacro with-input-editor-typeout ((&optional (stream t) &rest args + &key erase) + &body body) + "`Stream' is not evaluated and must be a symbol. If T (the +default), `*standard-input*' will be used. `Stream' will be bound +to an `extended-output-stream' while `body' is being evaluated." + (declare (ignore erase)) + (check-type stream symbol) + (let ((stream (if (eq stream t) '*standard-output* stream))) + `(invoke-with-input-editor-typeout + ,stream + #'(lambda (,stream) + ,@body) + ,@args))) + +(defun clear-typeout (&optional (stream t)) + "Blank out the input-editor typeout displayed on `stream', +defaulting to T for `*standard-output*'." + (with-input-editor-typeout (stream :erase t) + (declare (ignore stream)))) + (defun input-editing-rescan-loop (editing-stream continuation) (let ((start-scan-pointer (stream-scan-pointer editing-stream))) - (loop - (block rescan - (handler-bind ((rescan-condition - #'(lambda (c) - (reset-scan-pointer editing-stream start-scan-pointer) - ;; Input-editing contexts above may be interested... - (signal c) - (return-from rescan nil)))) - (return-from input-editing-rescan-loop - (funcall continuation editing-stream))))))) + (loop (block rescan + (handler-bind ((rescan-condition + #'(lambda (c) + (reset-scan-pointer editing-stream start-scan-pointer) + ;; Input-editing contexts above may be interested... + (signal c) + (return-from rescan nil)))) + (return-from input-editing-rescan-loop + (funcall continuation editing-stream))))))) + +(defgeneric finalize (editing-stream input-sensitizer) + (:documentation "Do any cleanup on an editing stream that is no +longer supposed to be used for editing, like turning off the +cursor, etc.")) + +(defmethod finalize ((stream input-editing-stream) input-sensitizer) + (clear-typeout stream) + (redraw-input-buffer stream))
(defgeneric invoke-with-input-editing (stream continuation input-sensitizer initial-contents class) @@ -254,6 +283,28 @@ (stream-default-view stream)))) (input-editing-rescan-loop stream continuation))
+(defmethod invoke-with-input-editing :around ((stream extended-output-stream) + continuation + input-sensitizer + initial-contents + class) + (declare (ignore continuation input-sensitizer initial-contents class)) + (letf (((cursor-visibility (stream-text-cursor stream)) nil)) + (call-next-method))) + +(defmethod invoke-with-input-editing :around (stream + continuation + input-sensitizer + initial-contents + class) + (declare (ignore continuation input-sensitizer initial-contents class)) + (with-activation-gestures (*standard-activation-gestures*) + (call-next-method))) + +(defgeneric invoke-with-input-editor-typeout (stream continuation &key erase) + (:documentation "Call `continuation' with a single argument, a +stream to do input-editor-typeout on.")) + (defgeneric input-editing-stream-bounding-rectangle (stream) (:documentation "Return the bounding rectangle of `stream' as four values. This function does not appear in the spec but is