Redirect scroll wheel related bindings from ttk::scrollbar to scrollbar as proposed by Csaba 2019-12-18 09:42:32 in Ticket [2b8fa6fd]

1 files changed, 16 insertions, 17 deletions

diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl
index 8415e55..efcf3a1 100644
--- a/library/ttk/scrollbar.tcl
+++ b/library/ttk/scrollbar.tcl
@@ -17,27 +17,26 @@ bind TScrollbar <ButtonPress-2> 	{ ttk::scrollbar::Jump %W %x %y }
 bind TScrollbar <B2-Motion>		{ ttk::scrollbar::Drag %W %x %y }
 bind TScrollbar <ButtonRelease-2>	{ ttk::scrollbar::Release %W %x %y }
 
-if {[tk windowingsystem] eq "aqua"} {
-    bind TScrollbar <MouseWheel> {
-	ttk::scrollbar::Scroll %W [expr {-(%D)}] units
-    }
-    bind TScrollbar <Option-MouseWheel> {
-	ttk::scrollbar::Scroll %W [expr {-10 * (%D)}] units
+# Redirect scrollwheel bindings to the scrollbar widget
+#
+# The shift-bindings scroll left/right (not up/down)
+# if a widget has both possibilities
+set eventList [list <MouseWheel> <Shift-MouseWheel>]
+switch [tk windowingsystem] {
+    aqua {
+        lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel>
     }
-} else {
-    bind TScrollbar <MouseWheel> {
-	if {%D >= 0} {
-	    ttk::scrollbar::Scroll %W [expr {-%D/30}] units
-	} else {
-	    ttk::scrollbar::Scroll %W [expr {(29-%D)/30}] units
-	}
+    x11 {
+        lappend eventList <Button-4> <Button-5> \
+                <Shift-Button-4> <Shift-Button-5>
+        # For tk 8.7, the event list should be extended by
+        # <Button-6> <Button-7>
     }
 }
-
-if {[tk windowingsystem] eq "x11"} {
-    bind TScrollbar <4> {ttk::scrollbar::Scroll %W -5 units}
-    bind TScrollbar <5> {ttk::scrollbar::Scroll %W 5 units}
+foreach event $eventList {
+    bind TScrollbar $event [bind Scrollbar $event]
 }
+unset eventList event
 
 proc ttk::scrollbar::Scroll {w n units} {
     set cmd [$w cget -command]