From 2273e70c10e4aa322c1ffa1e09b0c82776006d99 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 15 Apr 2011 16:54:22 -0600 Subject: [PATCH] gtk: fix button enable when mouse is over button original commit: 49903be78fb4b0d9ad297b2b792775bf1d9762d9 --- collects/mred/private/wx/gtk/window.rkt | 142 +++++++++++++----------- 1 file changed, 76 insertions(+), 66 deletions(-) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index 6c3fe37a..fa80128f 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -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))))))))) ;; ----------------------------------------