gitk: mousewheel scrolling functions for Tk 8.6

gitk supports scrolling of 5 windows, but does this differently on the
aqua, x11, and win32 platforms as Tk provides different events on each.
TIP 171 removes some differences on win32 while altering the required
bindings on x11. TIP 474, which is in Tk 8.7 and later, finally unifies
all platforms on using common MouseWheel bindings. Importantly for now,
TIP 171 causes delivery of MouseWheel events to the widget under the
mouse cursor on win32, eliminating the need for completely different
bindings on win32.

Let's make some common functions to unify as much as we can in Tk 8.6.
Examining the platforms shows that the default platform scrolling is
overridden differently on the 3 platforms, and the nominal amount of
motion achieved per mouse wheel "click" is different. win32 nominally
makes everything move 5 lines per click, aqua 1 line per click, and x11
is a mixture. Part of this is due to win32 overriding all scroll events,
while x11 and aqua override smaller sets. Also, note that the text
widgets (the lower two panes) always scroll by 2-3 lines when given a
smaller scroll amount, while the upper three canvas objects follow the
requested scrolling value more accurately.

First, let's have a common routine to calculate the scroll value to give
to a widget in an event. This accounts for the user preference, the
scale of the %D (delta) value given by the event (120 on win32, 1 on
aqua, assumed 1 on x11), and must always be integer. Include negation as
by convention the screen moves opposite to the MouseWheel delta. Allow
setting an offset value to account for the larger minimum scrolling of
text widgets.

Second, let's have a common declaration of MouseWheel event bindings, as
those are shared by all in Tcl9, and by aqua/win32 earlier. Bind all
five display windows here. Note that the Patch/Tree widget (cflist)
cannot scroll horizontally.

Signed-off-by: Mark Levedahl <mlevedahl@gmail.com>

diff --git a/gitk b/gitk
index 0596e4382a56ca53f687559fb6df3d3a06f21a93..56eb1ec4e64ef995ff42aacfa133d50e4922e031 100755 (executable)
--- a/gitk
+++ b/gitk
@@ -2259,6 +2259,21 @@ proc makedroplist {w varname args} {
     return $gm
 }
 
+proc scrollval {D {koff 0}} {
+    global kscroll scroll_D0
+    return [expr int(-($D / $scroll_D0) * max(1, $kscroll-$koff))]
+}
+
+proc bind_mousewheel {} {
+    global canv cflist ctext
+    bindall <MouseWheel> {allcanvs yview scroll [scrollval %D] units}
+    bindall <Shift-MouseWheel> break
+    bind $ctext <MouseWheel> {$ctext yview scroll [scrollval %D] units}
+    bind $ctext <Shift-MouseWheel> {$ctext xview scroll [scrollval %D] units}
+    bind $cflist <MouseWheel> {$cflist yview scroll [scrollval %D] units}
+    bind $cflist <Shift-MouseWheel> break
+}
+
 proc makewindow {} {
     global canv canv2 canv3 linespc charspc ctext cflist cscroll
     global tabstop