diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/button.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/button.rkt index 1983c9d568..494729e71c 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/button.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/button.rkt @@ -42,7 +42,7 @@ [button-type #f]) (init-field [event-type 'button]) (inherit get-cocoa get-cocoa-window init-font - register-as-child) + register-as-child get-wx-window) (define button-cocoa (let ([cocoa @@ -154,7 +154,22 @@ (define default-button? (memq 'border style)) (define/override (show-children) (when default-button? - (tellv (get-cocoa-window) setDefaultButtonCell: (tell button-cocoa cell)))) + (send (get-wx-window) add-possible-default this))) + (define/override (hide-children) + (when default-button? + (send (get-wx-window) remove-possible-default this))) + + (define/override (enable-window on?) + (super enable-window on?) + (when default-button? + (send (get-wx-window) queue-default-button-check))) + + (define/public (be-default) ; called by frame, only when the button is shown + ;; return #t to indicate succes, #f to let some other button take over + (and (tell #:type _BOOL button-cocoa isEnabled) + (begin + (tellv (get-cocoa-window) setDefaultButtonCell: (tell button-cocoa cell)) + #t))) (tellv button-cocoa setTarget: button-cocoa) (tellv button-cocoa setAction: #:type _SEL (selector clicked:)) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/frame.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/frame.rkt index 51a9fba56f..1c04a237b7 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/frame.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/frame.rkt @@ -596,6 +596,28 @@ (define/public (set-icon bm1 [bm2 #f] [mode 'both]) (void)) ;; FIXME + (define default-buttons (make-hasheq)) + (define checking-default? #f) + (define/public (add-possible-default button) + (hash-set! default-buttons button #t) + (queue-default-button-check)) + (define/public (remove-possible-default button) + (hash-remove! default-buttons button) + (queue-default-button-check)) + (define/public (queue-default-button-check) + (when (atomically + (if checking-default? + #f + (begin + (set! checking-default? #t) + #t))) + (queue-window-event + this + (lambda () + (set! checking-default? #f) + (for/or ([button (in-hash-keys default-buttons)]) + (send button be-default)))))) + (define/override (call-pre-on-event w e) (pre-on-event w e)) (define/override (call-pre-on-char w e)