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

gtk: fix button enable when mouse is over button

Browse Source 
original commit: 49903be78fb4b0d9ad297b2b792775bf1d9762d9
This commit is contained in:
Matthew Flatt 2011-04-15 16:54:22 -06:00
parent 2d275e014c
commit 2273e70c10
1 changed files with 76 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -300,72 +300,82 @@
(if crossing?
(GdkEventCrossing-type event)
(GdkEventButton-type event)))])
(unless (or (= type GDK_2BUTTON_PRESS)
(= type GDK_3BUTTON_PRESS))
(let ([wx (gtk->wx gtk)])
(and
wx
(let* ([modifiers (if motion?
(GdkEventMotion-state event)
(if crossing?
(GdkEventCrossing-state event)
(GdkEventButton-state event)))]
[bit? (lambda (m v) (positive? (bitwise-and m v)))]
[type (cond
[(= type GDK_MOTION_NOTIFY)
'motion]
[(= type GDK_ENTER_NOTIFY)
'enter]
[(= type GDK_LEAVE_NOTIFY)
'leave]
[(= type GDK_BUTTON_PRESS)
(case (GdkEventButton-button event)
[(1) 'left-down]
[(3) 'right-down]
[else 'middle-down])]
[else
(case (GdkEventButton-button event)
[(1) 'left-up]
[(3) 'right-up]
[else 'middle-up])])]
[m (new mouse-event%
[event-type type]
[left-down (case type
[(left-down) #t]
[(left-up) #f]
[else (bit? modifiers GDK_BUTTON1_MASK)])]
[middle-down (case type
[(middle-down) #t]
[(middle-up) #f]
[else (bit? modifiers GDK_BUTTON2_MASK)])]
[right-down (case type
[(right-down) #t]
[(right-up) #f]
[else (bit? modifiers GDK_BUTTON3_MASK)])]
[x (->long ((if motion?
GdkEventMotion-x
(if crossing? GdkEventCrossing-x GdkEventButton-x))
event))]
[y (->long ((if motion? GdkEventMotion-y
(if crossing? GdkEventCrossing-y GdkEventButton-y))
event))]
[shift-down (bit? modifiers GDK_SHIFT_MASK)]
[control-down (bit? modifiers GDK_CONTROL_MASK)]
[meta-down (bit? modifiers GDK_META_MASK)]
[alt-down (bit? modifiers GDK_MOD1_MASK)]
[time-stamp ((if motion? GdkEventMotion-time
(if crossing? GdkEventCrossing-time GdkEventButton-time))
event)]
[caps-down (bit? modifiers GDK_LOCK_MASK)])])
(if (send wx handles-events? gtk)
(begin
(queue-window-event wx (lambda ()
(send wx dispatch-on-event m #f)))
#t)
(constrained-reply (send wx get-eventspace)
(lambda () (or (send wx dispatch-on-event m #t)
(send wx internal-pre-on-event gtk m)))
#t))))))))
(let ([wx (gtk->wx gtk)])
(and
wx
(if (or (= type GDK_2BUTTON_PRESS)
(= type GDK_3BUTTON_PRESS))
#t
(let* ([modifiers (if motion?
(GdkEventMotion-state event)
(if crossing?
(GdkEventCrossing-state event)
(GdkEventButton-state event)))]
[bit? (lambda (m v) (positive? (bitwise-and m v)))]
[type (cond
[(= type GDK_MOTION_NOTIFY)
'motion]
[(= type GDK_ENTER_NOTIFY)
'enter]
[(= type GDK_LEAVE_NOTIFY)
'leave]
[(= type GDK_BUTTON_PRESS)
(case (GdkEventButton-button event)
[(1) 'left-down]
[(3) 'right-down]
[else 'middle-down])]
[else
(case (GdkEventButton-button event)
[(1) 'left-up]
[(3) 'right-up]
[else 'middle-up])])]
[m (new mouse-event%
[event-type type]
[left-down (case type
[(left-down) #t]
[(left-up) #f]
[else (bit? modifiers GDK_BUTTON1_MASK)])]
[middle-down (case type
[(middle-down) #t]
[(middle-up) #f]
[else (bit? modifiers GDK_BUTTON2_MASK)])]
[right-down (case type
[(right-down) #t]
[(right-up) #f]
[else (bit? modifiers GDK_BUTTON3_MASK)])]
[x (->long ((if motion?
GdkEventMotion-x
(if crossing? GdkEventCrossing-x GdkEventButton-x))
event))]
[y (->long ((if motion? GdkEventMotion-y
(if crossing? GdkEventCrossing-y GdkEventButton-y))
event))]
[shift-down (bit? modifiers GDK_SHIFT_MASK)]
[control-down (bit? modifiers GDK_CONTROL_MASK)]
[meta-down (bit? modifiers GDK_META_MASK)]
[alt-down (bit? modifiers GDK_MOD1_MASK)]
[time-stamp ((if motion? GdkEventMotion-time
(if crossing? GdkEventCrossing-time GdkEventButton-time))
event)]
[caps-down (bit? modifiers GDK_LOCK_MASK)])])
(if (send wx handles-events? gtk)
(begin
(queue-window-event wx (lambda ()
(send wx dispatch-on-event m #f)))
#t)
(constrained-reply (send wx get-eventspace)
(lambda () (or (send wx dispatch-on-event m #t)
(send wx internal-pre-on-event gtk m)))
#t
#:fail-result
;; an enter event is synthesized when a button is
;; enabled and the mouse is over the button, and the
;; event is not dispatched via the eventspace; leave
;; events are perhaps similarly synthesized, so allow
;; them, too
(if (or (eq? type 'enter) (eq? type 'leave))
#f
#t)))))))))
;; ----------------------------------------