From 262531e23121a4a11b5e683923a961712d003b10 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 28 Nov 2010 07:46:36 -0700 Subject: [PATCH] cocoa: fix enable & disable of windows --- collects/mred/private/wx/cocoa/canvas.rkt | 14 +++++++++++++- collects/mred/private/wx/cocoa/frame.rkt | 7 ++++++- collects/mred/private/wx/cocoa/item.rkt | 10 +++++----- collects/mred/private/wx/cocoa/panel.rkt | 8 +++++++- collects/mred/private/wx/cocoa/tab-panel.rkt | 16 +++++++++++++++- collects/mred/private/wx/cocoa/window.rkt | 16 ++++++++++++---- 6 files changed, 58 insertions(+), 13 deletions(-) diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 34f80512e4..551eed0d95 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -234,6 +234,9 @@ make-graphics-context is-shown-to-root? is-shown-to-before-root? + is-enabled-to-root? + is-window-enabled? + block-mouse-events move get-x get-y on-size register-as-child @@ -608,6 +611,15 @@ (scroller-page scroller) 1)])) + (define/override (enable-window on?) + (let ([on? (and on? (is-window-enabled?))]) + (let ([w (tell content-cocoa window)]) + (when (ptr-equal? content-cocoa (tell w firstResponder)) + (tellv w makeFirstResponder: #f))) + (block-mouse-events (not on?)) + (when is-combo? + (tellv content-cocoa setEnabled: #:type _BOOL on?)))) + (define/public (clear-combo-items) (tellv content-cocoa removeAllItems)) (define/public (append-combo-item str) @@ -698,7 +710,7 @@ (define/override (gets-focus?) wants-focus?) (define/override (can-be-responder?) - wants-focus?) + (and wants-focus? (is-enabled-to-root?))) (define/private (on-menu-click? e) ;; Called in Cocoa event-handling mode diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index eb2053c75c..ffe008e466 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -141,7 +141,8 @@ get-eventspace pre-on-char pre-on-event get-x - on-new-child) + on-new-child + is-window-enabled?) (super-new [parent parent] [cocoa @@ -333,6 +334,10 @@ (when saved-child (send saved-child child-accept-drag on?))) + (define/override (enable-window on?) + (when saved-child + (send saved-child enable-window (and on? (is-window-enabled?))))) + (define/override (is-shown?) (tell #:type _bool cocoa isVisible)) diff --git a/collects/mred/private/wx/cocoa/item.rkt b/collects/mred/private/wx/cocoa/item.rkt index e04a375195..2ff73fa109 100644 --- a/collects/mred/private/wx/cocoa/item.rkt +++ b/collects/mred/private/wx/cocoa/item.rkt @@ -29,16 +29,16 @@ (tellv cocoa setFont: sys-font))) (defclass item% window% - (inherit get-cocoa) + (inherit get-cocoa + is-window-enabled?) (init-field callback) (define/public (get-cocoa-control) (get-cocoa)) - (define/override (enable on?) - (tellv (get-cocoa-control) setEnabled: #:type _BOOL on?)) - (define/override (is-window-enabled?) - (tell #:type _BOOL (get-cocoa-control) isEnabled)) + (define/override (enable-window on?) + (let ([on? (and on? (is-window-enabled?))]) + (tellv (get-cocoa-control) setEnabled: #:type _BOOL on?))) (define/override (gets-focus?) (tell #:type _BOOL (get-cocoa-control) canBecomeKeyView)) diff --git a/collects/mred/private/wx/cocoa/panel.rkt b/collects/mred/private/wx/cocoa/panel.rkt index 6d57fecc04..85864672ae 100644 --- a/collects/mred/private/wx/cocoa/panel.rkt +++ b/collects/mred/private/wx/cocoa/panel.rkt @@ -19,7 +19,8 @@ (define (panel-mixin %) (class % - (inherit register-as-child on-new-child) + (inherit register-as-child on-new-child + is-window-enabled?) (define lbl-pos 'horizontal) (define children null) @@ -52,6 +53,11 @@ (define/override (children-accept-drag on?) (for ([child (in-list children)]) (send child child-accept-drag on?))) + + (define/override (enable-window on?) + (let ([on? (and on? (is-window-enabled?))]) + (for ([child (in-list children)]) + (send child enable-window on?)))) (define/override (set-size x y w h) (super set-size x y w h) diff --git a/collects/mred/private/wx/cocoa/tab-panel.rkt b/collects/mred/private/wx/cocoa/tab-panel.rkt index d67e669e69..6b11d595df 100644 --- a/collects/mred/private/wx/cocoa/tab-panel.rkt +++ b/collects/mred/private/wx/cocoa/tab-panel.rkt @@ -23,6 +23,9 @@ (void (ffi-lib (build-path psm-tab-bar-dir "PSMTabBarControl"))) (define NSNoTabsNoBorder 6) +(define NSDefaultControlTint 0) +(define NSClearControlTint 7) + (import-class NSView NSTabView NSTabViewItem PSMTabBarControl) (import-protocol NSTabViewDelegate) @@ -44,7 +47,9 @@ x y w h style labels) - (inherit get-cocoa register-as-child) + (inherit get-cocoa register-as-child + is-window-enabled? + block-mouse-events) (define tabv-cocoa (as-objc-allocation (tell (tell MyTabView alloc) init))) @@ -154,6 +159,15 @@ (when control-cocoa (set-ivar! control-cocoa wxb (->wxb this))) + (define/override (enable-window on?) + (super enable-window on?) + (let ([on? (and on? (is-window-enabled?))]) + (block-mouse-events (not on?)) + (tellv tabv-cocoa setControlTint: #:type _int + (if on? NSDefaultControlTint NSClearControlTint)) + (when control-cocoa + (tellv control-cocoa setEnabled: #:type _BOOL on?)))) + (define/override (maybe-register-as-child parent on?) (register-as-child parent on?))) diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index 11ae6cda57..0c37a04e5f 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -520,7 +520,14 @@ (define/public (is-window-enabled?) enabled?) (define/public (enable on?) - (set! enabled? on?)) + (set! enabled? on?) + (enable-window on?)) + (define/public (enable-window on?) + (void)) + + (define block-all-mouse-events? #f) + (define/public (block-mouse-events block?) + (set! block-all-mouse-events? block?)) (define/private (get-frame) (let ([v (tell #:type _NSRect cocoa frame)]) @@ -621,7 +628,8 @@ (accept-drags-everywhere (or accept-drag? accept-parent-drag?)))) (define/public (set-focus) - (when (gets-focus?) + (when (and (gets-focus?) + (is-enabled-to-root?)) (let ([w (tell cocoa window)]) (when w (tellv w makeFirstResponder: (get-cocoa-content)))))) @@ -664,7 +672,7 @@ (cond [(other-modal? this) #t] [(call-pre-on-event this e) #t] - [just-pre? #f] + [just-pre? block-all-mouse-events?] [else (when enabled? (on-event e)) #t])) (define/public (call-pre-on-event w e) @@ -773,7 +781,7 @@ (define/public (get-cursor-width-delta) 0) (define/public (gets-focus?) #f) - (define/public (can-be-responder?) #t) + (define/public (can-be-responder?) (is-enabled-to-root?)) (define/public (on-color-change) (send parent on-color-change))