Make mouse wheel handling similar across platforms without requiring
window focusing.
This is achieved by replacing on Windows bindings to MouseWheel with
bindings to virtual events MWheel. These events are sent to the windows
with the mouse pointer instead of to the ones with focus.
Signed-off-by: Cristian Stoica <cristi...@gmail.com>
---
ChangeLog | 6 ++++
tcl/end.tcl | 94 +++++++++++++++++++++++++++++++++++++++++++++----------
tcl/misc/misc.tcl | 8 ++---
3 files changed, 87 insertions(+), 21 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index d38cd43..5bcb5fc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1183,3 +1183,9 @@ scid-4.5.1
* Fix: Suppress 'Load Game Number' when no games are present
* Fix: Allow White to move against FICS puzzlebot
* Fix: Don't assess FICS unrated matches
+
+[June 2013]
+scid-4.5.1
+==========
+- Fixes :
+ * Fix: Platform consistent MouseWheel behavior without focus stealing
diff --git a/tcl/end.tcl b/tcl/end.tcl
index f330601..010bef2 100644
--- a/tcl/end.tcl
+++ b/tcl/end.tcl
@@ -1328,28 +1328,88 @@ bind $dot_w <Up> {
bind $dot_w <Down> {::move::Forward 10}
bind $dot_w <Right> ::move::Forward
bind $dot_w <End> ::move::End
-
bind $dot_w <period> {if {!$tree(refresh)} {toggleRotateBoard}}
-# MouseWheel in main window:
-bind .main <MouseWheel> {
- if {[expr -%D] < 0} { ::move::Back }
- if {[expr -%D] > 0} { ::move::Forward }
+proc MouseWheelRedirector {W X Y D} {
+ # Generate an MWheel virtual event to the window that has the mouse pointer
+ set w [winfo containing -displayof $W $X $Y]
+ # For virtual events we can't use the attribute "-delta" and we get away
+ # without a global variable by using instead "-data" which maps to %d
+ event generate $w <<MWheel>> -data $D -rootx $X -rooty $Y
}
-bind .main <Shift-MouseWheel> {
- if {[expr -%D] < 0} { ::move::Back 10 }
- if {[expr -%D] > 0} { ::move::Forward 10}
+
+proc ShiftMouseWheelRedirector {W X Y D} {
+ set w [winfo containing -displayof $W $X $Y]
+ event generate $w <<Shift-MWheel>> -data $D -rootx $X -rooty $Y
}
-if {! $windowsOS} {
- bind all <Button-4> {event generate [focus -displayof %W] <MouseWheel>
-delta 120}
- bind all <Button-5> {event generate [focus -displayof %W] <MouseWheel>
-delta -120}
- bind all <Shift-Button-4> {event generate [focus -displayof %W]
<Shift-MouseWheel> -delta 120}
- bind all <Shift-Button-5> {event generate [focus -displayof %W]
<Shift-MouseWheel> -delta -120}
- # bind $dot_w <Button-4> ::move::Back
- # bind $dot_w <Button-5> ::move::Forward
- # bind $dot_w <Shift-Button-4> {::move::Back 10}
- # bind $dot_w <Shift-Button-5> {::move::Forward 10}
+# MouseWheel bindings for consistent behavior across all platforms
+#
+# On Windows, redirect mouse wheel events to those windows that have the
+# mouse pointer:
+# - Disable completely MouseWheel handling for all used classes. No class or
+# window should listen to MouseWheel to avoid double firing
+# - Any window that receives a MouseWheel redirects these events as MWheel
+# to the window with the mouse pointer
+# - Rebind all classes and windows that handle mouse wheel to MWheel events.
+# Bind code is from TCL 8.5
+# On Linux and Macs this redirection is not necessary
+
+switch -- [tk windowingsystem] {
+ win32 {
+ # Disable MouseWheel handling
+ set mw_classes [list Text Listbox Treeview]
+ foreach class $mw_classes { bind $class <MouseWheel> {} }
+ # Transform MouseWheel events into MWheel
+ bind all <MouseWheel> { MouseWheelRedirector %W %X %Y %D }
+ bind all <Shift-MouseWheel> { ShiftMouseWheelRedirector %W %X %Y %D }
+ # Bind classes to MWheel
+ bind Listbox <<MWheel>> { %W yview scroll [expr {-(%d/120) * 4}] units}
+ bind Treeview <<MWheel>> { %W yview scroll [expr {-(%d/120)}] units }
+ bind Text <<MWheel>> {
+ if {%d >= 0} { %W yview scroll [expr {-%d/3}] pixels
+ } else { %W yview scroll [expr {(2-%d)/3}] pixels }
+ }
+ # Scroll the game with MWheel
+ bind .main <<MWheel>> {
+ if { %d > 0 } {
+ ::move::Back
+ } elseif { %d < 0 } {
+ ::move::Forward
+ }
+ }
+ bind .main <<Shift-MWheel>> {
+ if { %d > 0 } {
+ ::move::Back 10
+ } elseif { %d < 0 } {
+ ::move::Forward 10
+ }
+ }
+ }
+ x11 {
+ # Scroll the game with extended buttons
+ bind .main <Button-4> ::move::Back
+ bind .main <Button-5> ::move::Forward
+ bind .main <Shift-Button-4> {::move::Back 10}
+ bind .main <Shift-Button-5> {::move::Forward 10}
+ }
+ aqua {
+ # Scroll the game with MouseWheel
+ bind .main <MouseWheel> {
+ if { %D > 0 } {
+ ::move::Back
+ } elseif { %D < 0 } {
+ ::move::Forward
+ }
+ }
+ bind .main <Shift-MouseWheel> {
+ if { %D > 0 } {
+ ::move::Back 10
+ } elseif {%D < 0 } {
+ ::move::Forward 10
+ }
+ }
+ }
}
# Apply standard shortcuts to main window
diff --git a/tcl/misc/misc.tcl b/tcl/misc/misc.tcl
index 18c14ab..1149eed 100644
--- a/tcl/misc/misc.tcl
+++ b/tcl/misc/misc.tcl
@@ -52,14 +52,14 @@ proc bindFocusColors {w {inColor lightYellow} {outColor
white}} {
proc ttk_bindMouseWheel {bindtag callback} {
switch -- [tk windowingsystem] {
x11 {
- bind $bindtag <ButtonPress-4> "$callback -1; break"
- bind $bindtag <ButtonPress-5> "$callback +1; break"
+ bind $bindtag <ButtonPress-4> "$callback -1"
+ bind $bindtag <ButtonPress-5> "$callback +1"
}
win32 {
- bind $bindtag <MouseWheel> "[append callback { [expr
{-(%D/120)}]}]; break"
+ bind $bindtag <<MWheel>> [append callback { [expr {-(%d/120)}]}]
}
aqua {
- bind $bindtag <MouseWheel> "[append callback { [expr {-(%D)}]} ];
break"
+ bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ]
}
}
}
--
1.8.1.5
------------------------------------------------------------------------------
This SF.net email is sponsored by Windows:
Build for Windows Store.
http://p.sf.net/sfu/windows-dev2dev
_______________________________________________
Scid-users mailing list
Scid-users@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/scid-users
