cocoa: fix enable & disable of windows

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

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

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

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)
@@ -53,6 +54,11 @@
       (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)
       (fix-dc))

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

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