diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index d3ba10cb9c..525dc73f50 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -379,6 +379,13 @@ (when is-main? (do-notify-responder wx on?)))) + (define/public (get-focus-window [even-if-not-active? #f]) + (let ([f-cocoa (tell cocoa firstResponder)]) + (and f-cocoa + (or even-if-not-active? + (tell #:type _BOOL cocoa isKeyWindow)) + (->wx (get-ivar f-cocoa wxb))))) + (define/public (install-wait-cursor) (when (positive? (eventspace-wait-cursor-count (get-eventspace))) (tellv (get-wait-cursor-handle) set))) diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index 994ab5f2d2..33a57505c0 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/collects/mred/private/wx/gtk/frame.rkt @@ -49,6 +49,7 @@ (define-gtk gtk_window_set_gravity (_fun _GtkWindow _int -> _void)) (define-gtk gtk_window_set_icon_list (_fun _GtkWindow _GList -> _void)) (define-gtk gtk_window_fullscreen (_fun _GtkWindow -> _void)) +(define-gtk gtk_window_get_focus (_fun _GtkWindow -> _GtkWidget)) (define-gtk gtk_window_resize (_fun _GtkWidget _int _int -> _void)) @@ -376,6 +377,14 @@ (unless (eq? on? reported-activate) (set! reported-activate on?) (on-activate on?))))))) + + (define/public (get-focus-window [even-if-not-active? #f]) + (let ([f-gtk (gtk_window_get_focus gtk)]) + (and f-gtk + (or even-if-not-active? + (positive? (bitwise-and (get-gtk-object-flags f-gtk) + GTK_HAS_FOCUS))) + (gtk->wx f-gtk)))) (define/override (call-pre-on-event w e) (pre-on-event w e)) diff --git a/collects/mred/private/wx/win32/frame.rkt b/collects/mred/private/wx/win32/frame.rkt index c6c0a5296e..ef423fa38b 100644 --- a/collects/mred/private/wx/win32/frame.rkt +++ b/collects/mred/private/wx/win32/frame.rkt @@ -296,6 +296,12 @@ (when (pair? focus-window-path) (SetFocus (send (last focus-window-path) get-focus-hwnd)))) + (define/public (get-focus-window [even-if-not-active? #f]) + (and focus-window-path + (or even-if-not-active? + (ptr-equal? hwnd (GetActiveWindow))) + (last focus-window-path))) + (define/override (can-accept-focus?) #f) (define/override (child-can-accept-focus?) diff --git a/collects/mred/private/wx/win32/window.rkt b/collects/mred/private/wx/win32/window.rkt index 50eb6483ab..874db53c0f 100644 --- a/collects/mred/private/wx/win32/window.rkt +++ b/collects/mred/private/wx/win32/window.rkt @@ -143,6 +143,7 @@ 0 (cond [(= msg WM_SETFOCUS) + (set-top-focus this null w) (queue-window-event this (lambda () (on-set-focus))) 0] [(= msg WM_KILLFOCUS) diff --git a/collects/mred/private/wxtop.rkt b/collects/mred/private/wxtop.rkt index c1fd3e71a6..022cf962bd 100644 --- a/collects/mred/private/wxtop.rkt +++ b/collects/mred/private/wxtop.rkt @@ -70,7 +70,7 @@ (class100 (wx-make-container% (wx-make-window% base% #t)) (parent . args) (inherit get-x get-y get-width get-height set-size get-client-size is-shown? on-close enforce-size - get-eventspace) + get-eventspace get-focus-window) (private-field ;; have we had any redraw requests while the window has been ;; hidden? @@ -94,7 +94,6 @@ [enabled? #t] [focus #f] - [target #f] [border-buttons null] @@ -132,21 +131,17 @@ (eq? b w)))))) border-buttons) (when (w . is-a? . wx:button%) - (send w defaulting #t))))) - (set! focus w) - (when w - (set! target w)))] + (send w defaulting #t)))) + (set! focus w)))] - [get-focus-window - (lambda () focus)] [get-edit-target-window - (lambda () (and target (send (wx->proxy target) is-shown?) target))] + (lambda () (get-focus-window #t))] [get-focus-object (lambda () - (window->focus-object focus))] + (window->focus-object (get-focus-window)))] [get-edit-target-object (lambda () - (window->focus-object target))] + (window->focus-object (get-focus-window #t)))] [window->focus-object (lambda (w)