[mcclim-cvs] CVS mcclim
gbaumann
gbaumann at common-lisp.net
Sat Aug 1 16:10:32 UTC 2009
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)
More information about the Mcclim-cvs
mailing list