try to throttle cocoa event dequeue for key & mouse events

collects/mred/private/wx/cocoa/const.rkt

@@ -18,6 +18,62 @@
 
 (define NSAnyEventMask #xffffffff)
 
+(define NSLeftMouseDown 1)
+(define NSLeftMouseUp 2)
+(define NSRightMouseDown 3)
+(define NSRightMouseUp 4)
+(define NSMouseMoved 5)
+(define NSLeftMouseDragged 6)
+(define NSRightMouseDragged 7)
+(define NSMouseEntered 8)
+(define NSMouseExited 9)
+(define NSKeyDown 10)
+(define NSKeyUp 11)
+(define NSFlagsChanged 12)
+(define NSAppKitDefined 13)
+(define NSSystemDefined 14)
+(define NSApplicationDefined 15)
+(define NSPeriodic 16)
+(define NSCursorUpdate 17)
+(define NSScrollWheel 22)
+(define NSTabletPoint 23)
+(define NSTabletProximity 24)
+(define NSOtherMouseDown 25)
+(define NSOtherMouseUp 26)
+(define NSOtherMouseDragged 27)
+(define NSEventTypeGesture 29)
+(define NSEventTypeMagnify 30)
+(define NSEventTypeSwipe 31)
+(define NSEventTypeRotate 18)
+(define NSEventTypeBeginGesture 19)
+(define NSEventTypeEndGesture 20)
+
+(define MouseAndKeyEventMask
+  (bitwise-ior
+   (1 . << . NSLeftMouseDown)
+   (1 . << . NSLeftMouseUp)
+   (1 . << . NSRightMouseDown)
+   (1 . << . NSRightMouseUp)
+   (1 . << . NSMouseMoved)
+   (1 . << . NSLeftMouseDragged)
+   (1 . << . NSRightMouseDragged)
+   (1 . << . NSMouseEntered)
+   (1 . << . NSMouseExited)
+   (1 . << . NSKeyDown)
+   (1 . << . NSKeyUp)
+   (1 . << . NSScrollWheel)
+   (1 . << . NSTabletPoint)
+   (1 . << . NSTabletProximity)
+   (1 . << . NSOtherMouseDown)
+   (1 . << . NSOtherMouseUp)
+   (1 . << . NSOtherMouseDragged)
+   (1 . << . NSEventTypeGesture)
+   (1 . << . NSEventTypeMagnify)
+   (1 . << . NSEventTypeSwipe)
+   (1 . << . NSEventTypeRotate)
+   (1 . << . NSEventTypeBeginGesture)
+   (1 . << . NSEventTypeEndGesture)))
+
 (define NSAlphaShiftKeyMask (1 . << . 16))
 (define NSShiftKeyMask (1 . << . 17))
 (define NSControlKeyMask (1 . << . 18))

collects/mred/private/wx/cocoa/queue.rkt

@@ -70,7 +70,6 @@
 ;;  ready to wake up
 
 (import-class NSEvent)
-(define NSApplicationDefined 15)
 (define wake-evt
   (tell NSEvent 
         otherEventWithType: #:type _int NSApplicationDefined
@@ -181,6 +180,8 @@
 (define events-suspended? #f)
 (define was-menu-bar #f)
 
+(define avoid-mouse-key-until #f)
+
 (define (check-menu-bar-click evt)
   (if (and evt 
            (= 14 (tell #:type _NSUInteger evt type))
@@ -217,10 +218,17 @@
     (when (and events-suspended? wait?)
       (set! was-menu-bar #f)
       (set! events-suspended? #f))
+    (when (and avoid-mouse-key-until
+               ((current-inexact-milliseconds) . > . avoid-mouse-key-until))
+      (set! avoid-mouse-key-until #f))
     (begin0
      (let ([evt (if events-suspended?
                     #f
-                    (tell app nextEventMatchingMask: #:type _NSUInteger NSAnyEventMask
+                    (tell app nextEventMatchingMask: #:type _NSUInteger (if (and (not wait?)
+                                                                                 avoid-mouse-key-until)
+                                                                            (- NSAnyEventMask
+                                                                               MouseAndKeyEventMask)
+                                                                            NSAnyEventMask)
                           untilDate: (if wait? distantFuture #f)
                           inMode: NSDefaultRunLoopMode
                           dequeue: #:type _BOOL dequeue?))])
@@ -229,7 +237,15 @@
             (or (not dequeue?)
                 (let ([e (eventspace-hook (tell evt window))])
                   (if e
-                      (begin
+                      (let ([mouse-or-key?
+                             (bitwise-bit-set? MouseAndKeyEventMask
+                                               (tell #:type _NSInteger evt type))])
+                        ;; If it's a mouse or key event, delay further
+                        ;;  dequeue of mouse and key events until this
+                        ;;  one can be handled.
+                        (when mouse-or-key?
+                          (set! avoid-mouse-key-until
+                                (+ (current-inexact-milliseconds) 200.0)))
                         (retain evt)
                         (queue-event e (lambda () 
                                          (call-as-nonatomic-retry-point
@@ -237,7 +253,9 @@
                                             ;; in atomic mode
                                             (with-autorelease
                                              (tellv app sendEvent: evt)
-                                             (release evt)))))))
+                                             (release evt))))
+                                         (when mouse-or-key?
+                                           (set! avoid-mouse-key-until #f)))))
                       (tellv app sendEvent: evt)))
                 #t)))
      (tellv pool release))))