suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor to separate the two modes of flushing into their own separate pieces of code

Browse Source
This commit is contained in:
Robby Findler 2015-04-30 07:54:53 -05:00
parent e150651d8d
commit c33027cfea
1 changed files with 30 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
gui-lib/framework/private/text.rkt
View File

@ -2545,10 +2545,12 @@
;; output port synchronization code ;; output port synchronization code
;; ;;
;; flush-chan : (channel (evt void)) ;; the flush chans signal that the buffer-thread should flush pending output
;; signals that the buffer-thread should flush pending output ;; the diy variant just gets the data back and flushes it itself
;; the evt inside is waited on to indicate the flush has occurred ;; the other causes the thread that services all the events to flush
(define flush-chan (make-channel)) ;; the data via queue-callback
(define flush-chan/diy (make-channel))
(define flush-chan/queue (make-channel))
;; clear-output-chan : (channel void) ;; clear-output-chan : (channel void)
(define clear-output-chan (make-channel)) (define clear-output-chan (make-channel))
@ -2635,7 +2637,6 @@
(let loop (;; text-to-insert : (queue (cons (union snip bytes) style)) (let loop (;; text-to-insert : (queue (cons (union snip bytes) style))
[text-to-insert (empty-at-queue)] [text-to-insert (empty-at-queue)]
[last-flush (current-inexact-milliseconds)]) [last-flush (current-inexact-milliseconds)])
(sync (sync
(if (at-queue-empty? text-to-insert) (if (at-queue-empty? text-to-insert)
never-evt never-evt
@ -2649,7 +2650,7 @@
(queue-insertion viable-bytes always-evt) (queue-insertion viable-bytes always-evt)
(loop remaining-queue (current-inexact-milliseconds))))) (loop remaining-queue (current-inexact-milliseconds)))))
(handle-evt (handle-evt
flush-chan flush-chan/diy
(λ (return-evt/to-insert-chan) (λ (return-evt/to-insert-chan)
(define remaining-queue #f) (define remaining-queue #f)
(define viable-bytess (define viable-bytess
@ -2658,24 +2659,29 @@
(split-queue converter q)) (split-queue converter q))
(cond (cond
[flush-keep-trying? [flush-keep-trying?
(cond
[(channel? return-evt/to-insert-chan)
(cons viable-bytes (loop next-remaining-queue))] (cons viable-bytes (loop next-remaining-queue))]
[else [else
(set! remaining-queue next-remaining-queue)
(list viable-bytes)])))
(channel-put return-evt/to-insert-chan viable-bytess)
(loop remaining-queue (current-inexact-milliseconds))))
(handle-evt
flush-chan/queue
(λ (return-evt/to-insert-chan)
(define remaining-queue #f)
(let loop ([q text-to-insert])
(define-values (viable-bytes next-remaining-queue flush-keep-trying?)
(split-queue converter q))
(cond
[flush-keep-trying?
(define c (make-channel)) (define c (make-channel))
(queue-insertion viable-bytes c) (queue-insertion viable-bytes c)
(channel-put c #f) (channel-put c #f)
(loop next-remaining-queue)])] (loop next-remaining-queue)]
[else [else
(set! remaining-queue next-remaining-queue) (set! remaining-queue next-remaining-queue)
(cond
[(channel? return-evt/to-insert-chan)
(list viable-bytes)]
[else
(queue-insertion viable-bytes return-evt/to-insert-chan) (queue-insertion viable-bytes return-evt/to-insert-chan)
#f])]))) #f]))
(when (channel? return-evt/to-insert-chan)
(channel-put return-evt/to-insert-chan viable-bytess))
(loop remaining-queue (current-inexact-milliseconds)))) (loop remaining-queue (current-inexact-milliseconds))))
(handle-evt (handle-evt
clear-output-chan clear-output-chan
@ -2736,7 +2742,7 @@
(cond (cond
[(eq? (current-thread) (eventspace-handler-thread eventspace)) [(eq? (current-thread) (eventspace-handler-thread eventspace))
(define to-insert-channel (make-channel)) (define to-insert-channel (make-channel))
(thread (λ () (channel-put flush-chan to-insert-channel))) (thread (λ () (channel-put flush-chan/diy to-insert-channel)))
(for ([ele (in-list (channel-get to-insert-channel))]) (for ([ele (in-list (channel-get to-insert-channel))])
(do-insertion ele #f))] (do-insertion ele #f))]
[else [else
@ -2748,7 +2754,7 @@
(choice-evt (choice-evt
fail-channel fail-channel
(channel-put-evt return-channel (void)))]) (channel-put-evt return-channel (void)))])
(channel-put flush-chan return-evt) (channel-put flush-chan/queue return-evt)
return-channel))))])) return-channel))))]))
(define (out-close-proc) (define (out-close-proc)