diff --git a/collects/mred/private/mrtop.rkt b/collects/mred/private/mrtop.rkt index 26bb3820e9..9300f7d79a 100644 --- a/collects/mred/private/mrtop.rkt +++ b/collects/mred/private/mrtop.rkt @@ -122,9 +122,11 @@ (lambda (top-level hide-panel?) (set! mid-panel (make-object wx-vertical-panel% #f this top-level null #f)) (send mid-panel skip-subwindow-events? #t) + (send mid-panel skip-enter-leave-events #t) (send (send mid-panel area-parent) add-child mid-panel) (set! wx-panel (make-object wx-vertical-panel% #f this mid-panel null #f)) (send wx-panel skip-subwindow-events? #t) + (send wx-panel skip-enter-leave-events #t) (send (send wx-panel area-parent) add-child wx-panel) (send top-level set-container wx-panel) (when hide-panel? diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index ccebd61a7c..ed1b1dcdd0 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -578,6 +578,10 @@ ;; in atomic mode (void)) + (define skip-enter-leave? #f) + (define/public (skip-enter-leave-events skip?) + (set! skip-enter-leave? skip?)) + (define block-all-mouse-events? #f) (define/public (block-mouse-events block?) (set! block-all-mouse-events? block?)) diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index f592c25e57..e9fc5a56b5 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/collects/mred/private/wx/gtk/frame.rkt @@ -169,6 +169,7 @@ (values vbox-gtk panel-gtk)))) (gtk_widget_show vbox-gtk) (gtk_widget_show panel-gtk) + (connect-key-and-mouse gtk) (unless is-dialog? (gtk_window_set_icon_list gtk (cdr (force icon-pixbufs+glist)))) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index 42ba4b1465..87c0d0e66b 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -313,7 +313,10 @@ (and wx (if (or (= type GDK_2BUTTON_PRESS) - (= type GDK_3BUTTON_PRESS)) + (= type GDK_3BUTTON_PRESS) + (and (or (= type GDK_ENTER_NOTIFY) + (= type GDK_LEAVE_NOTIFY)) + (send wx skip-enter-leave-events))) #t (let* ([modifiers (if motion? (GdkEventMotion-state event) @@ -657,6 +660,12 @@ (define/public (on-char e) (void)) (define/public (on-event e) (void)) + (define skip-enter-leave? #f) + (define/public skip-enter-leave-events + (case-lambda + [(skip?) (set! skip-enter-leave? skip?)] + [else skip-enter-leave?])) + (define/public (register-child child on?) (void)) (define/public (register-child-in-parent on?) diff --git a/collects/mred/private/wx/win32/window.rkt b/collects/mred/private/wx/win32/window.rkt index 0b8e20fa19..d982b0bf6e 100644 --- a/collects/mred/private/wx/win32/window.rkt +++ b/collects/mred/private/wx/win32/window.rkt @@ -674,6 +674,10 @@ (lambda () (dispatch-on-event e #t)) #t))) + (define skip-enter-leave? #f) + (define/public (skip-enter-leave-events skip?) + (set! skip-enter-leave? skip?)) + (define mouse-in? #f) (define/public (generate-mouse-ins in-window mk) (if mouse-in? @@ -681,7 +685,8 @@ (begin (set! mouse-in? #t) (let ([parent-cursor (generate-parent-mouse-ins mk)]) - (handle-mouse-event (get-client-hwnd) 0 0 (mk 'enter)) + (unless skip-enter-leave? + (handle-mouse-event (get-client-hwnd) 0 0 (mk 'enter))) (let ([c (or cursor-handle parent-cursor)]) (set! effective-cursor-handle c) c))))) @@ -692,13 +697,14 @@ (define/public (send-leaves mk) (when mouse-in? (set! mouse-in? #f) - (when mk - (let ([e (mk 'leave)]) - (if (eq? (current-thread) - (eventspace-handler-thread eventspace)) - (handle-mouse-event (get-client-hwnd) 0 0 e) - (queue-window-event this - (lambda () (dispatch-on-event/sync e)))))))) + (unless skip-enter-leave? + (when mk + (let ([e (mk 'leave)]) + (if (eq? (current-thread) + (eventspace-handler-thread eventspace)) + (handle-mouse-event (get-client-hwnd) 0 0 e) + (queue-window-event this + (lambda () (dispatch-on-event/sync e))))))))) (define/public (send-child-leaves mk) #f) diff --git a/collects/mred/private/wxlitem.rkt b/collects/mred/private/wxlitem.rkt index 3bf4cb140b..fa55722ded 100644 --- a/collects/mred/private/wxlitem.rkt +++ b/collects/mred/private/wxlitem.rkt @@ -33,6 +33,7 @@ (send this alignment ha va) this) (let ([p (make-object wx-vertical-pane% #f proxy this null #f)]) + (send p skip-enter-leave-events #t) (send p skip-subwindow-events? #t) (send (send p area-parent) add-child p) (send p alignment ha va) @@ -41,6 +42,7 @@ (define (make-label label proxy p font) (and label (let ([l (make-object wx-message% #f proxy p label -1 -1 null font)]) + (send l skip-enter-leave-events #t) (send l skip-subwindow-events? #t) l))) @@ -57,7 +59,7 @@ (define wx-label-panel% (class wx-control-horizontal-panel% (init proxy parent label style font halign valign) - (inherit area-parent) + (inherit area-parent skip-enter-leave-events) (define c #f) (define/override (enable on?) (if c (send c enable on?) (void))) @@ -65,6 +67,7 @@ (define/override (is-window-enabled?) (if c (send c is-window-enabled?) #t)) (super-make-object #f proxy parent (if (memq 'deleted style) '(deleted) null) #f) + (skip-enter-leave-events #t) (unless (memq 'deleted style) (send (area-parent) add-child this)) (define horiz? (is-horiz? style parent)) diff --git a/collects/mred/private/wxpanel.rkt b/collects/mred/private/wxpanel.rkt index 704fa959e7..c7e279cf32 100644 --- a/collects/mred/private/wxpanel.rkt +++ b/collects/mred/private/wxpanel.rkt @@ -46,6 +46,7 @@ [get-client-size (lambda (wb hb) (when wb (set-box! wb width)) (when hb (set-box! hb height)))] + [skip-enter-leave-events (lambda (skip?) (void))] [set-size (lambda (x y w h) (unless (negative? x) (set! pos-x x)) (unless (negative? y) (set! pos-y y)) diff --git a/collects/mred/private/wxwindow.rkt b/collects/mred/private/wxwindow.rkt index 874449d49d..e4d0ef07ee 100644 --- a/collects/mred/private/wxwindow.rkt +++ b/collects/mred/private/wxwindow.rkt @@ -235,7 +235,7 @@ [pre-on-event (entry-point (lambda (w e) (if (skip-subwindow-events?) - #f + #f (pre-wx->proxy w e (lambda (m e) (as-exit (lambda ()