implement get-focus-window' and get-edit-target-window' in back end to avoid relying on `on-focus' callback handling

This commit is contained in:
Matthew Flatt 2010-12-28 05:23:15 -07:00
parent 54c337e5d3
commit 68e477fd52
5 changed files with 29 additions and 11 deletions

View File

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

View File

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

View File

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

View File

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

View File

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