From 6e08b009cb397fb963325392457860afc0504535 Mon Sep 17 00:00:00 2001 From: Sorawee Porncharoenwase Date: Fri, 23 Sep 2022 03:14:40 -0700 Subject: [PATCH] Cancel writing events after the Kill button is pressed When we press the kill button, make it so that queued up "do-insertion"s are not processed. This code is originally authored by @rfindler Fixes racket/racket#1677 and #444 --- gui-lib/framework/private/text-port.rkt | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/gui-lib/framework/private/text-port.rkt b/gui-lib/framework/private/text-port.rkt index b5f4c5fc7..2b47ca08a 100644 --- a/gui-lib/framework/private/text-port.rkt +++ b/gui-lib/framework/private/text-port.rkt @@ -290,7 +290,10 @@ (channel-put box-read-chan (cons eof (position->line-col-pos unread-start-point)))) (define/public-final (clear-input-port) (channel-put clear-input-chan (void))) (define/public-final (clear-box-input-port) (channel-put box-clear-input-chan (void))) - (define/public-final (clear-output-ports) + + (define output-ports-clear-count 0) + (define/public-final (clear-output-ports) + (set! output-ports-clear-count (add1 output-ports-clear-count)) (channel-put clear-output-chan (void)) (init-output-ports)) @@ -525,9 +528,11 @@ ;; thread: any thread, except the eventspace main thread (define/private (queue-insertion txts signal #:async? [async? #f]) (parameterize ([current-eventspace eventspace]) + (define current-clear-count output-ports-clear-count) (queue-callback (λ () - (do-insertion txts #f) + (when (= current-clear-count output-ports-clear-count) + (do-insertion txts #f)) (if async? (thread (λ () (sync signal))) (sync signal))) #f)))