2 |
2 |
3 # Copyright (C) 2005 Paul Mackerras. All rights reserved. |
3 # Copyright (C) 2005 Paul Mackerras. All rights reserved. |
4 # This program is free software; it may be used, copied, modified |
4 # This program is free software; it may be used, copied, modified |
5 # and distributed under the terms of the GNU General Public Licence, |
5 # and distributed under the terms of the GNU General Public Licence, |
6 # either version 2, or (at your option) any later version. |
6 # either version 2, or (at your option) any later version. |
|
7 |
|
8 |
|
9 # Modified version of Tip 171: |
|
10 # http://www.tcl.tk/cgi-bin/tct/tip/171.html |
|
11 # |
|
12 # The in_mousewheel global was added to fix strange reentrancy issues. |
|
13 # The whole snipped is activated only under windows, mouse wheel |
|
14 # bindings working already under MacOSX and Linux. |
|
15 |
|
16 if {[tk windowingsystem] eq "win32"} { |
|
17 |
|
18 set mw_classes [list Text Listbox Table TreeCtrl] |
|
19 foreach class $mw_classes { bind $class <MouseWheel> {} } |
|
20 |
|
21 set in_mousewheel 0 |
|
22 |
|
23 proc ::tk::MouseWheel {wFired X Y D {shifted 0}} { |
|
24 global in_mousewheel |
|
25 if { $in_mousewheel != 0 } { return } |
|
26 # Set event to check based on call |
|
27 set evt "<[expr {$shifted?{Shift-}:{}}]MouseWheel>" |
|
28 # do not double-fire in case the class already has a binding |
|
29 if {[bind [winfo class $wFired] $evt] ne ""} { return } |
|
30 # obtain the window the mouse is over |
|
31 set w [winfo containing $X $Y] |
|
32 # if we are outside the app, try and scroll the focus widget |
|
33 if {![winfo exists $w]} { catch {set w [focus]} } |
|
34 if {[winfo exists $w]} { |
|
35 |
|
36 if {[bind $w $evt] ne ""} { |
|
37 # Awkward ... this widget has a MouseWheel binding, but to |
|
38 # trigger successfully in it, we must give it focus. |
|
39 catch {focus} old |
|
40 if {$w ne $old} { focus $w } |
|
41 set in_mousewheel 1 |
|
42 event generate $w $evt -rootx $X -rooty $Y -delta $D |
|
43 set in_mousewheel 0 |
|
44 if {$w ne $old} { focus $old } |
|
45 return |
|
46 } |
|
47 |
|
48 # aqua and x11/win32 have different delta handling |
|
49 if {[tk windowingsystem] ne "aqua"} { |
|
50 set delta [expr {- ($D / 30)}] |
|
51 } else { |
|
52 set delta [expr {- ($D)}] |
|
53 } |
|
54 # scrollbars have different call conventions |
|
55 if {[string match "*Scrollbar" [winfo class $w]]} { |
|
56 catch {tk::ScrollByUnits $w \ |
|
57 [string index [$w cget -orient] 0] $delta} |
|
58 } else { |
|
59 set cmd [list $w [expr {$shifted ? "xview" : "yview"}] \ |
|
60 scroll $delta units] |
|
61 # Walking up to find the proper widget (handles cases like |
|
62 # embedded widgets in a canvas) |
|
63 while {[catch $cmd] && [winfo toplevel $w] ne $w} { |
|
64 set w [winfo parent $w] |
|
65 } |
|
66 } |
|
67 } |
|
68 } |
|
69 |
|
70 bind all <MouseWheel> [list ::tk::MouseWheel %W %X %Y %D 0] |
|
71 |
|
72 # end of win32 section |
|
73 } |
|
74 |
7 |
75 |
8 proc gitdir {} { |
76 proc gitdir {} { |
9 global env |
77 global env |
10 if {[info exists env(GIT_DIR)]} { |
78 if {[info exists env(GIT_DIR)]} { |
11 return $env(GIT_DIR) |
79 return $env(GIT_DIR) |