[PATCH] Hgk - add scroll by mouse wheel

[Andrei Vermel]

This is only tested on windows. May need '120' changed to something else on other platforms

Andrei

# HG changeset patch
# User Andrei Vermel <avermel at mail.ru>
# Date 1184736602 -14400
# Node ID bdb8ed833a4e1d8bfe7e618a8e3f8185a2206741
# Parent  35aa76938e4bdeaab7a6547cfac3614ab39ed428
hgk: add scroll by wheel

diff -r 35aa76938e4b -r bdb8ed833a4e contrib/hgk
--- a/contrib/hgk Wed Jul 18 09:30:02 2007 +0400
+++ b/contrib/hgk Wed Jul 18 09:30:02 2007 +0400
@@ -4,6 +4,38 @@
 # This program is free software; it may be used, copied, modified
 # and distributed under the terms of the GNU General Public Licence,
 # either version 2, or (at your option) any later version.
+
+proc wheelEvent { x y delta } {
+
+    # Find out what's the widget we're on
+    set act 0
+    set widget [winfo containing $x $y]
+
+    if {$widget != ""} {
+        # Make sure we've got a vertical scrollbar for this widget
+        if {[catch "$widget cget -yscrollcommand" cmd]} return
+
+        if {$cmd != ""} {
+            # Find out the scrollbar widget we're using
+            set scroller [lindex $cmd 0]
+
+            # Make sure we act
+            set act 1
+        }
+    }
+
+    if {$act == 1} {
+        # Now we know we have to process the wheel mouse event
+        set xy [$widget yview]
+        set factor [expr [lindex $xy 1]-[lindex $xy 0]]
+
+        # Make sure we activate the scrollbar's command
+        set cmd "[$scroller cget -command] scroll [expr -($delta/abs($delta))*int(pow(abs($delta/120), 3))] units"
+        eval $cmd
+    }
+}
+
+bind all <MouseWheel> "+wheelEvent %X %Y %D"
 
 proc gitdir {} {
     global env
-------------- next part --------------
A non-text attachment was scrubbed...
Name: hgk_wheel.diff
Type: application/octet-stream
Size: 1538 bytes
Desc: not available
Url : http://selenic.com/pipermail/mercurial/attachments/20070718/bd605b65/attachment.obj