Merge implementation of TIP #684.

doc/bind.n

@@ -173,11 +173,11 @@ types; where two names appear together, they are synonyms.
 \fBButton\fR, \fBButtonPress\fR	\fBEnter\fR	\fBMapRequest\fR
 \fBButtonRelease\fR	\fBExpose\fR	\fBMotion\fR
 \fBCirculate\fR	\fBFocusIn\fR	\fBMouseWheel\fR
-\fBCirculateRequest\fR	\fBFocusOut\fR	\fBProperty\fR
-\fBColormap\fR	\fBGravity\fR	\fBReparent\fR
-\fBConfigure\fR	\fBKey\fR, \fBKeyPress\fR	\fBResizeRequest\fR
-\fBConfigureRequest\fR	\fBKeyRelease\fR	\fBUnmap\fR
-\fBCreate\fR	\fBLeave\fR	\fBVisibility\fR
+\fBTouchpadScroll\fR	\fBCirculateRequest\fR	\fBFocusOut\fR
+\fBProperty\fR	\fBColormap\fR	\fBGravity\fR
+\fBReparent\fR	\fBConfigure\fR	\fBKey\fR, \fBKeyPress\fR
+\fBResizeRequest\fR	\fBConfigureRequest\fR	\fBKeyRelease\fR
+\fBUnmap\fR   \fBCreate\fR	\fBLeave\fR	\fBVisibility\fR
 \fBDeactivate\fR
 .DE
 Most of the above events have the same fields and behaviors as events
@@ -198,7 +198,7 @@ active.  Likewise, the \fBDeactive\fR event is sent when the window's
 state changes from active to deactive.  There are no useful percent
 substitutions you would make when binding to these events.
 .IP \fBMouseWheel\fR 5
-Many contemporary mice support a mouse wheel, which is used
+Many contemporary mice include a mouse wheel, which is used
 for scrolling documents without using the scrollbars.  By rolling the
 wheel, the system will generate \fBMouseWheel\fR events that the
 application can use to scroll.  The event is routed to the
@@ -212,12 +212,26 @@ values should scroll up and negative values should scroll down.
 .RS
 .PP
 Horizontal scrolling uses \fBShift-MouseWheel\fR events, with positive
-\fB%D\fR \fIdelta\fR substitution indicating left scrolling and negative
-right scrolling.
-Horizontal scrolling events may fire from
-many different hardware units such as tilt wheels or touchpads.  Horizontal
-scrolling can also be emulated by holding Shift and scrolling vertically.
+\fB%D\fR \fIdelta\fR substitution indicating left scrolling and
+negative right scrolling. Horizontal scrolling events are generated
+tilt wheels on some mice.  Horizontal scrolling can also be emulated
+by holding Shift and scrolling vertically.
 .RE
+.IP "\fBTouchpadScroll\fR" 5
+On some platforms (currently Windows and macOS) there is support for
+high-resolution scrolling devices, such as touchpads.  This is
+provided via \fBTouchpadScroll\fR events.  These events store two
+16 bit delta values in the integer provided by the \fB%D\fR
+substitution.  The \fIX\fR delta is in the high order 16 bits and the
+\fIY\fR delta is in the low order 16 bits.  These values can be
+unpacked by using the tk::PreciseScrollDeltas utility procedure.  For
+example:
+.CS
+lassign [tk::PreciseScrollDeltas %D] deltaX deltaY
+.CE
+The \fB$#\fR substitution is a counter for \fBTouchpadScroll\fR events
+which can be used by widgets that only support scrolling by units to
+ignore some portion of the events.
 .IP "\fBKeyPress\fR, \fBKeyRelease\fR" 5
 The \fBKeyPress\fR and \fBKeyRelease\fR events are generated
 whenever a key is pressed or released.  \fBKeyPress\fR and \fBKeyRelease\fR

generic/tk.h

@@ -670,8 +670,10 @@ typedef struct Tk_GeomMgr {
 #define ActivateNotify	    (MappingNotify + 2)
 #define DeactivateNotify    (MappingNotify + 3)
 #define MouseWheelEvent     (MappingNotify + 4)
-#define TK_LASTEVENT	    (MappingNotify + 5)
+#define TouchpadScroll      (MappingNotify + 5)
+#define TK_LASTEVENT	    (MappingNotify + 6)
 
+#define TouchpadScrollMask  (1L << 27)
 #define MouseWheelMask	    (1L << 28)
 #define ActivateMask	    (1L << 29)
 #define VirtualEventMask    (1L << 30)

generic/tkBind.c

@@ -528,6 +528,7 @@ static const EventInfo eventArray[] = {
     {"Activate",	ActivateNotify,		ActivateMask},
     {"Deactivate",	DeactivateNotify,	ActivateMask},
     {"MouseWheel",	MouseWheelEvent,	MouseWheelMask},
+    {"TouchpadScroll",  TouchpadScroll,         TouchpadScrollMask},
     {"CirculateRequest", CirculateRequest,	SubstructureRedirectMask},
     {"ConfigureRequest", ConfigureRequest,	SubstructureRedirectMask},
     {"Create",		CreateNotify,		SubstructureNotifyMask},
@@ -632,7 +633,8 @@ static const int flagArray[TK_LASTEVENT] = {
    /* VirtualEvent */		VIRTUAL,
    /* Activate */		ACTIVATE,
    /* Deactivate */		ACTIVATE,
-   /* MouseWheel */		WHEEL
+   /* MouseWheel */		WHEEL,
+   /* TouchpadScroll */		WHEEL
 };
 
 /*
@@ -5016,7 +5018,6 @@ ParseEventDescription(
 	    eventFlags = 0;
 	    if ((hPtr = Tcl_FindHashEntry(&eventTable, field))) {
 		const EventInfo *eiPtr = (const EventInfo *)Tcl_GetHashValue(hPtr);
-
 		patPtr->eventType = eiPtr->type;
 		eventFlags = flagArray[eiPtr->type];
 		eventMask = eiPtr->eventMask;
@@ -5091,7 +5092,6 @@ ParseEventDescription(
 	    } else if (patPtr->eventType == MotionNotify) {
 		patPtr->info = ButtonNumberFromState(patPtr->modMask);
 	    }
-
 	    p = SkipFieldDelims(p);
 
 	    if (*p != '>') {

generic/tkEvent.c

@@ -123,7 +123,8 @@ static const unsigned long eventMasks[TK_LASTEVENT] = {
     VirtualEventMask,			/* VirtualEvents */
     ActivateMask,			/* ActivateNotify */
     ActivateMask,			/* DeactivateNotify */
-    MouseWheelMask			/* MouseWheelEvent */
+    MouseWheelMask,			/* MouseWheelEvent */
+    TouchpadScrollMask			/* TouchpadScroll */
 };
 
 /*

library/demos/cscroll.tcl

@@ -17,16 +17,16 @@ 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
 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-]} {

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 \

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

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

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

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

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.

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;