gitk: update scrolling for TclTk 8.7+ / TIP 474

TclTk 8.7 (still in alpha), and 9.0 (released), implement TIP 474 that
delivers uniform handling of mouse and touchpad scrolling events on all
platforms, and by default bound to most widgets. TIP 474 also implements
use of the Option- modifier key (Alt- key on PC, Option- key on Macs) to
indicate desire for more motion per scroll wheel event, the
amplification is not defined but seems to be 5x to 10x.

So, for TclTk >= 8.7 we can use identical MouseWheel bindings on all
platforms, and should enable use of the Option- modifier to enable
larger motion. Let's do all of this, and use a 5x multiplier for the
Option- modifier.

This largely follows the prior win32 model, except that Tk 8.6 does not
reliably use the Option- modifier because the Alt- key conflicts with
builtin behavior to activate the main menubar. Presumably this conflict
is addressed in the win32 Tcl9.x package.

Signed-off-by: Mark Levedahl <mlevedahl@gmail.com>

diff --git a/gitk b/gitk
index ba112586bed7e025f55c6ae9ee4f7e2492052900..700d5d152d5ec2f9f169c75b409b80a35aecd145 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -2273,6 +2273,16 @@ proc bind_mousewheel {} {
     bind $cflist <MouseWheel> {$cflist yview scroll [scrollval %D 2] units}
     bind $cflist <Shift-MouseWheel> break
     bind $canv <Shift-MouseWheel> {$canv xview scroll [scrollval %D] units}
+
+    if {[package vcompare $::tcl_version 8.7] >= 0} {
+        bindall <Alt-MouseWheel> {allcanvs yview scroll [scrollval 5*%D] units}
+        bindall <Alt-Shift-MouseWheel> break
+        bind $ctext <Alt-MouseWheel> {$ctext yview scroll [scrollval 5*%D 2] units}
+        bind $ctext <Alt-Shift-MouseWheel> {$ctext xview scroll [scrollval 5*%D 2] units}
+        bind $cflist <Alt-MouseWheel> {$cflist yview scroll [scrollval 5*%D 2] units}
+        bind $cflist <Alt-Shift-MouseWheel> break
+        bind $canv <Alt-Shift-MouseWheel> {$canv xview scroll [scrollval 5*%D] units}
+    }
 }
 
 proc bind_mousewheel_buttons {} {
@@ -2732,7 +2742,7 @@ proc makewindow {} {
     bindall <1> {selcanvline %W %x %y}
 
     #Mouse / touchpad scrolling
-    if {[tk windowingsystem] == "win32"} {
+    if {[tk windowingsystem] == "win32" || [package vcompare $::tcl_version 8.7] >= 0} {
         set scroll_D0 120
         bind_mousewheel
     } elseif {[tk windowingsystem] == "x11"} {