Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv1478
Modified Files: incremental-redisplay.lisp Log Message:
Add explicit calls to FINISH-OUTPUT in COMPUTE-NEW-OUTPUT-RECORDS and INVOKE-UPDATING-OUTPUT. The current text record was being put in different subtrees when a new updating output record was created and when an existing one was found and reused.
Date: Tue Jan 18 01:16:32 2005 Author: tmoore
Index: mcclim/incremental-redisplay.lisp diff -u mcclim/incremental-redisplay.lisp:1.41 mcclim/incremental-redisplay.lisp:1.42 --- mcclim/incremental-redisplay.lisp:1.41 Tue Jan 11 05:35:18 2005 +++ mcclim/incremental-redisplay.lisp Tue Jan 18 01:16:30 2005 @@ -353,9 +353,6 @@ (fixed-position :reader output-record-fixed-position :initarg :fixed-position :initform nil) (displayer :reader output-record-displayer :initarg :displayer) - (sub-record :accessor sub-record - :documentation "The actual contents of this record. All output -record operations are forwarded to this record.") ;; Start and end cursor (start-graphics-state :accessor start-graphics-state :initarg :start-graphics-state @@ -511,12 +508,18 @@ (setf (output-record-dirty r) :updating)) record nil) + (finish-output stream) + ;; Why is this binding here? We need the "environment" in this call that + ;; computes the new records of an outer updating output record to resemble + ;; that when a record's contents are computed in invoke-updating-output. (letf (((stream-current-output-record stream) (output-record-parent record))) (compute-new-output-records-1 record stream (output-record-displayer record)))))
+;;; Create the sub-record that holds the new contents of the updating output +;;; record. (defun %invoke-updating (record stream displayer) (letf (((stream-current-output-record stream) record)) (with-new-output-record (stream) @@ -838,6 +841,7 @@ (parent-cache nil)) (unless *enable-updating-output* (return-from invoke-updating-output (funcall continuation stream))) + (finish-output stream) (let ((parent-cache (or parent-cache *current-updating-output* stream))) (when (eq unique-id *no-unique-id*) (setq unique-id (incf (id-counter parent-cache))))