Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv2833

Modified Files: frames.lisp incremental-redisplay.lisp package.lisp recording.lisp table-formatting.lisp text-selection.lisp Log Message: Use force-output instead of finish-output as the latter implies waiting for an answer from the display server, which is something we really do not want to do.

--- /project/mcclim/cvsroot/mcclim/frames.lisp 2009/02/28 16:49:40 1.136 +++ /project/mcclim/cvsroot/mcclim/frames.lisp 2009/08/01 16:10:31 1.137 @@ -466,62 +466,62 @@ (defmethod default-frame-top-level ((frame application-frame) &key (command-parser 'command-line-command-parser) - (command-unparser 'command-line-command-unparser) - (partial-command-parser - 'command-line-read-remaining-arguments-for-partial-command) - (prompt "Command: ")) + (command-unparser 'command-line-command-unparser) + (partial-command-parser + 'command-line-read-remaining-arguments-for-partial-command) + (prompt "Command: ")) ;; Give each pane a fresh start first time through. (let ((first-time t)) (loop ;; The variables are rebound each time through the loop because the ;; values of frame-standard-input et al. might be changed by a command. (let* ((*standard-input* (or (frame-standard-input frame) - *standard-input*)) - (*standard-output* (or (frame-standard-output frame) - *standard-output*)) - (query-io (frame-query-io frame)) - (*query-io* (or query-io *query-io*)) - (*pointer-documentation-output* - (frame-pointer-documentation-output frame)) - ;; during development, don't alter *error-output* - ;; (*error-output* (frame-error-output frame)) - (*command-parser* command-parser) - (*command-unparser* command-unparser) - (*partial-command-parser* partial-command-parser) - (interactorp (typep *query-io* 'interactor-pane))) - (restart-case - (progn - (redisplay-frame-panes frame :force-p first-time) - (setq first-time nil) - (if query-io + *standard-input*)) + (*standard-output* (or (frame-standard-output frame) + *standard-output*)) + (query-io (frame-query-io frame)) + (*query-io* (or query-io *query-io*)) + (*pointer-documentation-output* + (frame-pointer-documentation-output frame)) + ;; during development, don't alter *error-output* + ;; (*error-output* (frame-error-output frame)) + (*command-parser* command-parser) + (*command-unparser* command-unparser) + (*partial-command-parser* partial-command-parser) + (interactorp (typep *query-io* 'interactor-pane))) + (restart-case + (progn + (redisplay-frame-panes frame :force-p first-time) + (setq first-time nil) + (if query-io ;; For frames with an interactor: - (progn + (progn ;; Hide cursor, so we don't need to toggle it during ;; command output. - (setf (cursor-visibility (stream-text-cursor *query-io*)) - nil) - (when (and prompt interactorp) - (with-text-style (*query-io* +default-prompt-style+) - (if (stringp prompt) - (write-string prompt *query-io*) - (funcall prompt *query-io* frame)) - (finish-output *query-io*))) - (let ((command (read-frame-command frame - :stream *query-io*))) - (when interactorp - (fresh-line *query-io*)) - (when command - (execute-frame-command frame command)) - (when interactorp - (fresh-line *query-io*)))) + (setf (cursor-visibility (stream-text-cursor *query-io*)) + nil) + (when (and prompt interactorp) + (with-text-style (*query-io* +default-prompt-style+) + (if (stringp prompt) + (write-string prompt *query-io*) + (funcall prompt *query-io* frame)) + (force-output *query-io*))) + (let ((command (read-frame-command frame + :stream *query-io*))) + (when interactorp + (fresh-line *query-io*)) + (when command + (execute-frame-command frame command)) + (when interactorp + (fresh-line *query-io*)))) ;; Frames without an interactor: (let ((command (read-frame-command frame :stream nil))) (when command (execute-frame-command frame command))))) - (abort () - :report "Return to application command loop" - (if interactorp - (format *query-io* "~&Command aborted.~&") - (beep)))))))) + (abort () + :report "Return to application command loop" + (if interactorp + (format *query-io* "~&Command aborted.~&") + (beep))))))))

(defmethod read-frame-command :around ((frame application-frame) &key (stream *standard-input*)) --- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/09/25 00:30:01 1.65 +++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2009/08/01 16:10:32 1.66 @@ -513,7 +513,7 @@ (rectangle-edges* sub-record)))) record nil) - (finish-output stream) + (force-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. @@ -860,7 +860,7 @@ unique-id id-test cache-value cache-test &key (fixed-position nil) (all-new nil) (parent-cache nil)) - (finish-output stream) + (force-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)))) --- /project/mcclim/cvsroot/mcclim/package.lisp 2008/08/21 22:34:28 1.70 +++ /project/mcclim/cvsroot/mcclim/package.lisp 2009/08/01 16:10:32 1.71 @@ -234,7 +234,7 @@ nil))) packages) (progn (format t "~&there is no ~A." name) - (finish-output) + (force-output) nil))) (dump-defpackage (&aux imports export-ansi export-gray) (labels ((push-import-from (symbol package) @@ -255,7 +255,7 @@ (and sym2 (eq res :external)))) ;; (format t "~&;; ~S is patched." sym) - (finish-output) + (force-output) (push-import-from nam :clim-lisp-patch)) (t (setf sym (car sym)) --- /project/mcclim/cvsroot/mcclim/recording.lisp 2009/08/01 05:23:47 1.144 +++ /project/mcclim/cvsroot/mcclim/recording.lisp 2009/08/01 16:10:32 1.145 @@ -2292,7 +2292,7 @@ (letf (((stream-current-output-record stream) new-record)) ;; Should we switch on recording? -- APD (funcall continuation stream new-record) - (finish-output stream)) + (force-output stream)) (if parent (add-output-record new-record parent) (stream-add-output-record stream new-record)) @@ -2309,7 +2309,7 @@ (letf (((stream-current-output-record stream) new-record)) ;; Should we switch on recording? -- APD (funcall continuation stream new-record) - (finish-output stream)) + (force-output stream)) (if parent (add-output-record new-record parent) (stream-add-output-record stream new-record)) @@ -2325,7 +2325,7 @@ (letf (((stream-current-output-record stream) new-record) ((stream-cursor-position stream) (values 0 0))) (funcall continuation stream new-record) - (finish-output stream))) + (force-output stream))) new-record))

(defmethod invoke-with-output-to-output-record @@ -2337,7 +2337,7 @@ (letf (((stream-current-output-record stream) new-record) ((stream-cursor-position stream) (values 0 0))) (funcall continuation stream new-record) - (finish-output stream))) + (force-output stream))) new-record))

(defmethod make-design-from-output-record (record) --- /project/mcclim/cvsroot/mcclim/table-formatting.lisp 2008/11/09 19:58:26 1.41 +++ /project/mcclim/cvsroot/mcclim/table-formatting.lisp 2009/08/01 16:10:32 1.42 @@ -319,7 +319,7 @@ (let ((*table-suppress-update* t)) (with-output-recording-options (stream :record t :draw nil) (funcall continuation stream) - (finish-output stream)) + (force-output stream)) (with-output-recording-options (stream :record nil :draw nil) (adjust-table-cells table stream) (when multiple-columns (adjust-multiple-columns table stream)) @@ -427,7 +427,7 @@ (stream-cursor-position stream) (with-output-recording-options (stream :record t :draw nil) (funcall continuation stream) - (finish-output stream)) + (force-output stream)) (adjust-item-list-cells item-list stream) (setf (output-record-position item-list) (stream-cursor-position stream)) --- /project/mcclim/cvsroot/mcclim/text-selection.lisp 2009/06/03 20:33:16 1.8 +++ /project/mcclim/cvsroot/mcclim/text-selection.lisp 2009/08/01 16:10:32 1.9 @@ -289,7 +289,7 @@ (push (setf q (cons y nil)) *lines*)) (push (list x y string ts record full-record) (cdr q))) - (finish-output *trace-output*))) + (force-output *trace-output*))) (setf *lines* (sort (mapcar (lambda (line) (cons (car line)