admin/git
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gitk: fix trackpad scrolling for Tcl/Tk 8.7+

Browse Source 
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>
This commit is contained in:
Ruoyu Zhong
2025-08-27 10:12:19 +08:00
parent be1829c0fd
commit 432669914b
1 changed files with 24 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
gitk
View File

@@ -2301,6 +2301,11 @@ proc scrollval {D {koff 0}} {
return [expr int(-($D / $scroll_D0) * max(1, $kscroll-$koff))] 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 {} { proc bind_mousewheel {} {
global canv cflist ctext global canv cflist ctext
bindall <MouseWheel> {allcanvs yview scroll [scrollval %D] units} 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-MouseWheel> {$cflist yview scroll [scrollval 5*%D 2] units}
bind $cflist <Alt-Shift-MouseWheel> break bind $cflist <Alt-Shift-MouseWheel> break
bind $canv <Alt-Shift-MouseWheel> {$canv xview scroll [scrollval 5*%D] units} 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
}
} }
} }