(cherry-pick): Made the scrolling by units via <TouchpadScroll> smoot…

…her.
tcltk · Dec 12, 2023 · d72326e · d72326e
1 parent 8587ab4
commit d72326e
Show file tree

Hide file tree

Showing 6 changed files with 20 additions and 19 deletions.
diff --git a/library/listbox.tcl b/library/listbox.tcl
@@ -188,7 +188,7 @@ bind Listbox <Shift-Option-MouseWheel> {
     tk::MouseWheel %W x %D -12.0 units
 }
 bind Listbox <TouchpadScroll> {
-    if {[expr {%# %% 15}] != 0} {
+    if {%# %% 5 != 0} {
 	return
     }
     lassign [tk::PreciseScrollDeltas %D] deltaX deltaY

diff --git a/library/tk.tcl b/library/tk.tcl
@@ -550,13 +550,28 @@ proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} {
 }
 
 ## ::tk::PreciseScrollDeltas $dxdy
+
 proc ::tk::PreciseScrollDeltas {dxdy} {
     set deltaX [expr {$dxdy >> 16}]
     set low [expr {$dxdy & 0xffff}]
     set deltaY [expr {$low < 0x8000 ? $low : $low - 0x10000}]
     return [list $deltaX $deltaY]
 }
 
+# Helper for smooth scrolling of widgets that support xview moveto,
+# yview moveto, height and width.
+
+proc ::tk::ScrollByPixels {w deltaX deltaY} {
+    set width [expr {1.0 * [$w cget -width]}]
+    set height [expr {1.0 * [$w cget -height]}]
+    set X [lindex [$w xview] 0]
+    set Y [lindex [$w yview] 0]
+    set x [expr {$X - $deltaX / $width}]
+    set y [expr {$Y - $deltaY / $height}]
+    $w xview moveto $x
+    $w yview moveto $y
+}
+
 # ::tk::TabToWindow --
 # This procedure moves the focus to the given widget.
 # It sends a <<TraverseOut>> virtual event to the previous focus window,
@@ -845,20 +860,6 @@ if {$::ttk::library ne ""} {
     uplevel \#0 [list source -encoding utf-8 $::ttk::library/ttk.tcl]
 }
 
-# Helper for smooth scrolling of widgets that support xview moveto,
-# yview moveto, height and width.
-
-proc ::tk::ScrollByPixels {w deltaX deltaY} {
-    set width [expr {1.0 * [$w cget -width]}]
-    set height [expr {1.0 * [$w cget -height]}]
-    set X [lindex [$w xview] 0]
-    set Y [lindex [$w yview] 0]
-    set x [expr {$X - $deltaX / $width}]
-    set y [expr {$Y - $deltaY / $height}]
-    $w xview moveto $x
-    $w yview moveto $y
-}
-
 
 # Local Variables:
 # mode: tcl

diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl
@@ -59,7 +59,7 @@ bind TCombobox <Shift-MouseWheel> {
 bind TCombobox <TouchpadScroll> {
     lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
     # TouchpadScroll events fire about 60 times per second.
-    if {$deltaY != 0 && [expr {%# %% 15}] == 0} {
+    if {$deltaY != 0 && %# %% 15 == 0} {
 	ttk::combobox::Scroll %W [expr {$deltaY > 0 ? -1 : 1}]
     }
 }

diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl
@@ -33,7 +33,7 @@ bind TNotebook <Shift-Option-MouseWheel> {
 }
 bind TNotebook <TouchpadScroll> {
     # TouchpadScroll events fire about 60 times per second.
-    if {[expr {%# %% 30}] == 0} {
+    if {%# %% 15 == 0} {
 	ttk::notebook::CondCycleTab2 %W %D
     }
 }

diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl
@@ -30,7 +30,7 @@ bind TSpinbox <Shift-MouseWheel> {
 bind TSpinbox <TouchpadScroll> {
     lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
     # TouchpadScroll events fire about 60 times per second.
-    if {$deltaY != 0 && [expr {%# %% 12}] == 0} {
+    if {$deltaY != 0 && %# %% 12 == 0} {
 	ttk::spinbox::Spin %W [expr {$deltaY > 0 ? -1 : 1}]
     }
 }

diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
@@ -304,7 +304,7 @@ bind TtkScrollable <Shift-Option-MouseWheel> \
 ## Touchpad scrolling
 #
 bind TtkScrollable <TouchpadScroll> {
-    if {[expr {%# %% 15}] != 0} {
+    if {%# %% 5 != 0} {
         return
     }
     lassign [tk::PreciseScrollDeltas %D] deltaX deltaY