Bug#304781: mouse wheel patch

[Ludovic Drolez]

Hi !

Here's a slight variation on the patch I found on

http://sourceforge.net/mailarchive/forum.php?thread_id=3633292&forum_id=8827

Cheers,

--
Ludovic DROLEZ                              Linbox / Free&ALter Soft
www.linbox.com www.linbox.org                 tel: +33 3 87 50 87 90
152 rue de Grigy - Technopole Metz 2000                   57070 METZ

diff -u -r1.1.1.1 bindings.tcl
--- snavigator/gui/bindings.tcl 18 Apr 2002 23:40:18 -0000      1.1.1.1
+++ snavigator/gui/bindings.tcl 23 Nov 2003 18:32:07 -0000
@@ -180,7 +180,33 @@
     bind ${t} <Up> {
                tkTreeTableUpDown %W -1
        }
-    bind ${t} <Shift-Up> {
+
+
+  bind ${t} <Button-4> {
+    %W yview scroll -5 units
+  }
+  bind ${t} <Shift-Button-4> {
+    %W yview scroll -1 units
+  }
+  bind ${t} <Control-Button-4> {
+    %W xview scroll -10 units
+  }
+  bind ${t} <Button-5> {
+    %W yview scroll 5 units
+  }
+  bind ${t} <Shift-Button-5> {
+    %W yview scroll 1 units
+  }
+  bind ${t} <Control-Button-5> {
+    %W xview scroll 10 units
+  }
+#  bind ${t} <MouseWheel> {
+#    %W yview scroll [expr {- (%D / 120) * 4}] units
+#  }
+
+
+
+  bind ${t} <Shift-Up> {
                tkListboxExtendUpDown %W -1
        }
     bind ${t} <Down> {
@@ -567,6 +593,16 @@
     bind ${text} <Control-a> [bind ${text} <Home>]
     bind ${text} <Control-e> [bind ${text} <End>]
 
+    bind ${text} <Button-5> [list %W yview scroll 5 units]
+    bind ${text} <Button-4> [list %W yview scroll -5 units]
+    bind ${text} <Shift-Button-5> [list %W yview scroll 1 units]
+    bind ${text} <Shift-Button-4> [list %W yview scroll -1 units]
+    bind ${text} <Control-Button-5> [list %W xview scroll 10 units]
+    bind ${text} <Control-Button-4> [list %W xview scroll -10 units]
+#    bind ${text} <MouseWheel>
+#        { %W yview scroll [expr {- (%D / 120) * 4}] units
+#    }
+
     catch {
         bind ${text} <apLineDel> "[bind ${text} <Delete>]; break"
     }
@@ -1186,6 +1222,17 @@
     #apply input to canvases
     bind ${c} <ButtonRelease-1> "focus %W"
 
+    bind ${c} <Button-4> {sn_canvas_scroll %W MultiUp}
+    bind ${c} <Button-5> {sn_canvas_scroll %W MultiDown}
+    bind ${c} <Shift-Button-4> {sn_canvas_scroll %W Up}
+    bind ${c} <Shift-Button-5> {sn_canvas_scroll %W Down}
+    bind ${c} <Control-Button-4> {sn_canvas_scroll %W MultiLeft}
+    bind ${c} <Control-Button-5> {sn_canvas_scroll %W MultiRight}
+               # don"t see a way to use sn_canvas_scroll with this sinble 
binding
+#    bind ${c} <MouseWheel> {
+#        %W yview scroll [expr {- (%D / 120) * 4}] units
+#    }
+
     bind ${c} <Left> {sn_canvas_scroll %W Left}
     bind ${c} <Right> {sn_canvas_scroll %W Right}
     bind ${c} <Control-Left> {sn_canvas_scroll %W PgLeft}
@@ -1248,6 +1295,18 @@
             }
         End {
                 ${c} yview moveto 1
+            }
+        MultiUp {
+                ${c} yview scroll -5 units
+            }
+        MultiDown {
+                ${c} yview scroll 5 units
+            }
+        MultiLeft {
+                ${c} xview scroll -5 units
+            }
+        MultiRight {
+                ${c} xview scroll 5 units
             }
     }
 }