gitk: Add support for OS X mouse wheel
authorJonathan del Strother <jon.delStrother@bestbefore.tv>
Mon, 15 Oct 2007 09:33:07 +0000 (10:33 +0100)
committerShawn O. Pearce <spearce@spearce.org>
Sat, 20 Oct 2007 03:06:33 +0000 (23:06 -0400)
(Väinö Järvelä supplied this patch a while ago for 1.5.2.  It no longer
applied cleanly, so I'm reposting it.)

MacBook doesn't seem to recognize MouseRelease-4 and -5 events, at all.
So i added a support for the MouseWheel event, which i limited to Tcl/tk
aqua, as i couldn't test it neither on Linux or Windows. Tcl/tk needs to
be updated from the version that is shipped with OS X 10.4 Tiger, for
this patch to work.

Signed-off-by: Jonathan del Strother <jon.delStrother@bestbefore.tv>
Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
gitk

diff --git a/gitk b/gitk
index 999e3c2188ee25bbdfc8099b716a4f15569b0ebc..46673e3b9c48439c6213b9ba56730748999e03b2 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -843,6 +843,12 @@ proc makewindow {} {
     } else {
        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+        if {[tk windowingsystem] eq "aqua"} {
+            bindall <MouseWheel> {
+                set delta [expr {- (%D)}]
+                allcanvs yview scroll $delta units
+            }
+        }
     }
     bindall <2> "canvscan mark %W %x %y"
     bindall <B2-Motion> "canvscan dragto %W %x %y"