gitk: fix trackpad scrolling for Tcl/Tk 8.7+

TIP 684 [1] introduced TouchpadScroll events in Tcl/Tk 8.7, separating
trackpad gestures from traditional MouseWheel events. This broke
trackpad scrolling in gitk where trackpads generate TouchpadScroll
events instead of MouseWheel events.

Fix that by adding TouchpadScroll event bindings for all scrollable
widgets following the TIP 684 specification. Implement a new
precisescrollval proc to handle the smaller delta values from
TouchpadScroll events, using appropriate scaling factors that seem
sensible on my MacBook.

Fixes https://github.com/j6t/gitk/issues/31.

[1]: https://core.tcl-lang.org/tips/doc/main/tip/684.md

Signed-off-by: Ruoyu Zhong <zhongruoyu@outlook.com>

diff --git a/gitk b/gitk
index 2e1b629d7dca503042229621e5de87d813f75b31..6e4d71d5852533687dd7165d8605008036118df7 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -2301,6 +2301,11 @@ proc scrollval {D {koff 0}} {
     return [expr int(-($D / $scroll_D0) * max(1, $kscroll-$koff))]
 }
 
+proc precisescrollval {D {koff 0}} {
+    global kscroll
+    return [expr (-($D / 10.0) * max(1, $kscroll-$koff))]
+}
+
 proc bind_mousewheel {} {
     global canv cflist ctext
     bindall <MouseWheel> {allcanvs yview scroll [scrollval %D] units}
@@ -2319,6 +2324,25 @@ proc bind_mousewheel {} {
         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}
+
+        bindall <TouchpadScroll> {
+            lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+            allcanvs yview scroll [precisescrollval $deltaY] units
+        }
+        bind $ctext <TouchpadScroll> {
+            lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+            $ctext yview scroll [precisescrollval $deltaY 2] units
+            $ctext xview scroll [precisescrollval $deltaX 2] units
+        }
+        bind $cflist <TouchpadScroll> {
+            lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+            $cflist yview scroll [precisescrollval $deltaY 2] units
+        }
+        bind $canv <TouchpadScroll> {
+            lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+            $canv xview scroll [precisescrollval $deltaX] units
+            allcanvs yview scroll [precisescrollval $deltaY] units
+        }
     }
 }