diff --git a/collects/mred/private/wx/cocoa/menu-bar.rkt b/collects/mred/private/wx/cocoa/menu-bar.rkt index 60eb4bb8..68b09544 100644 --- a/collects/mred/private/wx/cocoa/menu-bar.rkt +++ b/collects/mred/private/wx/cocoa/menu-bar.rkt @@ -59,14 +59,7 @@ (and (<= x (NSPoint-x p) (+ x w)) (<= (- y h) (NSPoint-y p) y))))))) -(define suspend-menu-bar - (lambda (on?) - ;; We don't actually suspend anything, since the MrEd layer - ;; will drop events that shouldn't be delivered. - (void))) - -(set-menu-bar-hooks! in-menu-bar-range - suspend-menu-bar) +(set-menu-bar-hooks! in-menu-bar-range) ;; Init menu bar (let ([app (tell NSApplication sharedApplication)] diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index dddec0df..08f9b7f8 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -162,42 +162,47 @@ (define (set-front-hook! proc) (set! front-hook proc)) (define in-menu-bar-range? (lambda (p) #f)) -(define suspend-menu-bar (lambda (suspend?) (void))) -(define (set-menu-bar-hooks! r? s) - (set! in-menu-bar-range? r?) - (set! suspend-menu-bar s)) +(define (set-menu-bar-hooks! r?) + (set! in-menu-bar-range? r?)) (define events-suspended? #f) +(define was-menu-bar #f) (define (check-menu-bar-click evt) - (when (and evt - (= 14 (tell #:type _NSUInteger evt type)) - (= 7 (tell #:type _short evt subtype)) - (not (tell evt window)) - (in-menu-bar-range? (tell #:type _NSPoint evt locationInWindow))) - ;; Mouse down in the menu bar: - (let-values ([(f e) (front-hook)]) - (when e - ;; Don't handle further events until we've made an effort - ;; at on-demand notifications. - (set! events-suspended? #t) - (let ([t (thread (lambda () - (sleep 2) - ;; on-demand took too long, so disable the menu bar - ;; until the application can catch up - (suspend-menu-bar #t) - (set! events-suspended? #f)))]) - (queue-event e (lambda () - (send f on-menu-click) - (set! events-suspended? #f) - (kill-thread t)))))))) + (if (and evt + (= 14 (tell #:type _NSUInteger evt type)) + (= 7 (tell #:type _short evt subtype)) + (not (tell evt window)) + (in-menu-bar-range? (tell #:type _NSPoint evt locationInWindow))) + ;; Mouse down in the menu bar: + (let-values ([(f e) (front-hook)]) + (when e + ;; Avoid spiral of on-demand calls: + (unless (and was-menu-bar + (eq? e (weak-box-value was-menu-bar))) + ;; Don't handle further events until we've made an effort + ;; at on-demand notifications. + (set! was-menu-bar (make-weak-box e)) + (set! events-suspended? #t) + (let* ([c (make-custodian)] + [t (parameterize ([current-custodian c]) + (thread (lambda () + (sleep 2) + ;; on-demand took too long, so wait + ;; until the application can catch up + (set! events-suspended? #f))))]) + (queue-event e (lambda () + (send f on-menu-click) + (set! events-suspended? #f) + (custodian-shutdown-all c))))))) + (set! was-menu-bar #f))) ;; Call this function only in atomic mode: (define (check-one-event wait? dequeue?) (pre-event-sync wait?) (let ([pool (tell (tell NSAutoreleasePool alloc) init)]) (when (and events-suspended? wait?) - (suspend-menu-bar #t) + (set! was-menu-bar #f) (set! events-suspended? #f)) (begin0 (let ([evt (if events-suspended? diff --git a/collects/mred/private/wx/common/freeze.rkt b/collects/mred/private/wx/common/freeze.rkt index 2dabeb93..4c03a4c4 100644 --- a/collects/mred/private/wx/common/freeze.rkt +++ b/collects/mred/private/wx/common/freeze.rkt @@ -61,15 +61,14 @@ freeze-tag (lambda () default))) freeze-tag) - (void)))] - [old (scheme_set_on_atomic_timeout handler)]) + (void)))]) (with-holding handler (call-with-continuation-prompt ; to catch aborts (lambda () (call-with-continuation-prompt ; for composable continuation (lambda () - (set! prev old) + (set! prev (scheme_set_on_atomic_timeout handler)) (set! ready? #t) (begin0 (parameterize ([freezer-box #f])