From 5c15ac736a8f2e8f3de83faaf95f69ef1761a814 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 26 Jan 2011 12:10:07 -0700
Subject: [PATCH] cocoa: better sync between Cocoa and Racket event queues  to
 reduce inversion where a low-priority callback runs  when a GUI event is
 available

original commit: 630dee7227fe437532edfeeda6e5c35f1bf8f7c0
---
 collects/mred/private/wx/cocoa/queue.rkt  |  5 +++++
 collects/mred/private/wx/common/queue.rkt | 11 +++++++++++
 2 files changed, 16 insertions(+)

diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt
index 97cb733b..b41049e3 100644
--- a/collects/mred/private/wx/cocoa/queue.rkt
+++ b/collects/mred/private/wx/cocoa/queue.rkt
@@ -369,6 +369,11 @@
   (atomically
    (pre-event-sync #t)))
 
+(set-platform-queue-sync!
+ (lambda ()
+   ;; in atomic mode
+   (dispatch-all-ready)))
+
 ;; ------------------------------------------------------------
 ;; Install an alternate "sleep" function (in the PLT Scheme core)
 ;; that wakes up if any Cocoa event is ready.
diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt
index 91a400ed..340dabd5 100644
--- a/collects/mred/private/wx/common/queue.rkt
+++ b/collects/mred/private/wx/common/queue.rkt
@@ -20,6 +20,7 @@
               pre-event-sync
               boundary-tasks-ready-evt
               sometimes-delay-msec
+              set-platform-queue-sync!
 
               eventspace?
               current-eventspace
@@ -203,6 +204,10 @@
       (send f destroy))
     (hash-remove! active-eventspaces (eventspace-handler-thread e))))
 
+(define platform-queue-sync void)
+(define (set-platform-queue-sync! proc)
+  (set! platform-queue-sync proc))
+
 (define (make-eventspace* th)
   (let ([done-sema (make-semaphore 1)]
         [done-set? #t]
@@ -294,6 +299,12 @@
                                                (timer-first-ready timer peek?)
                                                (first refresh peek?)
                                                (first med peek?)
+                                               (and (not peek?)
+                                                    ;; before going with low-priority events,
+                                                    ;; make sure we're sync'ed up with the
+                                                    ;; GUI platform's event queue:
+                                                    (platform-queue-sync)
+                                                    (first med peek?))
                                                (first lo peek?)
                                                (timer-first-wait timer peek?)
                                                ;; nothing else ready...