diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 701221f32f..f7a149b0d8 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -163,8 +163,6 @@ (tellv cocoa setFocusState: #:type _BOOL on?) (tellv cocoa setNeedsDisplay: #:type _BOOL #t))) - (define is-visible? #f) - ;; Avoid multiple queued paints: (define paint-queued? #f) ;; To handle paint requests that happen while on-paint @@ -178,7 +176,7 @@ (set! paint-queued? #t) (queue-window-event this (lambda () (set! paint-queued? #f) - (when is-visible? + (when (is-shown-to-root?) (set! now-drawing? #t) (fix-dc) (on-paint) @@ -268,7 +266,6 @@ (define tr 0) (define/override (show on?) - (set! is-visible? on?) ;; FIXME: what if we're in the middle of an on-paint? (super show on?)) diff --git a/collects/mred/private/wx/cocoa/menu-bar.rkt b/collects/mred/private/wx/cocoa/menu-bar.rkt index aa35cc651f..fde29bc7a0 100644 --- a/collects/mred/private/wx/cocoa/menu-bar.rkt +++ b/collects/mred/private/wx/cocoa/menu-bar.rkt @@ -72,18 +72,20 @@ (tellv mb addItem: item) (tellv item release)))]) (let ([apple (tell (tell NSMenu alloc) initWithTitle: #:type _NSString "")]) - (let ([std (lambda (title sel [shortcut ""] [mods #f]) + (let ([std (lambda (title sel [shortcut ""] [mods #f] [delegate? #f]) (let ([item (tell (tell NSMenuItem alloc) initWithTitle: #:type _NSString title action: #:type _SEL sel keyEquivalent: #:type _NSString shortcut)]) (when mods (tellv item setKeyEquivalentModifierMask: #:type _NSInteger mods)) - (tellv item setTarget: app) + (tellv item setTarget: (if delegate? + (tell app delegate) + app)) (tellv apple addItem: item) (tellv item release)))]) (std (format "About ~a" app-name) (selector orderFrontStandardAboutPanel:)) - (std "Preferences..." (selector openPreferences:)) + (std "Preferences..." (selector openPreferences:) "," #f #t) (tellv apple addItem: (tell NSMenuItem separatorItem)) (let ([services (tell (tell NSMenu alloc) initWithTitle: #:type _NSString "Services")]) (tellv app setServicesMenu: services) diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index 0be2bbcf06..57b8fc683e 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -7,6 +7,7 @@ "const.rkt" "types.rkt" "../common/queue.rkt" + "../common/handlers.rkt" "../../lock.rkt" "../common/freeze.rkt") (unsafe!) @@ -37,8 +38,13 @@ (queue-quit-event) 0] [-a _BOOL (openPreferences: [_id app]) - (log-error "prefs") - #t]) + (queue-prefs-event) + #t] + [-a _BOOL (validateMenuItem: [_id menuItem]) + (if (ptr-equal? (selector openPreferences:) + (tell #:type _SEL menuItem action)) + (not (eq? (application-pref-handler) nothing-application-pref-handler)) + (super-tell #:type _BOOL validateMenuItem: menuItem))]) (tellv app finishLaunching) diff --git a/collects/mred/private/wx/common/event.rkt b/collects/mred/private/wx/common/event.rkt index 36ff6e7800..acfcf08544 100644 --- a/collects/mred/private/wx/common/event.rkt +++ b/collects/mred/private/wx/common/event.rkt @@ -91,8 +91,7 @@ (init-properties [[(symbol-in button check-box choice list-box list-box-dclick text-field text-field-enter slider radio-box - menu-popdown menu-popdown-none tab-panel - menu) + menu-popdown menu-popdown-none tab-panel) event-type] ;; FIXME: should have no default 'button]) diff --git a/collects/mred/private/wx/common/handlers.rkt b/collects/mred/private/wx/common/handlers.rkt index 3d8543ee62..e8048f0fff 100644 --- a/collects/mred/private/wx/common/handlers.rkt +++ b/collects/mred/private/wx/common/handlers.rkt @@ -3,26 +3,31 @@ (provide application-file-handler application-quit-handler application-about-handler - application-pref-handler) + application-pref-handler + + nothing-application-pref-handler) (define afh void) (define application-file-handler (case-lambda [(proc) (set! afh proc)] [() afh])) + (define aqh void) (define application-quit-handler (case-lambda [(proc) (set! aqh proc)] [() aqh])) + (define aah void) (define application-about-handler (case-lambda [(proc) (set! aah proc)] [() aah])) -(define aph void) + +(define (nothing-application-pref-handler) (void)) +(define aph nothing-application-pref-handler) (define application-pref-handler (case-lambda [(proc) (set! aph proc)] [() aph])) - diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt index c50a33712a..2cdbf09d9c 100644 --- a/collects/mred/private/wx/common/queue.rkt +++ b/collects/mred/private/wx/common/queue.rkt @@ -38,7 +38,8 @@ get-top-level-windows other-modal? - queue-quit-event) + queue-quit-event + queue-prefs-event) ;; ------------------------------------------------------------ ;; This module must be instantiated only once: @@ -348,3 +349,7 @@ (define (queue-quit-event) ;; called in event-pump thread (queue-event main-eventspace (application-quit-handler) 'med)) + +(define (queue-prefs-event) + ;; called in event-pump thread + (queue-event main-eventspace (application-pref-handler) 'med))