suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more repairs to constrained-reply and menu-bar handling

Browse Source 
original commit: 238650e3270706715af4abc43639ffa5a98e188e
This commit is contained in:
Matthew Flatt 2010-07-24 18:33:36 -05:00
parent b2de1b0624
commit 97fc56d722
3 changed files with 34 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/mred/private/wx/cocoa/menu-bar.rkt
View File

@ -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)]

57
collects/mred/private/wx/cocoa/queue.rkt
View File

@ -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?

5
collects/mred/private/wx/common/freeze.rkt
View File

@ -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])