suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/gui: skip some redundant 'enter & 'leave events

Browse Source
This commit is contained in:
Matthew Flatt 2012-10-02 06:21:05 -06:00
parent d6a8ac85b4
commit a5d7812732
8 changed files with 37 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mred/private/mrtop.rkt
View File

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

4
collects/mred/private/wx/cocoa/window.rkt
View File

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

1
collects/mred/private/wx/gtk/frame.rkt
View File

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

11
collects/mred/private/wx/gtk/window.rkt
View File

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

10
collects/mred/private/wx/win32/window.rkt
View File

@ -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)
(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))))))))
(lambda () (dispatch-on-event/sync e)))))))))
(define/public (send-child-leaves mk)
#f)

5
collects/mred/private/wxlitem.rkt
View File

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

1
collects/mred/private/wxpanel.rkt
View File

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