Add bindings for listbox and treeview. Some code clean up.

5 files changed, 30 insertions, 16 deletions

diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl
index 9b7f394..ed21310 100644
--- a/library/demos/cscroll.tcl
+++ b/library/demos/cscroll.tcl
@@ -111,7 +111,7 @@ if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk
     bind $c <TouchpadScroll> {
 	lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
 	if {$deltaX != 0 || $deltaY != 0} {
-	    tk::CanvasScrollByPixels %W $deltaX $deltaY
+	    tk::ScrollByPixels %W $deltaX $deltaY
 	}
     }
 }
diff --git a/library/demos/items.tcl b/library/demos/items.tcl
index be07916..335971b 100644
--- a/library/demos/items.tcl
+++ b/library/demos/items.tcl
@@ -37,7 +37,7 @@ ttk::scrollbar $w.frame.hscroll -orient horizontal -command "$c xview"
 bind $c <TouchpadScroll> {
     lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
     if {$deltaX != 0 || $deltaY != 0} {
-	tk::CanvasScrollByPixels %W $deltaX $deltaY
+	tk::ScrollByPixels %W $deltaX $deltaY
     }
 }
 
diff --git a/library/listbox.tcl b/library/listbox.tcl
index 32eea4b..ff3025f 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -188,13 +188,11 @@ bind Listbox <Shift-Option-MouseWheel> {
     tk::MouseWheel %W x %D -12.0 units
 }
 bind Listbox <TouchpadScroll> {
-    lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
-    if {$deltaX != 0} {
-	%W xview scroll [expr {-$deltaX}] units 
-    }
-    if {$deltaY != 0} {
-	%W yview scroll [expr {-$deltaY / 2.0}] units
+    if {[expr {%# %% 10}] != 0} {
+	return
     }
+    lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+    ::tk::ScrollByPixels %W $deltaX $deltaY
 }
 
 # ::tk::ListboxBeginSelect --
diff --git a/library/tk.tcl b/library/tk.tcl
index 1345fbf..656ad00 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -845,16 +845,18 @@ if {$::ttk::library ne ""} {
     uplevel \#0 [list source -encoding utf-8 $::ttk::library/ttk.tcl]
 }
 
-# Helper for smooth scrolling of Canvas widgets
-proc ::tk::CanvasScrollByPixels {canvas deltaX deltaY} {
-    set width [expr {1.0 * [$canvas cget -width]}]
-    set height [expr {1.0 * [$canvas cget -height]}]
-    set X [lindex [$canvas xview] 0]
-    set Y [lindex [$canvas yview] 0]
+# 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}]
-    $canvas xview moveto $x
-    $canvas yview moveto $y
+    $w xview moveto $x
+    $w yview moveto $y
 }
 
 
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
index c2c7e8f..32c119d 100644
--- a/library/ttk/utils.tcl
+++ b/library/ttk/utils.tcl
@@ -301,4 +301,18 @@ bind TtkScrollable <Shift-MouseWheel> \
 bind TtkScrollable <Shift-Option-MouseWheel> \
 	{ tk::MouseWheel %W x %D -12.0 }
 
+## Touchpad scrolling
+#
+bind TtkScrollable <TouchpadScroll> {
+    if {[expr {%# %% 4}] != 0} {
+        return
+    }
+    lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+    if {$deltaX != 0} {
+ 	%W xview scroll [expr {-$deltaX}] units 
+    }
+    if {$deltaY != 0} {
+	%W yview scroll [expr {-$deltaY}] units
+    }
+}
 #*EOF*