Merge branch 'tk87-touchpad-scroll' of github.com:ZhongRuoyu/gitk

* 'tk87-touchpad-scroll' of github.com:ZhongRuoyu/gitk:
  gitk: fix trackpad scrolling for Tcl/Tk 8.7+

Signed-off-by: Johannes Sixt <j6t@kdbg.org>
main^2
Johannes Sixt 2025-08-27 20:52:35 +02:00
commit 3fbbbe27ea
1 changed files with 24 additions and 0 deletions

24
gitk
View File

@ -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
}
}
}