Refactor all MouseWheel bindings, doing it the same way everywhere. So <MouseWheel> bindings are there on all platforms, (Button-4|5) only on X11.

Also add bindings for vertical scrolling for iconlist, as suggested by Max Augsburg. 
(still to be tested on X11 and MacOS)

6 files changed, 119 insertions, 74 deletions

diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl
index f6e88f4..f9b6b2b 100644
--- a/library/demos/cscroll.tcl
+++ b/library/demos/cscroll.tcl
@@ -60,19 +60,54 @@ bind $c <2> "$c scan mark %x %y"
 bind $c <B2-Motion> "$c scan dragto %x %y"
 if {[tk windowingsystem] eq "aqua"} {
     bind $c <MouseWheel> {
-        %W yview scroll [expr {- (%D)}] units
+	%W yview scroll [expr {-(%D)}] units
     }
     bind $c <Option-MouseWheel> {
-        %W yview scroll [expr {-10 * (%D)}] units
+	%W yview scroll [expr {-10 * (%D)}] units
     }
     bind $c <Shift-MouseWheel> {
-        %W xview scroll [expr {- (%D)}] units
+	%W xview scroll [expr {-(%D)}] units
     }
     bind $c <Shift-Option-MouseWheel> {
-        %W xview scroll [expr {-10 * (%D)}] units
+	%W xview scroll [expr {-10 * (%D)}] units
+    }
+} else {
+    bind $c <MouseWheel> {
+	%W yview scroll [expr {-(%D / 30)}] units
+    }
+    bind $c <Shift-MouseWheel> {
+	%W xview scroll [expr {-(%D / 30)}] units
     }
 }
 
+if {[tk windowingsystem] eq "x11"} {
+    # Support for mousewheels on Linux/Unix commonly comes through mapping
+    # the wheel to the extended buttons.  If you have a mousewheel, find
+    # Linux configuration info at:
+    #	http://linuxreviews.org/howtos/xfree/mouse/
+    bind $c <4> {
+	if {!$tk_strictMotif} {
+	    %W yview scroll -5 units
+	}
+    }
+    bind $c <Shift-4> {
+	if {!$tk_strictMotif} {
+	    %W xview scroll -5 units
+	}
+    }
+    bind $c <5> {
+	if {!$tk_strictMotif} {
+	    %W yview scroll 5 units
+	}
+    }
+    bind $c <Shift-5> {
+	if {!$tk_strictMotif} {
+	    %W xview scroll 5 units
+	}
+    }
+}
+
+
 proc scrollEnter canvas {
     global oldFill
     set id [$canvas find withtag current]
diff --git a/library/iconlist.tcl b/library/iconlist.tcl
index 62b0b2d..521ec37 100644
--- a/library/iconlist.tcl
+++ b/library/iconlist.tcl
@@ -446,6 +446,17 @@ package require Tk 8.6
 	bind $canvas <Control-B1-Motion> {;}
 	bind $canvas <Shift-B1-Motion>	[namespace code {my ShiftMotion1 %x %y}]
 
+	if {[tk windowingsystem] eq "aqua"} {
+	    bind $canvas <Shift-MouseWheel>	[namespace code {my MouseWheel [expr {40 * (%W)}]}]
+	    bind $canvas <Option-Shift-MouseWheel>	[namespace code {my MouseWheel [expr {400 * (%W)}]}]
+	} else {
+	    bind $canvas <Shift-MouseWheel>	[namespace code {my MouseWheel %W}]
+	}
+	if {[tk windowingsystem] eq "x11"} {
+	    bind $canvas <Shift-4>	[namespace code {my MouseWheel 120}]
+	    bind $canvas <Shift-5>	[namespace code {my MouseWheel -120}]
+	}
+
 	bind $canvas <<PrevLine>>	[namespace code {my UpDown -1}]
 	bind $canvas <<NextLine>>	[namespace code {my UpDown  1}]
 	bind $canvas <<PrevChar>>	[namespace code {my LeftRight -1}]
@@ -492,6 +503,16 @@ package require Tk 8.6
     # ----------------------------------------------------------------------
 
     # Event handlers
+    method MouseWheel {amount} {
+	if {$noScroll || $::tk_strictMotif} {
+	    return
+	}
+	if {$amount > 0} {
+	    $canvas xview scroll [expr {(-119-$amount) / 120}] units
+	} else {
+	    $canvas xview scroll [expr {-($amount / 120)}] units
+	}
+    }
     method Btn1 {x y} {
 	focus $canvas
 	set i [$w index @$x,$y]
diff --git a/library/listbox.tcl b/library/listbox.tcl
index 16e51bd..2149e10 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -182,27 +182,27 @@ bind Listbox <B2-Motion> {
 
 if {[tk windowingsystem] eq "aqua"} {
     bind Listbox <MouseWheel> {
-        %W yview scroll [expr {- (%D)}] units
+        %W yview scroll [expr {-(%D)}] units
     }
     bind Listbox <Option-MouseWheel> {
         %W yview scroll [expr {-10 * (%D)}] units
     }
     bind Listbox <Shift-MouseWheel> {
-        %W xview scroll [expr {- (%D)}] units
+        %W xview scroll [expr {-(%D)}] units
     }
     bind Listbox <Shift-Option-MouseWheel> {
         %W xview scroll [expr {-10 * (%D)}] units
     }
 } else {
     bind Listbox <MouseWheel> {
-        %W yview scroll [expr {- (%D / 120) * 4}] units
+        %W yview scroll [expr {-(%D/30)}] units
     }
     bind Listbox <Shift-MouseWheel> {
-        %W xview scroll [expr {- (%D / 120) * 4}] units
+        %W xview scroll [expr {-(%D/30)}] units
     }
 }
 
-if {"x11" eq [tk windowingsystem]} {
+if {[tk windowingsystem] eq "x11"} {
     # Support for mousewheels on Linux/Unix commonly comes through mapping
     # the wheel to the extended buttons.  If you have a mousewheel, find
     # Linux configuration info at:
diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl
index 6f1caa2..65f29ee 100644
--- a/library/scrlbar.tcl
+++ b/library/scrlbar.tcl
@@ -128,42 +128,36 @@ bind Scrollbar <<LineEnd>> {
     tk::ScrollToPos %W 1
 }
 }
-switch [tk windowingsystem] {
-    "aqua" {
-	bind Scrollbar <MouseWheel> {
-	    tk::ScrollByUnits %W v [expr {- (%D)}]
-	}
-	bind Scrollbar <Option-MouseWheel> {
-	    tk::ScrollByUnits %W v [expr {-10 * (%D)}]
-	}
-	bind Scrollbar <Shift-MouseWheel> {
-	    tk::ScrollByUnits %W h [expr {- (%D)}]
-	}
-	bind Scrollbar <Shift-Option-MouseWheel> {
-	    tk::ScrollByUnits %W h [expr {-10 * (%D)}]
-	}
+
+if {[tk windowingsystem] eq "aqua"} {
+    bind Scrollbar <MouseWheel> {
+	tk::ScrollByUnits %W v [expr {-(%D)}]
     }
-    "win32" {
-	bind Scrollbar <MouseWheel> {
-	    tk::ScrollByUnits %W v [expr {- (%D / 120) * 4}]
-	}
-	bind Scrollbar <Shift-MouseWheel> {
-	    tk::ScrollByUnits %W h [expr {- (%D / 120) * 4}]
-	}
+    bind Scrollbar <Option-MouseWheel> {
+	tk::ScrollByUnits %W v [expr {-10 * (%D)}]
     }
-    "x11" {
-	bind Scrollbar <MouseWheel> {
-	    tk::ScrollByUnits %W v [expr {- (%D /120 ) * 4}]
-	}
-	bind Scrollbar <Shift-MouseWheel> {
-	    tk::ScrollByUnits %W h [expr {- (%D /120 ) * 4}]
-	}
-	bind Scrollbar <4> {tk::ScrollByUnits %W v -5}
-	bind Scrollbar <5> {tk::ScrollByUnits %W v 5}
-	bind Scrollbar <Shift-4> {tk::ScrollByUnits %W h -5}
-	bind Scrollbar <Shift-5> {tk::ScrollByUnits %W h 5}
+    bind Scrollbar <Shift-MouseWheel> {
+	tk::ScrollByUnits %W h [expr {-(%D)}]
+    }
+    bind Scrollbar <Shift-Option-MouseWheel> {
+	tk::ScrollByUnits %W h [expr {-10 * (%D)}]
+    }
+} else {
+    bind Scrollbar <MouseWheel> {
+	tk::ScrollByUnits %W v [expr {-(%D / 30)}]
+    }
+    bind Scrollbar <Shift-MouseWheel> {
+	tk::ScrollByUnits %W h [expr {-(%D / 30)}]
     }
 }
+
+if {[tk windowingsystem] eq "x11"} {
+    bind Scrollbar <4> {tk::ScrollByUnits %W v -5}
+    bind Scrollbar <5> {tk::ScrollByUnits %W v 5}
+    bind Scrollbar <Shift-4> {tk::ScrollByUnits %W h -5}
+    bind Scrollbar <Shift-5> {tk::ScrollByUnits %W h 5}
+}
+
 # tk::ScrollButtonDown --
 # This procedure is invoked when a button is pressed in a scrollbar.
 # It changes the way the scrollbar is displayed and takes actions
diff --git a/library/text.tcl b/library/text.tcl
index 7d12e18..60bf497 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -468,7 +468,7 @@ if {[tk windowingsystem] eq "aqua"} {
     }
 }
 
-if {"x11" eq [tk windowingsystem]} {
+if {[tk windowingsystem] eq "x11"} {
     # Support for mousewheels on Linux/Unix commonly comes through mapping
     # the wheel to the extended buttons.  If you have a mousewheel, find
     # Linux configuration info at:
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
index 7cc1bb7..857f4cd 100644
--- a/library/ttk/utils.tcl
+++ b/library/ttk/utils.tcl
@@ -300,17 +300,15 @@ proc ttk::copyBindings {from to} {
 #
 
 proc ttk::bindMouseWheel {bindtag callback} {
-    switch -- [tk windowingsystem] {
-	x11 {
-	    bind $bindtag <ButtonPress-4> "$callback -1"
-	    bind $bindtag <ButtonPress-5> "$callback +1"
-	}
-	win32 {
-	    bind $bindtag <MouseWheel> [append callback { [expr {-(%D/120)}]}]
-	}
-	aqua {
-	    bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ]
-	}
+    if {[tk windowingsystem] eq "x11"} {
+	bind $bindtag <ButtonPress-4> "$callback -1"
+	bind $bindtag <ButtonPress-5> "$callback +1"
+    }
+    if {[tk windowingsystem] eq "aqua"} {
+	bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ]
+	bind $bindtag <Option-MouseWheel> [append callback { [expr {-10 *(%D)}]} ]
+    } else {
+	bind $bindtag <MouseWheel> [append callback { [expr {-(%D / 120)}]}]
     }
 }
 
@@ -322,29 +320,26 @@ proc ttk::bindMouseWheel {bindtag callback} {
 # standard scrollbar protocol.
 #
 
-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> \
+if {[tk windowingsystem] eq "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 }
+}
+if {[tk windowingsystem] eq "aqua"} {
+    bind TtkScrollable <MouseWheel> \
 	    { %W yview scroll [expr {-(%D)}] units }
-	bind TtkScrollable <Shift-MouseWheel> \
+    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 }
-    }
+    bind TtkScrollable <Option-MouseWheel> \
+	    { %W yview scroll  [expr {-10 * (%D)}] units }
+    bind TtkScrollable <Shift-Option-MouseWheel> \
+	    { %W xview scroll [expr {-10 * (%D)}] units }
+} else {
+    bind TtkScrollable <MouseWheel> \
+	    { %W yview scroll [expr {-(%D / 120)}] units }
+    bind TtkScrollable <Shift-MouseWheel> \
+	    { %W xview scroll [expr {-(%D / 120)}] units }
 }
 
 #*EOF*