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