Merge implementation of TIP #684.

11 files changed, 174 insertions, 16 deletions

diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl
index eea0e2e..ed21310 100644
--- a/library/demos/cscroll.tcl
+++ b/library/demos/cscroll.tcl
@@ -17,7 +17,7 @@ wm iconname $w "cscroll"
 positionWindow $w
 set c $w.c
 
-label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas.  If you click button 1 on one of the rectangles, its indices will be printed on stdout."
+label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled by using the scrollbars, by dragging with button 2 in the canvas, by using a mouse wheel, or with the two-finger gesture on a touchpad.  If you click button 1 on one of the rectangles, its indices will be printed on stdout."
 pack $w.msg -side top
 
 ## See Code / Dismiss buttons
@@ -25,8 +25,8 @@ set btns [addSeeDismiss $w.buttons $w]
 pack $btns -side bottom -fill x
 
 frame $w.grid
-ttk::scrollbar $w.hscroll -orient horizontal -command "$c xview"
-ttk::scrollbar $w.vscroll -command "$c yview"
+scrollbar $w.hscroll -orient horizontal -command "$c xview"
+scrollbar $w.vscroll -command "$c yview"
 canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \
 	-xscrollcommand "$w.hscroll set" \
 	-yscrollcommand "$w.vscroll set"
@@ -108,6 +108,12 @@ if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk
 	    %W xview scroll [expr {(%D-2)/-3}] units
 	}
     }
+    bind $c <TouchpadScroll> {
+	lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+	if {$deltaX != 0 || $deltaY != 0} {
+	    tk::ScrollByPixels %W $deltaX $deltaY
+	}
+    }
 }
 
 if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} {
diff --git a/library/demos/items.tcl b/library/demos/items.tcl
index 5f51a90..335971b 100644
--- a/library/demos/items.tcl
+++ b/library/demos/items.tcl
@@ -34,6 +34,13 @@ canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \
 ttk::scrollbar $w.frame.vscroll -command "$c yview"
 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::ScrollByPixels %W $deltaX $deltaY
+    }
+}
+
 grid $c -in $w.frame \
     -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
 grid $w.frame.vscroll \
diff --git a/library/listbox.tcl b/library/listbox.tcl
index f0009bf..a27ae1e 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -175,18 +175,29 @@ bind Listbox <Button-2> {
 bind Listbox <B2-Motion> {
     %W scan dragto %x %y
 }
-
 bind Listbox <MouseWheel> {
-    tk::MouseWheel %W y %D -40.0
+    tk::MouseWheel %W y %D -40.0 units
 }
 bind Listbox <Option-MouseWheel> {
-    tk::MouseWheel %W y %D -12.0
+    tk::MouseWheel %W y %D -12.0 units
 }
 bind Listbox <Shift-MouseWheel> {
-    tk::MouseWheel %W x %D -40.0
+    tk::MouseWheel %W x %D -40.0 units
 }
 bind Listbox <Shift-Option-MouseWheel> {
-    tk::MouseWheel %W x %D -12.0
+    tk::MouseWheel %W x %D -12.0 units
+}
+bind Listbox <TouchpadScroll> {
+    if {[expr {%# %% 15}] != 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
+    }
 }
 
 # ::tk::ListboxBeginSelect --
diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl
index 35ff251..283b7a2 100644
--- a/library/scrlbar.tcl
+++ b/library/scrlbar.tcl
@@ -144,6 +144,15 @@ bind Scrollbar <Shift-MouseWheel> {
 bind Scrollbar <Shift-Option-MouseWheel> {
     tk::ScrollByUnits %W hv %D -12.0
 }
+bind Scrollbar <TouchpadScroll> {
+    lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+    if {$deltaX != 0 && [%W cget -orient] eq "horizontal"} {
+	tk::ScrollbarScrollByPixels %W h $deltaX
+    }
+    if {$deltaY != 0 && [%W cget -orient] eq "vertical"} {
+	tk::ScrollbarScrollByPixels %W v $deltaY
+    }
+}
 
 # tk::ScrollButtonDown --
 # This procedure is invoked when a button is pressed in a scrollbar.
@@ -304,6 +313,49 @@ proc ::tk::ScrollEndDrag {w x y} {
     set Priv(initPos) ""
 }
 
+# ::tk::ScrollbarScrollByPixels --
+# This procedure tells the scrollbar's associated widget to scroll up
+# or down by a given number of pixels.  It only works with scrollbars
+# because it uses the delta command.
+#
+# Arguments:
+# w -		The scrollbar widget.
+# orient -	Which kind of scrollbar this applies to: "h" for
+#		horizontal, "v" for vertical.
+# amount -	How many pixels to scroll.
+
+proc ::tk::ScrollbarScrollByPixels {w orient amount} {
+    set cmd [$w cget -command]
+    if {$cmd eq ""} {
+	return
+    }
+    set xyview [lindex [split $cmd] end]
+    if {$orient eq "v"} {
+	if {$xyview eq "xview"} {
+	    return
+	}
+	set size [winfo height $w]
+    }
+    if {$orient eq "h"} {
+	if {$xyview eq "yview"} {
+	    return
+	}
+	set size [winfo width $w]
+    }
+
+    # The code below works with both the current and old syntax for
+    # the scrollbar get command.
+
+    set info [$w get]
+    if {[llength $info] == 2} {
+	set first [lindex $info 0]
+    } else {
+	set first [lindex $info 2]
+    }
+    set pixels [expr {-$amount}]
+    uplevel #0 $cmd moveto [expr $first + [$w delta $pixels $pixels]]
+}
+
 # ::tk::ScrollByUnits --
 # This procedure tells the scrollbar's associated widget to scroll up
 # or down by a given number of units.  It notifies the associated widget
diff --git a/library/text.tcl b/library/text.tcl
index e5a4c11..caa2844 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -468,6 +468,15 @@ bind Text <Shift-MouseWheel> {
 bind Text <Shift-Option-MouseWheel> {
     tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels
 }
+bind Text <TouchpadScroll> {
+    lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+    if {$deltaX != 0} {
+	%W xview scroll [tk::ScaleNum [expr {-$deltaX}]] pixels
+    }
+    if {$deltaY != 0} {
+	%W yview scroll [tk::ScaleNum [expr {-$deltaY}]] pixels
+    }
+}
 
 # ::tk::TextClosestGap --
 # Given x and y coordinates, this procedure finds the closest boundary
diff --git a/library/tk.tcl b/library/tk.tcl
index a6dc37c..656ad00 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -549,6 +549,13 @@ proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} {
     $w ${dir}view scroll [expr {$amount/$factor}] $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]
+}
 
 # ::tk::TabToWindow --
 # This procedure moves the focus to the given widget.
@@ -837,6 +844,21 @@ if {[tk windowingsystem] eq "x11"} {
 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
index 9756376..c253eb0 100644
--- a/library/ttk/combobox.tcl
+++ b/library/ttk/combobox.tcl
@@ -56,7 +56,13 @@ ttk::bindMouseWheel TCombobox		{ ttk::combobox::Scroll %W }
 bind TCombobox <Shift-MouseWheel> {
     # Ignore the event
 }
-
+bind TCombobox <TouchpadScroll> {
+    lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+    # TouchpadScroll events fire about 60 times per second.
+    if {$deltaY != 0 && [expr {%# %% 15}] == 0} {
+	ttk::combobox::Scroll %W [expr {$deltaY > 0 ? -1 : 1}]
+    }
+}
 bind TCombobox <<TraverseIn>> 		{ ttk::combobox::TraverseIn %W }
 
 ### Combobox listbox bindings.
diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl
index d8ed23b..7fb0ad5 100644
--- a/library/ttk/notebook.tcl
+++ b/library/ttk/notebook.tcl
@@ -20,16 +20,22 @@ bind TNotebook <Enter> {
     set tk::Priv(xEvents) 0; set tk::Priv(yEvents) 0
 }
 bind TNotebook <MouseWheel> {
-    ttk::notebook::CondCycleTab %W y %D -120.0
+    ttk::notebook::CondCycleTab1 %W y %D -120.0
 }
 bind TNotebook <Option-MouseWheel> {
-    ttk::notebook::CondCycleTab %W y %D -12.0
+    ttk::notebook::CondCycleTab1 %W y %D -12.0
 }
 bind TNotebook <Shift-MouseWheel> {
-    ttk::notebook::CondCycleTab %W x %D -120.0
+    ttk::notebook::CondCycleTab1 %W x %D -120.0
 }
 bind TNotebook <Shift-Option-MouseWheel> {
-    ttk::notebook::CondCycleTab %W x %D -12.0
+    ttk::notebook::CondCycleTab1 %W x %D -12.0
+}
+bind TNotebook <TouchpadScroll> {
+    # TouchpadScroll events fire about 60 times per second.
+    if {[expr {%# %% 30}] == 0} {
+	ttk::notebook::CondCycleTab2 %W %D
+    }
 }
 
 # ActivateTab $nb $tab --
@@ -89,10 +95,10 @@ proc ttk::notebook::CycleTab {w dir {factor 1.0}} {
     }
 }
 
-# CondCycleTab --
+# CondCycleTab1 --
 #	Conditionally invoke the ttk::notebook::CycleTab proc.
 #
-proc ttk::notebook::CondCycleTab {w axis dir {factor 1.0}} {
+proc ttk::notebook::CondCycleTab1 {w axis dir {factor 1.0}} {
     # Count both the <MouseWheel> and <Shift-MouseWheel>
     # events, and ignore the non-dominant ones
 
@@ -107,6 +113,23 @@ proc ttk::notebook::CondCycleTab {w axis dir {factor 1.0}} {
     CycleTab $w $dir $factor
 }
 
+# CondCycleTab2 --
+#	Conditionally invoke the ttk::notebook::CycleTab proc.
+#
+proc ttk::notebook::CondCycleTab2 {w dxdy} {
+    if {[set style [$w cget -style]] eq ""} {
+	set style TNotebook
+    }
+    set tabSide [string index [ttk::style lookup $style -tabposition {} nw] 0]
+
+    lassign [tk::PreciseScrollDeltas $dxdy] deltaX deltaY
+    if {$tabSide in {n s} && $deltaX != 0} {
+	CycleTab $w [expr {$deltaX < 0 ? -1 : 1}]
+    } elseif {$tabSide in {w e} && $deltaY != 0} {
+	CycleTab $w [expr {$deltaY < 0 ? -1 : 1}]
+    }
+}
+
 # MnemonicTab $nb $key --
 #	Scan all tabs in the specified notebook for one with the
 #	specified mnemonic. If found, returns path name of tab;
diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl
index 4f73f1f..7c31511 100644
--- a/library/ttk/scrollbar.tcl
+++ b/library/ttk/scrollbar.tcl
@@ -23,7 +23,8 @@ bind TScrollbar <Enter> {
     set tk::Priv(xEvents) 0; set tk::Priv(yEvents) 0
 }
 foreach event {<MouseWheel> <Option-MouseWheel>
-	       <Shift-MouseWheel> <Shift-Option-MouseWheel>} {
+	       <Shift-MouseWheel> <Shift-Option-MouseWheel>
+	       <TouchpadScroll>} {
     bind TScrollbar $event [bind Scrollbar $event]
 }
 unset event
diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl
index 5aca894..0160d35 100644
--- a/library/ttk/spinbox.tcl
+++ b/library/ttk/spinbox.tcl
@@ -27,6 +27,13 @@ ttk::bindMouseWheel TSpinbox 		{ ttk::spinbox::Spin %W }
 bind TSpinbox <Shift-MouseWheel> {
     # Ignore the event
 }
+bind TSpinbox <TouchpadScroll> {
+    lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+    # TouchpadScroll events fire about 60 times per second.
+    if {$deltaY != 0 && [expr {%# %% 12}] == 0} {
+	ttk::spinbox::Spin %W [expr {$deltaY > 0 ? -1 : 1}]
+    }
+}
 
 ## Motion --
 #	Sets cursor.
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
index c2c7e8f..ea7dc72 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 {%# %% 15}] != 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*