Fix MouseWheel bindings for ttk::treeview widget

(Fixes #1442006, #1821939, #1862692)

2 files changed, 64 insertions, 18 deletions

diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl
index 3ccb746..a5ebcb2 100644
--- a/library/ttk/treeview.tcl
+++ b/library/ttk/treeview.tcl
@@ -1,4 +1,4 @@
-# $Id: treeview.tcl,v 1.2 2006/12/18 19:33:14 jenglish Exp $
+# $Id: treeview.tcl,v 1.3 2008/01/06 19:16:12 jenglish Exp $
 #
 # ttk::treeview widget bindings and utilities.
 #
@@ -56,13 +56,7 @@ bind Treeview	<Shift-ButtonPress-1> \
 bind Treeview	<Control-ButtonPress-1> \
 		{ ttk::treeview::Select %W %x %y toggle }
 
-# Standard mousewheel bindings:
-#
-bind Treeview <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units }
-if {[string equal "x11" [tk windowingsystem]]} {
-    bind Treeview <ButtonPress-4>	{ %W yview scroll -5 units }
-    bind Treeview <ButtonPress-5>	{ %W yview scroll 5 units }
-}
+ttk::copyBindings TtkScrollable Treeview 
 
 ### Binding procedures.
 #
@@ -163,7 +157,7 @@ proc ttk::treeview::Select {w x y op} {
     }
 }
 
-## DoubleClick -- Double-ButtonPress-1 binding.  
+## DoubleClick -- Double-ButtonPress-1 binding.
 #
 proc ttk::treeview::DoubleClick {w x y} {
     if {[set row [$w identify row $x $y]] ne ""} {
@@ -261,7 +255,7 @@ proc ttk::treeview::heading.release {w} {
 #
 
 ## SelectOp $w $item [ choose | extend | toggle ] --
-#	Dispatch to appropriate selection operation 
+#	Dispatch to appropriate selection operation
 #	depending on current value of -selectmode.
 #
 proc ttk::treeview::SelectOp {w item op} {
@@ -282,10 +276,10 @@ proc ttk::treeview::select.extend.browse {w item} { BrowseTo $w $item }
 
 ## -selectmode multiple:
 #
-proc ttk::treeview::select.choose.extended {w item} { 
+proc ttk::treeview::select.choose.extended {w item} {
     BrowseTo $w $item
 }
-proc ttk::treeview::select.toggle.extended {w item} { 
+proc ttk::treeview::select.toggle.extended {w item} {
     $w selection toggle $item
 }
 proc ttk::treeview::select.extend.extended {w item} {
@@ -304,7 +298,7 @@ proc ttk::treeview::select.extend.extended {w item} {
 #	in preorder traversal order.  $item1 and $item2 may be
 #	in either order.
 #
-# NOTES: 
+# NOTES:
 #	This routine is O(N) in the size of the tree.
 #	There's probably a way to do this that's O(N) in the number
 #	of items returned, but I'm not clever enough to figure it out.
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
index 1e277be..1de8ec8 100644
--- a/library/ttk/utils.tcl
+++ b/library/ttk/utils.tcl
@@ -1,5 +1,5 @@
 #
-# $Id: utils.tcl,v 1.5 2007/12/13 15:27:08 dgp Exp $
+# $Id: utils.tcl,v 1.6 2008/01/06 19:16:12 jenglish Exp $
 #
 # Utilities for widget implementations.
 #
@@ -48,7 +48,7 @@ proc ttk::clickToFocus {w} {
 #
 # See also: tk::FocusOK
 #
-# Note: This routine doesn't implement the same fallback heuristics 
+# Note: This routine doesn't implement the same fallback heuristics
 #	as tk::FocusOK.
 #
 proc ttk::takesFocus {w} {
@@ -78,8 +78,8 @@ proc ttk::takesFocus {w} {
 #
 
 proc ttk::focusFirst {w} {
-    if {[ttk::takesFocus $w]} { 
-	return $w 
+    if {[ttk::takesFocus $w]} {
+	return $w
     }
     foreach child [winfo children $w] {
 	if {[set c [ttk::focusFirst $child]] ne ""} {
@@ -239,7 +239,7 @@ proc ttk::CancelRepeat {} {
     after cancel $Repeat(timer)
 }
 
-### Miscellaneous.
+### Bindings.
 #
 
 ## ttk::copyBindings $from $to --
@@ -251,4 +251,56 @@ proc ttk::copyBindings {from to} {
     }
 }
 
+## Standard mousewheel bindings.
+#
+# Usage: [ttk::copyBindings TtkScrollable $bindtag]
+# adds mousewheel support to a scrollable widget.
+#
+# Platform inconsistencies:
+#
+# On X11, the server typically maps the mouse wheel to Button4 and Button5.
+#
+# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events.
+#
+# On Windows, %D must be scaled by a factor of 120.
+# In addition, Tk redirects mousewheel events to the window with
+# keyboard focus instead of sending them to the window under the pointer.
+# We do not attempt to fix that here, see also TIP#171.
+#
+# OSX conventionally uses Shift+MouseWheel for horizontal scrolling,
+# and Option+MouseWheel for accelerated scrolling.
+#
+# The Shift+MouseWheel behavior is not conventional on Windows or most
+# X11 toolkits, but it's useful.
+#
+# MouseWheel scrolling is accelerated on X11, which is conventional
+# for Tk and appears to be conventional for other toolkits (although
+# Gtk+ and Qt do not appear to use as large a factor).
+#
+
+switch -- [tk windowingsystem] {
+    x11 {
+	bind TtkScrollable <ButtonPress-4>       { %W yview scroll -5 units }
+	bind TtkScrollable <ButtonPress-5>       { %W yview scroll  5 units }
+	bind TtkScrollable <Shift-ButtonPress-4> { %W xview scroll -5 units }
+	bind TtkScrollable <Shift-ButtonPress-5> { %W xview scroll  5 units }
+    }
+    win32 {
+	bind TtkScrollable <MouseWheel> \
+	    { %W yview scroll [expr {-(%D/120)}] units }
+	bind TtkScrollable <Shift-MouseWheel> \
+	    { %W xview scroll [expr {-(%D/120)}] units }
+    }
+    aqua {
+	bind TtkScrollable <MouseWheel> \
+	    { %W yview scroll [expr {-(%D)}] units }
+	bind TtkScrollable <Shift-MouseWheel> \
+	    { %W xview scroll [expr {-(%D)}] units }
+	bind TtkScrollable <Option-MouseWheel> \
+	    { %W yview scroll  [expr {-10*(%D)}] units }
+	bind TtkScrollable <Shift-Option-MouseWheel> \
+	    { %W xview scroll [expr {-10*(%D)}] units }
+    }
+}
+
 #*EOF*