[mcclim-cvs] CVS mcclim

[thenriksen]

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 at bricoworks.com)
-;;;  (c) copyright 2006 by
+;;;  (c) copyright 2006-2008 by
 ;;;           Troels Henriksen (athas at sigkill.dk)
 
 ;;; This library is free software; you can redistribute it and/or
@@ -219,18 +219,47 @@
 					   (stream-scan-pointer ,stream-var))))
        , at 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)
+          , at body)
+      , at 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