[mcclim-cvs] CVS mcclim/Drei

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv19045/Drei

Modified Files:
	input-editor.lisp 
Log Message:
Implemented generic input-editor typeout, provided we can get an
output record for the input editor.

Theoretically, the nice typeout implementation should now also work
for Goatee, though I seem to have broken it at some other point.


--- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp	2008/02/01 16:50:31	1.36
+++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp	2008/02/01 20:28:45	1.37
@@ -46,13 +46,7 @@
                         :initform nil
                         :documentation "After a command has been
 executed, the contents of the Drei area instance shall be
-replaced by the contents of this array, if non-NIL.")
-   (%typeout-record :accessor typeout-record
-                    :initform nil
-                    :documentation "The output record (if any)
-that is the typeout information for this Drei-based
-input-editing-stream. `With-input-editor-typeout' manages this
-output record."))
+replaced by the contents of this array, if non-NIL."))
   (:documentation "An mixin that helps in implementing Drei-based
 input-editing streams. This class should not be directly
 instantiated."))
@@ -754,73 +748,6 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
-;;; `With-input-editor-typeout'
-;;;
-;;; Clears some space above the input-editing stream, moving other
-;;; output records on the sheet down, and prints the output. Nothing
-;;; is displayed until after the with-input-editor-typeout body is
-;;; done.
-
-(defun sheet-move-output-vertically (sheet y delta-y)
-  "Move the output records of `sheet', starting at vertical
-device unit offset `y' or below, down by `delta-y' device units,
-then repaint `sheet'."
-  (unless (zerop delta-y)
-    (with-bounding-rectangle* (sheet-x1 sheet-y1 sheet-x2 sheet-y2) sheet
-      (declare (ignore sheet-x1 sheet-y1))
-      (map-over-output-records-overlapping-region
-       #'(lambda (record)
-           (multiple-value-bind (record-x record-y) (output-record-position record)
-             (when (>= (+ record-y (bounding-rectangle-height record)) y)
-               (setf (output-record-position record)
-                     (values record-x (+ record-y delta-y))))))
-       (stream-output-history sheet)
-       (make-bounding-rectangle 0 y sheet-x2 sheet-y2))
-      ;; Only repaint within the visible region...
-      (with-bounding-rectangle* (viewport-x1 viewport-y1 viewport-x2 viewport-y2)
-          (or (pane-viewport-region sheet) sheet)
-        (declare (ignore viewport-y1))
-        (repaint-sheet sheet (make-bounding-rectangle viewport-x1 (- y (abs delta-y))
-                                                      viewport-x2 viewport-y2))))))
-
-(defmethod climi::invoke-with-input-editor-typeout ((editing-stream drei-input-editing-mixin)
-                                                    (continuation function) &key erase)
-  (declare (ignore erase))
-  (let* ((encapsulated-stream (encapsulating-stream-stream editing-stream))
-         (new-typeout-record (with-output-to-output-record (encapsulated-stream)
-                               (funcall continuation encapsulated-stream)))
-         (editor-record (drei-instance editing-stream)))
-    (with-accessors ((stream-typeout-record typeout-record)) editing-stream
-      (with-sheet-medium (medium encapsulated-stream)
-        (setf (output-record-position new-typeout-record)
-              (values 0 (bounding-rectangle-min-y (or stream-typeout-record editor-record))))
-        ;; Calculate the height difference between the old typeout and the new.
-        (let ((delta-y (- (bounding-rectangle-height new-typeout-record)
-                          (if stream-typeout-record
-                              (bounding-rectangle-height stream-typeout-record)
-                              0))))
-          (multiple-value-bind (typeout-x typeout-y)
-              (output-record-position new-typeout-record)
-            (declare (ignore typeout-x))
-            ;; Clear the old typeout.
-            (when stream-typeout-record
-              (clear-output-record stream-typeout-record))
-            (sheet-move-output-vertically encapsulated-stream typeout-y delta-y)
-            ;; Reuse the old stream-typeout-record, if any.
-            (cond (stream-typeout-record
-                   (add-output-record new-typeout-record stream-typeout-record))
-                  (t
-                   (stream-add-output-record encapsulated-stream new-typeout-record)
-                   (setf stream-typeout-record new-typeout-record)))
-            ;; Now, let there be light!
-            (with-bounding-rectangle* (x1 y1 x2 y2) stream-typeout-record
-              (declare (ignore x2))
-              (repaint-sheet encapsulated-stream
-                             (make-bounding-rectangle
-                              x1 y1 (bounding-rectangle-width encapsulated-stream) y2)))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 
 ;;; Presentation type specialization.
 
 ;;; When starting out with reading `command-or-form', we use Lisp