diff --git a/collects/mred/private/wx/cocoa/const.rkt b/collects/mred/private/wx/cocoa/const.rkt index 82c37e0bab..f8a39c5d32 100644 --- a/collects/mred/private/wx/cocoa/const.rkt +++ b/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)) diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index 469e08d6a9..8633d1ec16 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/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))))