Mercurial > hg
annotate contrib/hgk @ 18805:6a0578d07024
hgk: update backgroud colour when Ttk is available
Ttk doesn't automatically set up Tk colour palette.
Because of that, Ttk controls look differently when used
together with old Tk controls. When we use Ttk controls,
we first query if we have any setting for the client
background, and if we do, we update Tk palette as well.
author | Andrew Shadura <bugzilla@tut.by> |
---|---|
date | Sun, 10 Mar 2013 16:42:16 +0100 |
parents | 870505ec3e56 |
children | 932f5d3587c9 |
rev | line source |
---|---|
1361
f6d73b26dbdb
contrib/hgk: remove hardcoded path to Wish
TK Soh <teekaysoh@yahoo.com>
parents:
1340
diff
changeset
|
1 #!/usr/bin/env wish |
267 | 2 |
3 # Copyright (C) 2005 Paul Mackerras. All rights reserved. | |
4 # This program is free software; it may be used, copied, modified | |
5 # and distributed under the terms of the GNU General Public Licence, | |
6 # either version 2, or (at your option) any later version. | |
5395
e73a83af7926
hgk: add basic usage and configuration documentation
Patrick Mezard <pmezard@gmail.com>
parents:
5394
diff
changeset
|
7 # |
e73a83af7926
hgk: add basic usage and configuration documentation
Patrick Mezard <pmezard@gmail.com>
parents:
5394
diff
changeset
|
8 # See hgk.py for extension usage and configuration. |
267 | 9 |
4969
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
10 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
11 # Modified version of Tip 171: |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
12 # http://www.tcl.tk/cgi-bin/tct/tip/171.html |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
13 # |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
14 # The in_mousewheel global was added to fix strange reentrancy issues. |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
15 # The whole snipped is activated only under windows, mouse wheel |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
16 # bindings working already under MacOSX and Linux. |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
17 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
18 if {[catch {package require Ttk}]} { |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
19 # use a shim |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
20 namespace eval ttk { |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
21 proc style args {} |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
22 |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
23 proc entry args { |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
24 eval [linsert $args 0 ::entry] -relief flat |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
25 } |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
26 } |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
27 |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
28 interp alias {} ttk::button {} button |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
29 interp alias {} ttk::frame {} frame |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
30 interp alias {} ttk::label {} label |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
31 interp alias {} ttk::scrollbar {} scrollbar |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
32 interp alias {} ttk::optionMenu {} tk_optionMenu |
18805
6a0578d07024
hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents:
18804
diff
changeset
|
33 |
6a0578d07024
hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents:
18804
diff
changeset
|
34 proc updatepalette {} {} |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
35 } else { |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
36 proc ::ttk::optionMenu {w varName firstValue args} { |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
37 upvar #0 $varName var |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
38 |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
39 if {![info exists var]} { |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
40 set var $firstValue |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
41 } |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
42 ttk::menubutton $w -textvariable $varName -menu $w.menu \ |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
43 -direction flush |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
44 menu $w.menu -tearoff 0 |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
45 $w.menu add radiobutton -label $firstValue -variable $varName |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
46 foreach i $args { |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
47 $w.menu add radiobutton -label $i -variable $varName |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
48 } |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
49 return $w.menu |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
50 } |
18805
6a0578d07024
hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents:
18804
diff
changeset
|
51 proc updatepalette {} { |
6a0578d07024
hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents:
18804
diff
changeset
|
52 catch { |
6a0578d07024
hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents:
18804
diff
changeset
|
53 tk_setPalette background [ttk::style lookup client -background] |
6a0578d07024
hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents:
18804
diff
changeset
|
54 } |
6a0578d07024
hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents:
18804
diff
changeset
|
55 } |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
56 } |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
57 |
4969
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
58 if {[tk windowingsystem] eq "win32"} { |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
59 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
60 ttk::style theme use xpnative |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
61 |
4969
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
62 set mw_classes [list Text Listbox Table TreeCtrl] |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
63 foreach class $mw_classes { bind $class <MouseWheel> {} } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
64 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
65 set in_mousewheel 0 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
66 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
67 proc ::tk::MouseWheel {wFired X Y D {shifted 0}} { |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
68 global in_mousewheel |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
69 if { $in_mousewheel != 0 } { return } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
70 # Set event to check based on call |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
71 set evt "<[expr {$shifted?{Shift-}:{}}]MouseWheel>" |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
72 # do not double-fire in case the class already has a binding |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
73 if {[bind [winfo class $wFired] $evt] ne ""} { return } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
74 # obtain the window the mouse is over |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
75 set w [winfo containing $X $Y] |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
76 # if we are outside the app, try and scroll the focus widget |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
77 if {![winfo exists $w]} { catch {set w [focus]} } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
78 if {[winfo exists $w]} { |
5143
d4fa6bafc43a
Remove trailing spaces, fix indentation
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4969
diff
changeset
|
79 |
4969
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
80 if {[bind $w $evt] ne ""} { |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
81 # Awkward ... this widget has a MouseWheel binding, but to |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
82 # trigger successfully in it, we must give it focus. |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
83 catch {focus} old |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
84 if {$w ne $old} { focus $w } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
85 set in_mousewheel 1 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
86 event generate $w $evt -rootx $X -rooty $Y -delta $D |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
87 set in_mousewheel 0 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
88 if {$w ne $old} { focus $old } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
89 return |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
90 } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
91 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
92 # aqua and x11/win32 have different delta handling |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
93 if {[tk windowingsystem] ne "aqua"} { |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
94 set delta [expr {- ($D / 30)}] |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
95 } else { |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
96 set delta [expr {- ($D)}] |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
97 } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
98 # scrollbars have different call conventions |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
99 if {[string match "*Scrollbar" [winfo class $w]]} { |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
100 catch {tk::ScrollByUnits $w \ |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
101 [string index [$w cget -orient] 0] $delta} |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
102 } else { |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
103 set cmd [list $w [expr {$shifted ? "xview" : "yview"}] \ |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
104 scroll $delta units] |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
105 # Walking up to find the proper widget (handles cases like |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
106 # embedded widgets in a canvas) |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
107 while {[catch $cmd] && [winfo toplevel $w] ne $w} { |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
108 set w [winfo parent $w] |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
109 } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
110 } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
111 } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
112 } |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
113 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
114 bind all <MouseWheel> [list ::tk::MouseWheel %W %X %Y %D 0] |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
115 |
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
116 # end of win32 section |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
117 } else { |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
118 |
18561
7365d031d457
hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents:
17960
diff
changeset
|
119 if {[catch { |
7365d031d457
hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents:
17960
diff
changeset
|
120 set theme [ttk::style theme use] |
7365d031d457
hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents:
17960
diff
changeset
|
121 }]} { |
7365d031d457
hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents:
17960
diff
changeset
|
122 set theme $::ttk::currentTheme |
7365d031d457
hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents:
17960
diff
changeset
|
123 } |
7365d031d457
hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents:
17960
diff
changeset
|
124 if {$theme eq "default"} { |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
125 ttk::style theme use clam |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
126 } |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
127 |
5143
d4fa6bafc43a
Remove trailing spaces, fix indentation
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4969
diff
changeset
|
128 } |
4969
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
129 |
18805
6a0578d07024
hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents:
18804
diff
changeset
|
130 updatepalette |
4969
b43db44cd047
hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents:
4968
diff
changeset
|
131 |
5392
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
132 # Unify right mouse button handling. |
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
133 # See "mouse buttons on macintosh" thread on comp.lang.tcl |
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
134 if {[tk windowingsystem] eq "aqua"} { |
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
135 event add <<B3>> <Control-ButtonPress-1> |
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
136 event add <<B3>> <Button-2> |
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
137 } else { |
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
138 event add <<B3>> <Button-3> |
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
139 } |
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
140 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
141 proc gitdir {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
142 global env |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
143 if {[info exists env(GIT_DIR)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
144 return $env(GIT_DIR) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
145 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
146 return ".hg" |
267 | 147 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
148 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
149 |
18804 | 150 proc popupify {w} { |
151 wm resizable $w 0 0 | |
152 wm withdraw $w | |
153 update | |
154 set x [expr {([winfo screenwidth .]-[winfo reqwidth $w])/2}] | |
155 set y [expr {([winfo screenheight .]-[winfo reqheight $w])/2}] | |
156 wm geometry $w +$x+$y | |
157 wm transient $w . | |
158 wm deiconify $w | |
159 wm resizable $w 1 1 | |
160 } | |
161 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
162 proc getcommits {rargs} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
163 global commits commfd phase canv mainfont env |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
164 global startmsecs nextupdate ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
165 global ctext maincursor textcursor leftover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
166 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
167 # check that we can find a .git directory somewhere... |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
168 set gitdir [gitdir] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
169 if {![file isdirectory $gitdir]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
170 error_popup "Cannot find the git directory \"$gitdir\"." |
267 | 171 exit 1 |
172 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
173 set commits {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
174 set phase getcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
175 set startmsecs [clock clicks -milliseconds] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
176 set nextupdate [expr $startmsecs + 100] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
177 set ncmupdate 1 |
3093
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
178 set limit 0 |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
179 set revargs {} |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
180 for {set i 0} {$i < [llength $rargs]} {incr i} { |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
181 set opt [lindex $rargs $i] |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
182 if {$opt == "--limit"} { |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
183 incr i |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
184 set limit [lindex $rargs $i] |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
185 } else { |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
186 lappend revargs $opt |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
187 } |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
188 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
189 if [catch { |
3093
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
190 set parse_args [concat --default HEAD $revargs] |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
191 set parse_temp [eval exec {$env(HG)} --config ui.report_untrusted=false debug-rev-parse $parse_args] |
3940
a33ddd20105c
hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents:
3093
diff
changeset
|
192 regsub -all "\r\n" $parse_temp "\n" parse_temp |
a33ddd20105c
hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents:
3093
diff
changeset
|
193 set parsed_args [split $parse_temp "\n"] |
3093
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
194 } err] { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
195 # if git-rev-parse failed for some reason... |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
196 if {$rargs == {}} { |
3093
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
197 set revargs HEAD |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
198 } |
3093
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
199 set parsed_args $revargs |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
200 } |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
201 if {$limit > 0} { |
edefbb3a3b08
hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents:
3092
diff
changeset
|
202 set parsed_args [concat -n $limit $parsed_args] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
203 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
204 if [catch { |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
205 set commfd [open "|{$env(HG)} --config ui.report_untrusted=false debug-rev-list --header --topo-order --parents $parsed_args" r] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
206 } err] { |
1278 | 207 puts stderr "Error executing hg debug-rev-list: $err" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
208 exit 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
209 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
210 set leftover {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
211 fconfigure $commfd -blocking 0 -translation lf |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
212 fileevent $commfd readable [list getcommitlines $commfd] |
267 | 213 $canv delete all |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
214 $canv create text 3 3 -anchor nw -text "Reading commits..." \ |
267 | 215 -font $mainfont -tags textitems |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
216 . config -cursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
217 settextcursor watch |
267 | 218 } |
219 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
220 proc getcommitlines {commfd} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
221 global commits parents cdate children |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
222 global commitlisted phase commitinfo nextupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
223 global stopped redisplaying leftover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
224 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
225 set stuff [read $commfd] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
226 if {$stuff == {}} { |
267 | 227 if {![eof $commfd]} return |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
228 # set it blocking so we wait for the process to terminate |
267 | 229 fconfigure $commfd -blocking 1 |
230 if {![catch {close $commfd} err]} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
231 after idle finishcommits |
267 | 232 return |
233 } | |
234 if {[string range $err 0 4] == "usage"} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
235 set err \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
236 {Gitk: error reading commits: bad arguments to git-rev-list. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
237 (Note: arguments to gitk are passed to git-rev-list |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
238 to allow selection of commits to be displayed.)} |
267 | 239 } else { |
240 set err "Error reading commits: $err" | |
241 } | |
242 error_popup $err | |
243 exit 1 | |
244 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
245 set start 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
246 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
247 set i [string first "\0" $stuff $start] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
248 if {$i < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
249 append leftover [string range $stuff $start end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
250 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
251 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
252 set cmit [string range $stuff $start [expr {$i - 1}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
253 if {$start == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
254 set cmit "$leftover$cmit" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
255 set leftover {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
256 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
257 set start [expr {$i + 1}] |
3940
a33ddd20105c
hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents:
3093
diff
changeset
|
258 regsub -all "\r\n" $cmit "\n" cmit |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
259 set j [string first "\n" $cmit] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
260 set ok 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
261 if {$j >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
262 set ids [string range $cmit 0 [expr {$j - 1}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
263 set ok 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
264 foreach id $ids { |
3059
3dab573a4330
hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents:
2297
diff
changeset
|
265 if {![regexp {^[0-9a-f]{12}$} $id]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
266 set ok 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
267 break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
268 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
269 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
270 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
271 if {!$ok} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
272 set shortcmit $cmit |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
273 if {[string length $shortcmit] > 80} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
274 set shortcmit "[string range $shortcmit 0 80]..." |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
275 } |
1278 | 276 error_popup "Can't parse hg debug-rev-list output: {$shortcmit}" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
277 exit 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
278 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
279 set id [lindex $ids 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
280 set olds [lrange $ids 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
281 set cmit [string range $cmit [expr {$j + 1}] end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
282 lappend commits $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
283 set commitlisted($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
284 parsecommit $id $cmit 1 [lrange $ids 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
285 drawcommit $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
286 if {[clock clicks -milliseconds] >= $nextupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
287 doupdate 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
288 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
289 while {$redisplaying} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
290 set redisplaying 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
291 if {$stopped == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
292 set stopped 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
293 set phase "getcommits" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
294 foreach id $commits { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
295 drawcommit $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
296 if {$stopped} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
297 if {[clock clicks -milliseconds] >= $nextupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
298 doupdate 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
299 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
300 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
301 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
302 } |
267 | 303 } |
304 } | |
305 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
306 proc doupdate {reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
307 global commfd nextupdate numcommits ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
308 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
309 if {$reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
310 fileevent $commfd readable {} |
267 | 311 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
312 update |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
313 set nextupdate [expr {[clock clicks -milliseconds] + 100}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
314 if {$numcommits < 100} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
315 set ncmupdate [expr {$numcommits + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
316 } elseif {$numcommits < 10000} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
317 set ncmupdate [expr {$numcommits + 10}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
318 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
319 set ncmupdate [expr {$numcommits + 100}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
320 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
321 if {$reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
322 fileevent $commfd readable [list getcommitlines $commfd] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
323 } |
267 | 324 } |
325 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
326 proc readcommit {id} { |
4688
39001f4b7d99
hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4502
diff
changeset
|
327 global env |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
328 if [catch {set contents [exec $env(HG) --config ui.report_untrusted=false debug-cat-file commit $id]}] return |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
329 parsecommit $id $contents 0 {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
330 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
331 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
332 proc parsecommit {id contents listed olds} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
333 global commitinfo children nchildren parents nparents cdate ncleft |
7776
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
334 global firstparents |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
335 |
267 | 336 set inhdr 1 |
337 set comment {} | |
338 set headline {} | |
339 set auname {} | |
340 set audate {} | |
341 set comname {} | |
342 set comdate {} | |
3092
d0fcce3728d1
hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents:
3059
diff
changeset
|
343 set rev {} |
5859
e0f86c1e3ae5
hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents:
5662
diff
changeset
|
344 set branch {} |
13461 | 345 set bookmark {} |
267 | 346 if {![info exists nchildren($id)]} { |
347 set children($id) {} | |
348 set nchildren($id) 0 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
349 set ncleft($id) 0 |
267 | 350 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
351 set parents($id) $olds |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
352 set nparents($id) [llength $olds] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
353 foreach p $olds { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
354 if {![info exists nchildren($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
355 set children($p) [list $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
356 set nchildren($p) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
357 set ncleft($p) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
358 } elseif {[lsearch -exact $children($p) $id] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
359 lappend children($p) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
360 incr nchildren($p) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
361 incr ncleft($p) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
362 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
363 } |
3940
a33ddd20105c
hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents:
3093
diff
changeset
|
364 regsub -all "\r\n" $contents "\n" contents |
267 | 365 foreach line [split $contents "\n"] { |
366 if {$inhdr} { | |
2297
936b615eb44e
Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
2058
diff
changeset
|
367 set line [split $line] |
267 | 368 if {$line == {}} { |
369 set inhdr 0 | |
370 } else { | |
371 set tag [lindex $line 0] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
372 if {$tag == "author"} { |
267 | 373 set x [expr {[llength $line] - 2}] |
374 set audate [lindex $line $x] | |
2297
936b615eb44e
Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
2058
diff
changeset
|
375 set auname [join [lrange $line 1 [expr {$x - 1}]]] |
267 | 376 } elseif {$tag == "committer"} { |
377 set x [expr {[llength $line] - 2}] | |
378 set comdate [lindex $line $x] | |
2297
936b615eb44e
Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
2058
diff
changeset
|
379 set comname [join [lrange $line 1 [expr {$x - 1}]]] |
3092
d0fcce3728d1
hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents:
3059
diff
changeset
|
380 } elseif {$tag == "revision"} { |
d0fcce3728d1
hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents:
3059
diff
changeset
|
381 set rev [lindex $line 1] |
5859
e0f86c1e3ae5
hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents:
5662
diff
changeset
|
382 } elseif {$tag == "branch"} { |
e0f86c1e3ae5
hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents:
5662
diff
changeset
|
383 set branch [join [lrange $line 1 end]] |
13461 | 384 } elseif {$tag == "bookmark"} { |
385 set bookmark [join [lrange $line 1 end]] | |
386 } | |
267 | 387 } |
388 } else { | |
389 if {$comment == {}} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
390 set headline [string trim $line] |
267 | 391 } else { |
392 append comment "\n" | |
393 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
394 if {!$listed} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
395 # git-rev-list indents the comment by 4 spaces; |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
396 # if we got this via git-cat-file, add the indentation |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
397 append comment " " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
398 } |
267 | 399 append comment $line |
400 } | |
401 } | |
402 if {$audate != {}} { | |
18803
82289176717d
hgk: don't use fixed format for dates
Andrew Shadura <bugzilla@tut.by>
parents:
18802
diff
changeset
|
403 set audate [clock format $audate] |
267 | 404 } |
405 if {$comdate != {}} { | |
406 set cdate($id) $comdate | |
18803
82289176717d
hgk: don't use fixed format for dates
Andrew Shadura <bugzilla@tut.by>
parents:
18802
diff
changeset
|
407 set comdate [clock format $comdate] |
267 | 408 } |
409 set commitinfo($id) [list $headline $auname $audate \ | |
13461 | 410 $comname $comdate $comment $rev $branch $bookmark] |
7776
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
411 |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
412 if {[info exists firstparents]} { |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
413 set i [lsearch $firstparents $id] |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
414 if {$i != -1} { |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
415 # remove the parent from firstparents, possible building |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
416 # an empty list |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
417 set firstparents [concat \ |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
418 [lrange $firstparents 0 [expr $i - 1]] \ |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
419 [lrange $firstparents [expr $i + 1] end]] |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
420 if {$firstparents eq {}} { |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
421 # we have found all parents of the first changeset |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
422 # which means that we can safely select the first line |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
423 after idle { |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
424 selectline 0 0 |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
425 } |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
426 } |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
427 } |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
428 } else { |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
429 # this is the first changeset, save the parents |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
430 set firstparents $olds |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
431 if {$firstparents eq {}} { |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
432 # a repository with a single changeset |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
433 after idle { |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
434 selectline 0 0 |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
435 } |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
436 } |
34ff1a1b5dd7
hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents:
7747
diff
changeset
|
437 } |
267 | 438 } |
439 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
440 proc readrefs {} { |
13461 | 441 global bookmarkcurrent bookmarkids tagids idtags idbookmarks headids idheads tagcontents env curid |
6210
942287cb1f57
Removed trailing spaces from everything except test output
Thomas Arendsen Hein <thomas@intevation.de>
parents:
5859
diff
changeset
|
442 |
6322
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
443 set status [catch {exec $env(HG) --config ui.report_untrusted=false id} curid] |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
444 if { $status != 0 } { |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
445 puts $::errorInfo |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
446 if { ![string equal $::errorCode NONE] } { |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
447 exit 2 |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
448 } |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
449 } |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
450 regexp -- {[[:xdigit:]]+} $curid curid |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
451 |
6322
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
452 set status [catch {exec $env(HG) --config ui.report_untrusted=false tags} tags] |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
453 if { $status != 0 } { |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
454 puts $::errorInfo |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
455 if { ![string equal $::errorCode NONE] } { |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
456 exit 2 |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
457 } |
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
458 } |
3940
a33ddd20105c
hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents:
3093
diff
changeset
|
459 regsub -all "\r\n" $tags "\n" tags |
6322
108636b9b981
hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents:
6210
diff
changeset
|
460 |
3940
a33ddd20105c
hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents:
3093
diff
changeset
|
461 set lines [split $tags "\n"] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
462 foreach f $lines { |
4502
1774c037fbd2
hgk: display tags that contain spaces
TK Soh <teekaysoh@yahoo.com>
parents:
4501
diff
changeset
|
463 regexp {(\S+)$} $f full |
1774c037fbd2
hgk: display tags that contain spaces
TK Soh <teekaysoh@yahoo.com>
parents:
4501
diff
changeset
|
464 regsub {\s+(\S+)$} $f "" direct |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
465 set sha [split $full ':'] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
466 set tag [lindex $sha 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
467 lappend tagids($direct) $tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
468 lappend idtags($tag) $direct |
267 | 469 } |
7039
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
470 |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
471 set status [catch {exec $env(HG) --config ui.report_untrusted=false heads} heads] |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
472 if { $status != 0 } { |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
473 puts $::errorInfo |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
474 if { ![string equal $::errorCode NONE] } { |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
475 exit 2 |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
476 } |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
477 } |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
478 regsub -all "\r\n" $heads "\n" heads |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
479 |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
480 set lines [split $heads "\n"] |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
481 foreach f $lines { |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
482 set match "" |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
483 regexp {changeset:\s+(\S+):(\S+)$} $f match id sha |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
484 if {$match != ""} { |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
485 lappend idheads($sha) $id |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
486 } |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
487 } |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
488 |
13461 | 489 set status [catch {exec $env(HG) --config ui.report_untrusted=false bookmarks} bookmarks] |
490 if { $status != 0 } { | |
491 puts $::errorInfo | |
492 if { ![string equal $::errorCode NONE] } { | |
493 exit 2 | |
494 } | |
495 } | |
496 set lines [split $bookmarks "\n"] | |
497 set bookmarkcurrent 0 | |
498 foreach f $lines { | |
499 regexp {(\S+)$} $f full | |
500 regsub {\s+(\S+)$} $f "" direct | |
501 set sha [split $full ':'] | |
502 set bookmark [lindex $sha 1] | |
503 set current [string first " * " $direct)] | |
504 regsub {^\s(\*|\s)\s} $direct "" direct | |
505 lappend bookmarkids($direct) $bookmark | |
506 lappend idbookmarks($bookmark) $direct | |
507 if {$current >= 0} { | |
508 set bookmarkcurrent $direct | |
509 } | |
510 } | |
267 | 511 } |
512 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
513 proc readotherrefs {base dname excl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
514 global otherrefids idotherrefs |
267 | 515 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
516 set git [gitdir] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
517 set files [glob -nocomplain -types f [file join $git $base *]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
518 foreach f $files { |
267 | 519 catch { |
520 set fd [open $f r] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
521 set line [read $fd 40] |
3059
3dab573a4330
hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents:
2297
diff
changeset
|
522 if {[regexp {^[0-9a-f]{12}} $line id]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
523 set name "$dname[file tail $f]" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
524 set otherrefids($name) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
525 lappend idotherrefs($id) $name |
267 | 526 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
527 close $fd |
267 | 528 } |
529 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
530 set dirs [glob -nocomplain -types d [file join $git $base *]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
531 foreach d $dirs { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
532 set dir [file tail $d] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
533 if {[lsearch -exact $excl $dir] >= 0} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
534 readotherrefs [file join $base $dir] "$dname$dir/" {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
535 } |
267 | 536 } |
537 | |
4968
713426631adf
hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents:
4741
diff
changeset
|
538 proc allcansmousewheel {delta} { |
713426631adf
hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents:
4741
diff
changeset
|
539 set delta [expr -5*(int($delta)/abs($delta))] |
713426631adf
hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents:
4741
diff
changeset
|
540 allcanvs yview scroll $delta units |
713426631adf
hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents:
4741
diff
changeset
|
541 } |
713426631adf
hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents:
4741
diff
changeset
|
542 |
267 | 543 proc error_popup msg { |
544 set w .error | |
545 toplevel $w | |
546 wm transient $w . | |
547 message $w.m -text $msg -justify center -aspect 400 | |
548 pack $w.m -side top -fill x -padx 20 -pady 20 | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
549 ttk::button $w.ok -text OK -command "destroy $w" |
267 | 550 pack $w.ok -side bottom -fill x |
551 bind $w <Visibility> "grab $w; focus $w" | |
18804 | 552 popupify $w |
267 | 553 tkwait window $w |
554 } | |
555 | |
556 proc makewindow {} { | |
557 global canv canv2 canv3 linespc charspc ctext cflist textfont | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
558 global findtype findtypemenu findloc findstring fstring geometry |
267 | 559 global entries sha1entry sha1string sha1but |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
560 global maincursor textcursor curtextcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
561 global rowctxmenu gaudydiff mergemax |
7746
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
562 global hgvdiff bgcolor fgcolor diffremcolor diffaddcolor diffmerge1color |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
563 global diffmerge2color hunksepcolor |
12634
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
564 global posx posy |
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
565 |
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
566 if {[info exists posx]} { |
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
567 wm geometry . +$posx+$posy |
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
568 } |
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
569 |
267 | 570 menu .bar |
571 .bar add cascade -label "File" -menu .bar.file | |
572 menu .bar.file | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
573 .bar.file add command -label "Reread references" -command rereadrefs |
267 | 574 .bar.file add command -label "Quit" -command doquit |
575 menu .bar.help | |
576 .bar add cascade -label "Help" -menu .bar.help | |
13380
d11405848abd
hgk: gitk->hgk in About... menu
Javi Merino <cibervicho@gmail.com>
parents:
12634
diff
changeset
|
577 .bar.help add command -label "About hgk" -command about |
267 | 578 . configure -menu .bar |
579 | |
580 if {![info exists geometry(canv1)]} { | |
581 set geometry(canv1) [expr 45 * $charspc] | |
582 set geometry(canv2) [expr 30 * $charspc] | |
583 set geometry(canv3) [expr 15 * $charspc] | |
584 set geometry(canvh) [expr 25 * $linespc + 4] | |
585 set geometry(ctextw) 80 | |
586 set geometry(ctexth) 30 | |
587 set geometry(cflistw) 30 | |
588 } | |
589 panedwindow .ctop -orient vertical | |
590 if {[info exists geometry(width)]} { | |
591 .ctop conf -width $geometry(width) -height $geometry(height) | |
592 set texth [expr {$geometry(height) - $geometry(canvh) - 56}] | |
593 set geometry(ctexth) [expr {($texth - 8) / | |
594 [font metrics $textfont -linespace]}] | |
595 } | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
596 ttk::frame .ctop.top |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
597 ttk::frame .ctop.top.bar |
267 | 598 pack .ctop.top.bar -side bottom -fill x |
599 set cscroll .ctop.top.csb | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
600 ttk::scrollbar $cscroll -command {allcanvs yview} |
267 | 601 pack $cscroll -side right -fill y |
602 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4 | |
603 pack .ctop.top.clist -side top -fill both -expand 1 | |
604 .ctop add .ctop.top | |
605 set canv .ctop.top.clist.canv | |
606 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \ | |
7738
db366ec8d0a4
hgk: Add background colour setting
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7039
diff
changeset
|
607 -bg $bgcolor -bd 0 \ |
17960
d0d99c8bdf51
hgk: specify some colours explicitly in hex
Andrew Shadura <bugzilla@tut.by>
parents:
17958
diff
changeset
|
608 -yscrollincr $linespc -yscrollcommand "$cscroll set" -selectbackground "#c0c0c0" |
267 | 609 .ctop.top.clist add $canv |
610 set canv2 .ctop.top.clist.canv2 | |
611 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \ | |
17960
d0d99c8bdf51
hgk: specify some colours explicitly in hex
Andrew Shadura <bugzilla@tut.by>
parents:
17958
diff
changeset
|
612 -bg $bgcolor -bd 0 -yscrollincr $linespc -selectbackground "#c0c0c0" |
267 | 613 .ctop.top.clist add $canv2 |
614 set canv3 .ctop.top.clist.canv3 | |
615 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \ | |
17960
d0d99c8bdf51
hgk: specify some colours explicitly in hex
Andrew Shadura <bugzilla@tut.by>
parents:
17958
diff
changeset
|
616 -bg $bgcolor -bd 0 -yscrollincr $linespc -selectbackground "#c0c0c0" |
267 | 617 .ctop.top.clist add $canv3 |
618 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w} | |
619 | |
620 set sha1entry .ctop.top.bar.sha1 | |
621 set entries $sha1entry | |
622 set sha1but .ctop.top.bar.sha1label | |
623 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \ | |
624 -command gotocommit -width 8 | |
625 $sha1but conf -disabledforeground [$sha1but cget -foreground] | |
626 pack .ctop.top.bar.sha1label -side left | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
627 ttk::entry $sha1entry -width 40 -font $textfont -textvariable sha1string |
267 | 628 trace add variable sha1string write sha1change |
629 pack $sha1entry -side left -pady 2 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
630 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
631 image create bitmap bm-left -data { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
632 #define left_width 16 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
633 #define left_height 16 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
634 static unsigned char left_bits[] = { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
635 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
636 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
637 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01}; |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
638 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
639 image create bitmap bm-right -data { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
640 #define right_width 16 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
641 #define right_height 16 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
642 static unsigned char right_bits[] = { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
643 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
644 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
645 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01}; |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
646 } |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
647 ttk::button .ctop.top.bar.leftbut -image bm-left -command goback \ |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
648 -state disabled -width 26 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
649 pack .ctop.top.bar.leftbut -side left -fill y |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
650 ttk::button .ctop.top.bar.rightbut -image bm-right -command goforw \ |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
651 -state disabled -width 26 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
652 pack .ctop.top.bar.rightbut -side left -fill y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
653 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
654 ttk::button .ctop.top.bar.findbut -text "Find" -command dofind |
267 | 655 pack .ctop.top.bar.findbut -side left |
656 set findstring {} | |
657 set fstring .ctop.top.bar.findstring | |
658 lappend entries $fstring | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
659 ttk::entry $fstring -width 30 -font $textfont -textvariable findstring |
267 | 660 pack $fstring -side left -expand 1 -fill x |
661 set findtype Exact | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
662 set findtypemenu [ttk::optionMenu .ctop.top.bar.findtype \ |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
663 findtype Exact IgnCase Regexp] |
267 | 664 set findloc "All fields" |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
665 ttk::optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ |
18801
c84cc0f3364a
hgk: drop committer field from the UI
Andrew Shadura <bugzilla@tut.by>
parents:
18561
diff
changeset
|
666 Comments Author Files Pickaxe |
267 | 667 pack .ctop.top.bar.findloc -side right |
668 pack .ctop.top.bar.findtype -side right | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
669 # for making sure type==Exact whenever loc==Pickaxe |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
670 trace add variable findloc write findlocchange |
267 | 671 |
672 panedwindow .ctop.cdet -orient horizontal | |
673 .ctop add .ctop.cdet | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
674 ttk::frame .ctop.cdet.left |
267 | 675 set ctext .ctop.cdet.left.ctext |
7745
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
676 text $ctext -fg $fgcolor -bg $bgcolor -state disabled -font $textfont \ |
267 | 677 -width $geometry(ctextw) -height $geometry(ctexth) \ |
1430
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
678 -yscrollcommand ".ctop.cdet.left.sb set" \ |
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
679 -xscrollcommand ".ctop.cdet.left.hb set" -wrap none |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
680 ttk::scrollbar .ctop.cdet.left.sb -command "$ctext yview" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
681 ttk::scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview" |
267 | 682 pack .ctop.cdet.left.sb -side right -fill y |
1430
c91966c3bbf5
hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents:
1429
diff
changeset
|
683 pack .ctop.cdet.left.hb -side bottom -fill x |
267 | 684 pack $ctext -side left -fill both -expand 1 |
685 .ctop.cdet add .ctop.cdet.left | |
686 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
687 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
688 if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
689 $ctext tag conf hunksep -back blue -fore white |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
690 $ctext tag conf d0 -back "#ff8080" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
691 $ctext tag conf d1 -back green |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
692 } else { |
7746
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
693 $ctext tag conf hunksep -fore $hunksepcolor |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
694 $ctext tag conf d0 -fore $diffremcolor |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
695 $ctext tag conf d1 -fore $diffaddcolor |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
696 |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
697 # The mX colours seem to be used in merge changesets, where m0 |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
698 # is first parent, m1 is second parent and so on. Git can have |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
699 # several parents, Hg cannot, so I think the m2..mmax would be |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
700 # unused. |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
701 $ctext tag conf m0 -fore $diffmerge1color |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
702 $ctext tag conf m1 -fore $diffmerge2color |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
703 $ctext tag conf m2 -fore green |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
704 $ctext tag conf m3 -fore purple |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
705 $ctext tag conf m4 -fore brown |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
706 $ctext tag conf mmax -fore darkgrey |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
707 set mergemax 5 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
708 $ctext tag conf mresult -font [concat $textfont bold] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
709 $ctext tag conf msep -font [concat $textfont bold] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
710 $ctext tag conf found -back yellow |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
711 } |
267 | 712 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
713 ttk::frame .ctop.cdet.right |
267 | 714 set cflist .ctop.cdet.right.cfiles |
7745
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
715 listbox $cflist -fg $fgcolor -bg $bgcolor \ |
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
716 -selectmode extended -width $geometry(cflistw) \ |
267 | 717 -yscrollcommand ".ctop.cdet.right.sb set" |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
718 ttk::scrollbar .ctop.cdet.right.sb -command "$cflist yview" |
267 | 719 pack .ctop.cdet.right.sb -side right -fill y |
720 pack $cflist -side left -fill both -expand 1 | |
721 .ctop.cdet add .ctop.cdet.right | |
722 bind .ctop.cdet <Configure> {resizecdetpanes %W %w} | |
723 | |
724 pack .ctop -side top -fill both -expand 1 | |
725 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
726 bindall <1> {selcanvline %W %x %y} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
727 #bindall <B1-Motion> {selcanvline %W %x %y} |
4968
713426631adf
hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents:
4741
diff
changeset
|
728 bindall <MouseWheel> "allcansmousewheel %D" |
267 | 729 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" |
730 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" | |
731 bindall <2> "allcanvs scan mark 0 %y" | |
732 bindall <B2-Motion> "allcanvs scan dragto 0 %y" | |
733 bind . <Key-Up> "selnextline -1" | |
734 bind . <Key-Down> "selnextline 1" | |
735 bind . <Key-Prior> "allcanvs yview scroll -1 pages" | |
736 bind . <Key-Next> "allcanvs yview scroll 1 pages" | |
737 bindkey <Key-Delete> "$ctext yview scroll -1 pages" | |
738 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages" | |
739 bindkey <Key-space> "$ctext yview scroll 1 pages" | |
740 bindkey p "selnextline -1" | |
741 bindkey n "selnextline 1" | |
742 bindkey b "$ctext yview scroll -1 pages" | |
743 bindkey d "$ctext yview scroll 18 units" | |
744 bindkey u "$ctext yview scroll -18 units" | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
745 bindkey / {findnext 1} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
746 bindkey <Key-Return> {findnext 0} |
267 | 747 bindkey ? findprev |
748 bindkey f nextfile | |
749 bind . <Control-q> doquit | |
1429
45bd7925dceb
Add control-w key binding to quit hgk.
Eric Bloodworth <ergosys@gmail.com>
parents:
1361
diff
changeset
|
750 bind . <Control-w> doquit |
267 | 751 bind . <Control-f> dofind |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
752 bind . <Control-g> {findnext 0} |
267 | 753 bind . <Control-r> findprev |
754 bind . <Control-equal> {incrfont 1} | |
755 bind . <Control-KP_Add> {incrfont 1} | |
756 bind . <Control-minus> {incrfont -1} | |
757 bind . <Control-KP_Subtract> {incrfont -1} | |
758 bind $cflist <<ListboxSelect>> listboxsel | |
759 bind . <Destroy> {savestuff %W} | |
760 bind . <Button-1> "click %W" | |
761 bind $fstring <Key-Return> dofind | |
762 bind $sha1entry <Key-Return> gotocommit | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
763 bind $sha1entry <<PasteSelection>> clearsha1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
764 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
765 set maincursor [. cget -cursor] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
766 set textcursor [$ctext cget -cursor] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
767 set curtextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
768 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
769 set rowctxmenu .rowctxmenu |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
770 menu $rowctxmenu -tearoff 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
771 $rowctxmenu add command -label "Diff this -> selected" \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
772 -command {diffvssel 0} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
773 $rowctxmenu add command -label "Diff selected -> this" \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
774 -command {diffvssel 1} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
775 $rowctxmenu add command -label "Make patch" -command mkpatch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
776 $rowctxmenu add command -label "Create tag" -command mktag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
777 $rowctxmenu add command -label "Write commit to file" -command writecommit |
5394
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
778 if { $hgvdiff ne "" } { |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
779 $rowctxmenu add command -label "Visual diff with parent" \ |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
780 -command {vdiff 1} |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
781 $rowctxmenu add command -label "Visual diff with selected" \ |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
782 -command {vdiff 0} |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
783 } |
267 | 784 } |
785 | |
786 # when we make a key binding for the toplevel, make sure | |
787 # it doesn't get triggered when that key is pressed in the | |
788 # find string entry widget. | |
789 proc bindkey {ev script} { | |
790 global entries | |
791 bind . $ev $script | |
792 set escript [bind Entry $ev] | |
793 if {$escript == {}} { | |
794 set escript [bind Entry <Key>] | |
795 } | |
796 foreach e $entries { | |
797 bind $e $ev "$escript; break" | |
798 } | |
799 } | |
800 | |
801 # set the focus back to the toplevel for any click outside | |
802 # the entry widgets | |
803 proc click {w} { | |
804 global entries | |
805 foreach e $entries { | |
806 if {$w == $e} return | |
807 } | |
808 focus . | |
809 } | |
810 | |
811 proc savestuff {w} { | |
812 global canv canv2 canv3 ctext cflist mainfont textfont | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
813 global stuffsaved findmergefiles gaudydiff maxgraphpct |
7745
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
814 global maxwidth authorcolors curidfont bgcolor fgcolor |
7746
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
815 global diffremcolor diffaddcolor hunksepcolor |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
816 global diffmerge1color diffmerge2color |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
817 |
267 | 818 if {$stuffsaved} return |
819 if {![winfo viewable .]} return | |
820 catch { | |
5506
be20a42f27a1
hgk: change config file from .gitk to .hgk
bdowning@lavos.net
parents:
5464
diff
changeset
|
821 set f [open "~/.hgk-new" w] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
822 puts $f [list set mainfont $mainfont] |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
823 puts $f [list set curidfont $curidfont] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
824 puts $f [list set textfont $textfont] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
825 puts $f [list set findmergefiles $findmergefiles] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
826 puts $f [list set gaudydiff $gaudydiff] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
827 puts $f [list set maxgraphpct $maxgraphpct] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
828 puts $f [list set maxwidth $maxwidth] |
267 | 829 puts $f "set geometry(width) [winfo width .ctop]" |
830 puts $f "set geometry(height) [winfo height .ctop]" | |
831 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" | |
832 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]" | |
833 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]" | |
834 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]" | |
835 set wid [expr {([winfo width $ctext] - 8) \ | |
836 / [font measure $textfont "0"]}] | |
837 puts $f "set geometry(ctextw) $wid" | |
838 set wid [expr {([winfo width $cflist] - 11) \ | |
839 / [font measure [$cflist cget -font] "0"]}] | |
840 puts $f "set geometry(cflistw) $wid" | |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
841 puts $f "#" |
12634
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
842 puts $f "# main window position:" |
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
843 puts $f "set posx [winfo x .]" |
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
844 puts $f "set posy [winfo y .]" |
43f42de733d0
hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents:
9989
diff
changeset
|
845 puts $f "#" |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
846 puts $f "# authorcolors format:" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
847 puts $f "#" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
848 puts $f "# zero or more sublists of" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
849 puts $f "#" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
850 puts $f "# { regex color }" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
851 puts $f "#" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
852 puts $f "# followed by a list of colors" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
853 puts $f "#" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
854 puts $f "# If the commit author matches a regex in a sublist," |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
855 puts $f "# the commit will be colored by that color" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
856 puts $f "# otherwise the next unused entry from the list of colors" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
857 puts $f "# will be assigned to this commit and also all other commits" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
858 puts $f "# of the same author. When the list of colors is exhausted," |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
859 puts $f "# the last entry will be reused." |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
860 puts $f "#" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
861 puts $f "set authorcolors {$authorcolors}" |
7747
5f7512f680cb
hgk: added explanation to .hgk for background colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7746
diff
changeset
|
862 puts $f "#" |
5f7512f680cb
hgk: added explanation to .hgk for background colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7746
diff
changeset
|
863 puts $f "# The background color in the text windows" |
7738
db366ec8d0a4
hgk: Add background colour setting
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7039
diff
changeset
|
864 puts $f "set bgcolor $bgcolor" |
7745
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
865 puts $f "#" |
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
866 puts $f "# The text color used in the diff and file list view" |
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
867 puts $f "set fgcolor $fgcolor" |
7746
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
868 puts $f "#" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
869 puts $f "# Color to display + lines in diffs" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
870 puts $f "set diffaddcolor $diffaddcolor" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
871 puts $f "#" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
872 puts $f "# Color to display - lines in diffs" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
873 puts $f "set diffremcolor $diffremcolor" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
874 puts $f "#" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
875 puts $f "# Merge diffs: Color to signal lines from first parent" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
876 puts $f "set diffmerge1color $diffmerge1color" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
877 puts $f "#" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
878 puts $f "# Merge diffs: Color to signal lines from second parent" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
879 puts $f "set diffmerge2color $diffmerge2color" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
880 puts $f "#" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
881 puts $f "# Hunkseparator (@@ -lineno,lines +lineno,lines @@) color" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
882 puts $f "set hunksepcolor $hunksepcolor" |
267 | 883 close $f |
5506
be20a42f27a1
hgk: change config file from .gitk to .hgk
bdowning@lavos.net
parents:
5464
diff
changeset
|
884 file rename -force "~/.hgk-new" "~/.hgk" |
267 | 885 } |
886 set stuffsaved 1 | |
887 } | |
888 | |
889 proc resizeclistpanes {win w} { | |
890 global oldwidth | |
891 if [info exists oldwidth($win)] { | |
892 set s0 [$win sash coord 0] | |
893 set s1 [$win sash coord 1] | |
894 if {$w < 60} { | |
895 set sash0 [expr {int($w/2 - 2)}] | |
896 set sash1 [expr {int($w*5/6 - 2)}] | |
897 } else { | |
898 set factor [expr {1.0 * $w / $oldwidth($win)}] | |
899 set sash0 [expr {int($factor * [lindex $s0 0])}] | |
900 set sash1 [expr {int($factor * [lindex $s1 0])}] | |
901 if {$sash0 < 30} { | |
902 set sash0 30 | |
903 } | |
904 if {$sash1 < $sash0 + 20} { | |
905 set sash1 [expr $sash0 + 20] | |
906 } | |
907 if {$sash1 > $w - 10} { | |
908 set sash1 [expr $w - 10] | |
909 if {$sash0 > $sash1 - 20} { | |
910 set sash0 [expr $sash1 - 20] | |
911 } | |
912 } | |
913 } | |
914 $win sash place 0 $sash0 [lindex $s0 1] | |
915 $win sash place 1 $sash1 [lindex $s1 1] | |
916 } | |
917 set oldwidth($win) $w | |
918 } | |
919 | |
920 proc resizecdetpanes {win w} { | |
921 global oldwidth | |
922 if [info exists oldwidth($win)] { | |
923 set s0 [$win sash coord 0] | |
924 if {$w < 60} { | |
925 set sash0 [expr {int($w*3/4 - 2)}] | |
926 } else { | |
927 set factor [expr {1.0 * $w / $oldwidth($win)}] | |
928 set sash0 [expr {int($factor * [lindex $s0 0])}] | |
929 if {$sash0 < 45} { | |
930 set sash0 45 | |
931 } | |
932 if {$sash0 > $w - 15} { | |
933 set sash0 [expr $w - 15] | |
934 } | |
935 } | |
936 $win sash place 0 $sash0 [lindex $s0 1] | |
937 } | |
938 set oldwidth($win) $w | |
939 } | |
940 | |
941 proc allcanvs args { | |
942 global canv canv2 canv3 | |
943 eval $canv $args | |
944 eval $canv2 $args | |
945 eval $canv3 $args | |
946 } | |
947 | |
948 proc bindall {event action} { | |
949 global canv canv2 canv3 | |
950 bind $canv $event $action | |
951 bind $canv2 $event $action | |
952 bind $canv3 $event $action | |
953 } | |
954 | |
955 proc about {} { | |
956 set w .about | |
957 if {[winfo exists $w]} { | |
958 raise $w | |
959 return | |
960 } | |
961 toplevel $w | |
13380
d11405848abd
hgk: gitk->hgk in About... menu
Javi Merino <cibervicho@gmail.com>
parents:
12634
diff
changeset
|
962 wm title $w "About hgk" |
267 | 963 message $w.m -text { |
13380
d11405848abd
hgk: gitk->hgk in About... menu
Javi Merino <cibervicho@gmail.com>
parents:
12634
diff
changeset
|
964 Hgk version 1.2 |
267 | 965 |
966 Copyright © 2005 Paul Mackerras | |
967 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
968 Use and redistribute under the terms of the GNU General Public License} \ |
267 | 969 -justify center -aspect 400 |
970 pack $w.m -side top -fill x -padx 20 -pady 20 | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
971 ttk::button $w.ok -text Close -command "destroy $w" |
267 | 972 pack $w.ok -side bottom |
18804 | 973 popupify $w |
267 | 974 } |
975 | |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
976 set aunextcolor 0 |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
977 proc assignauthorcolor {name} { |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
978 global authorcolors aucolormap aunextcolor |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
979 if [info exists aucolormap($name)] return |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
980 |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
981 set randomcolors {black} |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
982 for {set i 0} {$i < [llength $authorcolors]} {incr i} { |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
983 set col [lindex $authorcolors $i] |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
984 if {[llength $col] > 1} { |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
985 set re [lindex $col 0] |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
986 set c [lindex $col 1] |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
987 if {[regexp -- $re $name]} { |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
988 set aucolormap($name) $c |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
989 return |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
990 } |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
991 } else { |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
992 set randomcolors [lrange $authorcolors $i end] |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
993 break |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
994 } |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
995 } |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
996 |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
997 set ncolors [llength $randomcolors] |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
998 set c [lindex $randomcolors $aunextcolor] |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
999 if {[incr aunextcolor] >= $ncolors} { |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1000 incr aunextcolor -1 |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1001 } |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1002 set aucolormap($name) $c |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1003 } |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1004 |
267 | 1005 proc assigncolor {id} { |
1006 global commitinfo colormap commcolors colors nextcolor | |
1007 global parents nparents children nchildren | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1008 global cornercrossings crossings |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1009 |
267 | 1010 if [info exists colormap($id)] return |
1011 set ncolors [llength $colors] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1012 if {$nparents($id) <= 1 && $nchildren($id) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1013 set child [lindex $children($id) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1014 if {[info exists colormap($child)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1015 && $nparents($child) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1016 set colormap($id) $colormap($child) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1017 return |
267 | 1018 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1019 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1020 set badcolors {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1021 if {[info exists cornercrossings($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1022 foreach x $cornercrossings($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1023 if {[info exists colormap($x)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1024 && [lsearch -exact $badcolors $colormap($x)] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1025 lappend badcolors $colormap($x) |
267 | 1026 } |
1027 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1028 if {[llength $badcolors] >= $ncolors} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1029 set badcolors {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1030 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1031 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1032 set origbad $badcolors |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1033 if {[llength $badcolors] < $ncolors - 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1034 if {[info exists crossings($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1035 foreach x $crossings($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1036 if {[info exists colormap($x)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1037 && [lsearch -exact $badcolors $colormap($x)] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1038 lappend badcolors $colormap($x) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1039 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1040 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1041 if {[llength $badcolors] >= $ncolors} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1042 set badcolors $origbad |
267 | 1043 } |
1044 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1045 set origbad $badcolors |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1046 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1047 if {[llength $badcolors] < $ncolors - 1} { |
267 | 1048 foreach child $children($id) { |
1049 if {[info exists colormap($child)] | |
1050 && [lsearch -exact $badcolors $colormap($child)] < 0} { | |
1051 lappend badcolors $colormap($child) | |
1052 } | |
1053 if {[info exists parents($child)]} { | |
1054 foreach p $parents($child) { | |
1055 if {[info exists colormap($p)] | |
1056 && [lsearch -exact $badcolors $colormap($p)] < 0} { | |
1057 lappend badcolors $colormap($p) | |
1058 } | |
1059 } | |
1060 } | |
1061 } | |
1062 if {[llength $badcolors] >= $ncolors} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1063 set badcolors $origbad |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1064 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1065 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1066 for {set i 0} {$i <= $ncolors} {incr i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1067 set c [lindex $colors $nextcolor] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1068 if {[incr nextcolor] >= $ncolors} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1069 set nextcolor 0 |
267 | 1070 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1071 if {[lsearch -exact $badcolors $c]} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1072 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1073 set colormap($id) $c |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1074 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1075 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1076 proc initgraph {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1077 global canvy canvy0 lineno numcommits nextcolor linespc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1078 global mainline mainlinearrow sidelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1079 global nchildren ncleft |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1080 global displist nhyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1081 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1082 allcanvs delete all |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1083 set nextcolor 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1084 set canvy $canvy0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1085 set lineno -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1086 set numcommits 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1087 catch {unset mainline} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1088 catch {unset mainlinearrow} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1089 catch {unset sidelines} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1090 foreach id [array names nchildren] { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1091 set ncleft($id) $nchildren($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1092 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1093 set displist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1094 set nhyperspace 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1095 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1096 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1097 proc bindline {t id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1098 global canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1099 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1100 $canv bind $t <Enter> "lineenter %x %y $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1101 $canv bind $t <Motion> "linemotion %x %y $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1102 $canv bind $t <Leave> "lineleave $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1103 $canv bind $t <Button-1> "lineclick %x %y $id 1" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1104 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1105 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1106 proc drawlines {id xtra} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1107 global mainline mainlinearrow sidelines lthickness colormap canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1108 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1109 $canv delete lines.$id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1110 if {[info exists mainline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1111 set t [$canv create line $mainline($id) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1112 -width [expr {($xtra + 1) * $lthickness}] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1113 -fill $colormap($id) -tags lines.$id \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1114 -arrow $mainlinearrow($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1115 $canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1116 bindline $t $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1117 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1118 if {[info exists sidelines($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1119 foreach ls $sidelines($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1120 set coords [lindex $ls 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1121 set thick [lindex $ls 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1122 set arrow [lindex $ls 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1123 set t [$canv create line $coords -fill $colormap($id) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1124 -width [expr {($thick + $xtra) * $lthickness}] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1125 -arrow $arrow -tags lines.$id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1126 $canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1127 bindline $t $id |
267 | 1128 } |
1129 } | |
1130 } | |
1131 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1132 # level here is an index in displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1133 proc drawcommitline {level} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1134 global parents children nparents displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1135 global canv canv2 canv3 mainfont namefont canvy linespc |
267 | 1136 global lineid linehtag linentag linedtag commitinfo |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1137 global colormap numcommits currentparents dupparents |
13461 | 1138 global idtags idline idheads idotherrefs idbookmarks |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1139 global lineno lthickness mainline mainlinearrow sidelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1140 global commitlisted rowtextx idpos lastuse displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1141 global oldnlines olddlevel olddisplist |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1142 global aucolormap curid curidfont |
267 | 1143 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1144 incr numcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1145 incr lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1146 set id [lindex $displist $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1147 set lastuse($id) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1148 set lineid($lineno) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1149 set idline($id) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1150 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1151 if {![info exists commitinfo($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1152 readcommit $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1153 if {![info exists commitinfo($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1154 set commitinfo($id) {"No commit information available"} |
267 | 1155 set nparents($id) 0 |
1156 } | |
1157 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1158 assigncolor $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1159 set currentparents {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1160 set dupparents {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1161 if {[info exists commitlisted($id)] && [info exists parents($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1162 foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1163 if {[lsearch -exact $currentparents $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1164 lappend currentparents $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1165 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1166 # remember that this parent was listed twice |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1167 lappend dupparents $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1168 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1169 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1170 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1171 set x [xcoord $level $level $lineno] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1172 set y1 $canvy |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1173 set canvy [expr $canvy + $linespc] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1174 allcanvs conf -scrollregion \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1175 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1176 if {[info exists mainline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1177 lappend mainline($id) $x $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1178 if {$mainlinearrow($id) ne "none"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1179 set mainline($id) [trimdiagstart $mainline($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1180 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1181 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1182 drawlines $id 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1183 set orad [expr {$linespc / 3}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1184 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1185 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1186 -fill $ofill -outline black -width 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1187 $canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1188 $canv bind $t <1> {selcanvline {} %x %y} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1189 set xt [xcoord [llength $displist] $level $lineno] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1190 if {[llength $currentparents] > 2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1191 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1192 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1193 set rowtextx($lineno) $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1194 set idpos($id) [list $x $xt $y1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1195 if {[info exists idtags($id)] || [info exists idheads($id)] |
13461 | 1196 || [info exists idotherrefs($id)] || [info exists idbookmarks($id)]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1197 set xt [drawtags $id $x $xt $y1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1198 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1199 set headline [lindex $commitinfo($id) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1200 set name [lindex $commitinfo($id) 1] |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1201 assignauthorcolor $name |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1202 set fg $aucolormap($name) |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1203 if {$id == $curid} { |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1204 set fn $curidfont |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1205 } else { |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1206 set fn $mainfont |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1207 } |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1208 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1209 set date [lindex $commitinfo($id) 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1210 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \ |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1211 -text $headline -font $fn \ |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1212 -fill $fg] |
5392
66d7aabf5b41
hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents:
5284
diff
changeset
|
1213 $canv bind $linehtag($lineno) <<B3>> "rowmenu %X %Y $id" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1214 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \ |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1215 -text $name -font $namefont \ |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1216 -fill $fg] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1217 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \ |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1218 -text $date -font $mainfont \ |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
1219 -fill $fg] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1220 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1221 set olddlevel $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1222 set olddisplist $displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1223 set oldnlines [llength $displist] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1224 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1225 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1226 proc drawtags {id x xt y1} { |
13462
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1227 global bookmarkcurrent idtags idbookmarks idheads idotherrefs commitinfo |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1228 global linespc lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1229 global canv mainfont idline rowtextx |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1230 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1231 set marks {} |
13462
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1232 set nbookmarks 0 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1233 set ntags 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1234 set nheads 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1235 if {[info exists idtags($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1236 set marks $idtags($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1237 set ntags [llength $marks] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1238 } |
13462
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1239 if {[info exists idbookmarks($id)]} { |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1240 set marks [concat $marks $idbookmarks($id)] |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1241 set nbookmarks [llength $idbookmarks($id)] |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1242 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1243 if {[info exists idheads($id)]} { |
7039
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
1244 set headmark [lindex $commitinfo($id) 7] |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
1245 if {$headmark ne "default"} { |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
1246 lappend marks $headmark |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
1247 set nheads 1 |
aafe12bd7174
hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents:
6361
diff
changeset
|
1248 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1249 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1250 if {$marks eq {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1251 return $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1252 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1253 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1254 set delta [expr {int(0.5 * ($linespc - $lthickness))}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1255 set yt [expr $y1 - 0.5 * $linespc] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1256 set yb [expr $yt + $linespc - 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1257 set xvals {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1258 set wvals {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1259 foreach tag $marks { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1260 set wid [font measure $mainfont $tag] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1261 lappend xvals $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1262 lappend wvals $wid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1263 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1264 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1265 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1266 -width $lthickness -fill black -tags tag.$id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1267 $canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1268 foreach tag $marks x $xvals wid $wvals { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1269 set xl [expr $x + $delta] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1270 set xr [expr $x + $delta + $wid + $lthickness] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1271 if {[incr ntags -1] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1272 # draw a tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1273 set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1274 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1275 -width 1 -outline black -fill yellow -tags tag.$id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1276 $canv bind $t <1> [list showtag $tag 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1277 set rowtextx($idline($id)) [expr {$xr + $linespc}] |
13462
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1278 } elseif {[incr nbookmarks -1] >= 0} { |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1279 # draw a tag |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1280 set col gray50 |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1281 if {[string compare $bookmarkcurrent $tag] == 0} { |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1282 set col gray |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1283 } |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1284 set xl [expr $xl - $delta/2] |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1285 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1286 -width 1 -outline black -fill $col -tags tag.$id |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1287 } else { |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1288 # draw a head or other ref |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1289 if {[incr nheads -1] >= 0} { |
17960
d0d99c8bdf51
hgk: specify some colours explicitly in hex
Andrew Shadura <bugzilla@tut.by>
parents:
17958
diff
changeset
|
1290 set col "#00ff00" |
13462
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1291 } else { |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1292 set col "#ddddff" |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1293 } |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1294 set xl [expr $xl - $delta/2] |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1295 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ |
8641cb094c81
hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents:
13461
diff
changeset
|
1296 -width 1 -outline black -fill $col -tags tag.$id |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1297 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1298 set t [$canv create text $xl $y1 -anchor w -text $tag \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1299 -font $mainfont -tags tag.$id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1300 if {$ntags >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1301 $canv bind $t <1> [list showtag $tag 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1302 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1303 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1304 return $xt |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1305 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1306 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1307 proc notecrossings {id lo hi corner} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1308 global olddisplist crossings cornercrossings |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1309 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1310 for {set i $lo} {[incr i] < $hi} {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1311 set p [lindex $olddisplist $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1312 if {$p == {}} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1313 if {$i == $corner} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1314 if {![info exists cornercrossings($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1315 || [lsearch -exact $cornercrossings($id) $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1316 lappend cornercrossings($id) $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1317 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1318 if {![info exists cornercrossings($p)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1319 || [lsearch -exact $cornercrossings($p) $id] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1320 lappend cornercrossings($p) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1321 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1322 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1323 if {![info exists crossings($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1324 || [lsearch -exact $crossings($id) $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1325 lappend crossings($id) $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1326 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1327 if {![info exists crossings($p)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1328 || [lsearch -exact $crossings($p) $id] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1329 lappend crossings($p) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1330 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1331 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1332 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1333 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1334 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1335 proc xcoord {i level ln} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1336 global canvx0 xspc1 xspc2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1337 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1338 set x [expr {$canvx0 + $i * $xspc1($ln)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1339 if {$i > 0 && $i == $level} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1340 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1341 } elseif {$i > $level} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1342 set x [expr {$x + $xspc2 - $xspc1($ln)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1343 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1344 return $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1345 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1346 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1347 # it seems Tk can't draw arrows on the end of diagonal line segments... |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1348 proc trimdiagend {line} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1349 while {[llength $line] > 4} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1350 set x1 [lindex $line end-3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1351 set y1 [lindex $line end-2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1352 set x2 [lindex $line end-1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1353 set y2 [lindex $line end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1354 if {($x1 == $x2) != ($y1 == $y2)} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1355 set line [lreplace $line end-1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1356 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1357 return $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1358 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1359 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1360 proc trimdiagstart {line} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1361 while {[llength $line] > 4} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1362 set x1 [lindex $line 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1363 set y1 [lindex $line 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1364 set x2 [lindex $line 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1365 set y2 [lindex $line 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1366 if {($x1 == $x2) != ($y1 == $y2)} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1367 set line [lreplace $line 0 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1368 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1369 return $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1370 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1371 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1372 proc drawslants {id needonscreen nohs} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1373 global canv mainline mainlinearrow sidelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1374 global canvx0 canvy xspc1 xspc2 lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1375 global currentparents dupparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1376 global lthickness linespc canvy colormap lineno geometry |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1377 global maxgraphpct maxwidth |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1378 global displist onscreen lastuse |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1379 global parents commitlisted |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1380 global oldnlines olddlevel olddisplist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1381 global nhyperspace numcommits nnewparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1382 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1383 if {$lineno < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1384 lappend displist $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1385 set onscreen($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1386 return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1387 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1388 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1389 set y1 [expr {$canvy - $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1390 set y2 $canvy |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1391 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1392 # work out what we need to get back on screen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1393 set reins {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1394 if {$onscreen($id) < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1395 # next to do isn't displayed, better get it on screen... |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1396 lappend reins [list $id 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1397 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1398 # make sure all the previous commits's parents are on the screen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1399 foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1400 if {$onscreen($p) < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1401 lappend reins [list $p 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1402 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1403 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1404 # bring back anything requested by caller |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1405 if {$needonscreen ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1406 lappend reins $needonscreen |
267 | 1407 } |
1408 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1409 # try the shortcut |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1410 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1411 set dlevel $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1412 set x [xcoord $dlevel $dlevel $lineno] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1413 set mainline($id) [list $x $y1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1414 set mainlinearrow($id) none |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1415 set lastuse($id) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1416 set displist [lreplace $displist $dlevel $dlevel $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1417 set onscreen($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1418 set xspc1([expr {$lineno + 1}]) $xspc1($lineno) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1419 return $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1420 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1421 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1422 # update displist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1423 set displist [lreplace $displist $olddlevel $olddlevel] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1424 set j $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1425 foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1426 set lastuse($p) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1427 if {$onscreen($p) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1428 set displist [linsert $displist $j $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1429 set onscreen($p) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1430 incr j |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1431 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1432 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1433 if {$onscreen($id) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1434 lappend displist $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1435 set onscreen($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1436 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1437 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1438 # remove the null entry if present |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1439 set nullentry [lsearch -exact $displist {}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1440 if {$nullentry >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1441 set displist [lreplace $displist $nullentry $nullentry] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1442 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1443 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1444 # bring back the ones we need now (if we did it earlier |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1445 # it would change displist and invalidate olddlevel) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1446 foreach pi $reins { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1447 # test again in case of duplicates in reins |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1448 set p [lindex $pi 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1449 if {$onscreen($p) < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1450 set onscreen($p) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1451 set lastuse($p) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1452 set displist [linsert $displist [lindex $pi 1] $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1453 incr nhyperspace -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1454 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1455 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1456 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1457 set lastuse($id) $lineno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1458 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1459 # see if we need to make any lines jump off into hyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1460 set displ [llength $displist] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1461 if {$displ > $maxwidth} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1462 set ages {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1463 foreach x $displist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1464 lappend ages [list $lastuse($x) $x] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1465 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1466 set ages [lsort -integer -index 0 $ages] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1467 set k 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1468 while {$displ > $maxwidth} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1469 set use [lindex $ages $k 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1470 set victim [lindex $ages $k 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1471 if {$use >= $lineno - 5} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1472 incr k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1473 if {[lsearch -exact $nohs $victim] >= 0} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1474 set i [lsearch -exact $displist $victim] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1475 set displist [lreplace $displist $i $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1476 set onscreen($victim) -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1477 incr nhyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1478 incr displ -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1479 if {$i < $nullentry} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1480 incr nullentry -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1481 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1482 set x [lindex $mainline($victim) end-1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1483 lappend mainline($victim) $x $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1484 set line [trimdiagend $mainline($victim)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1485 set arrow "last" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1486 if {$mainlinearrow($victim) ne "none"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1487 set line [trimdiagstart $line] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1488 set arrow "both" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1489 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1490 lappend sidelines($victim) [list $line 1 $arrow] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1491 unset mainline($victim) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1492 } |
267 | 1493 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1494 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1495 set dlevel [lsearch -exact $displist $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1496 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1497 # If we are reducing, put in a null entry |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1498 if {$displ < $oldnlines} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1499 # does the next line look like a merge? |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1500 # i.e. does it have > 1 new parent? |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1501 if {$nnewparents($id) > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1502 set i [expr {$dlevel + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1503 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1504 set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1505 if {$nullentry >= 0 && $nullentry < $i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1506 incr i -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1507 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1508 } elseif {$nullentry >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1509 set i $nullentry |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1510 while {$i < $displ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1511 && [lindex $olddisplist $i] == [lindex $displist $i]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1512 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1513 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1514 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1515 set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1516 if {$dlevel >= $i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1517 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1518 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1519 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1520 if {$i < $displ} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1521 set displist [linsert $displist $i {}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1522 incr displ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1523 if {$dlevel >= $i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1524 incr dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1525 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1526 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1527 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1528 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1529 # decide on the line spacing for the next line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1530 set lj [expr {$lineno + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1531 set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1532 if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1533 set xspc1($lj) $xspc2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1534 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1535 set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1536 if {$xspc1($lj) < $lthickness} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1537 set xspc1($lj) $lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1538 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1539 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1540 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1541 foreach idi $reins { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1542 set id [lindex $idi 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1543 set j [lsearch -exact $displist $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1544 set xj [xcoord $j $dlevel $lj] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1545 set mainline($id) [list $xj $y2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1546 set mainlinearrow($id) first |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1547 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1548 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1549 set i -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1550 foreach id $olddisplist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1551 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1552 if {$id == {}} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1553 if {$onscreen($id) <= 0} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1554 set xi [xcoord $i $olddlevel $lineno] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1555 if {$i == $olddlevel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1556 foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1557 set j [lsearch -exact $displist $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1558 set coords [list $xi $y1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1559 set xj [xcoord $j $dlevel $lj] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1560 if {$xj < $xi - $linespc} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1561 lappend coords [expr {$xj + $linespc}] $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1562 notecrossings $p $j $i [expr {$j + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1563 } elseif {$xj > $xi + $linespc} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1564 lappend coords [expr {$xj - $linespc}] $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1565 notecrossings $p $i $j [expr {$j - 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1566 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1567 if {[lsearch -exact $dupparents $p] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1568 # draw a double-width line to indicate the doubled parent |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1569 lappend coords $xj $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1570 lappend sidelines($p) [list $coords 2 none] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1571 if {![info exists mainline($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1572 set mainline($p) [list $xj $y2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1573 set mainlinearrow($p) none |
267 | 1574 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1575 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1576 # normal case, no parent duplicated |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1577 set yb $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1578 set dx [expr {abs($xi - $xj)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1579 if {0 && $dx < $linespc} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1580 set yb [expr {$y1 + $dx}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1581 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1582 if {![info exists mainline($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1583 if {$xi != $xj} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1584 lappend coords $xj $yb |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1585 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1586 set mainline($p) $coords |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1587 set mainlinearrow($p) none |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1588 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1589 lappend coords $xj $yb |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1590 if {$yb < $y2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1591 lappend coords $xj $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1592 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1593 lappend sidelines($p) [list $coords 1 none] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1594 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1595 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1596 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1597 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1598 set j $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1599 if {[lindex $displist $i] != $id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1600 set j [lsearch -exact $displist $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1601 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1602 if {$j != $i || $xspc1($lineno) != $xspc1($lj) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1603 || ($olddlevel < $i && $i < $dlevel) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1604 || ($dlevel < $i && $i < $olddlevel)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1605 set xj [xcoord $j $dlevel $lj] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1606 lappend mainline($id) $xi $y1 $xj $y2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1607 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1608 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1609 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1610 return $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1611 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1612 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1613 # search for x in a list of lists |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1614 proc llsearch {llist x} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1615 set i 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1616 foreach l $llist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1617 if {$l == $x || [lsearch -exact $l $x] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1618 return $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1619 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1620 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1621 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1622 return -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1623 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1624 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1625 proc drawmore {reading} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1626 global displayorder numcommits ncmupdate nextupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1627 global stopped nhyperspace parents commitlisted |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1628 global maxwidth onscreen displist currentparents olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1629 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1630 set n [llength $displayorder] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1631 while {$numcommits < $n} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1632 set id [lindex $displayorder $numcommits] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1633 set ctxend [expr {$numcommits + 10}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1634 if {!$reading && $ctxend > $n} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1635 set ctxend $n |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1636 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1637 set dlist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1638 if {$numcommits > 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1639 set dlist [lreplace $displist $olddlevel $olddlevel] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1640 set i $olddlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1641 foreach p $currentparents { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1642 if {$onscreen($p) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1643 set dlist [linsert $dlist $i $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1644 incr i |
267 | 1645 } |
1646 } | |
1647 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1648 set nohs {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1649 set reins {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1650 set isfat [expr {[llength $dlist] > $maxwidth}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1651 if {$nhyperspace > 0 || $isfat} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1652 if {$ctxend > $n} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1653 # work out what to bring back and |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1654 # what we want to don't want to send into hyperspace |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1655 set room 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1656 for {set k $numcommits} {$k < $ctxend} {incr k} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1657 set x [lindex $displayorder $k] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1658 set i [llsearch $dlist $x] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1659 if {$i < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1660 set i [llength $dlist] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1661 lappend dlist $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1662 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1663 if {[lsearch -exact $nohs $x] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1664 lappend nohs $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1665 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1666 if {$reins eq {} && $onscreen($x) < 0 && $room} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1667 set reins [list $x $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1668 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1669 set newp {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1670 if {[info exists commitlisted($x)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1671 set right 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1672 foreach p $parents($x) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1673 if {[llsearch $dlist $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1674 lappend newp $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1675 if {[lsearch -exact $nohs $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1676 lappend nohs $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1677 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1678 if {$reins eq {} && $onscreen($p) < 0 && $room} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1679 set reins [list $p [expr {$i + $right}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1680 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1681 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1682 set right 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1683 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1684 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1685 set l [lindex $dlist $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1686 if {[llength $l] == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1687 set l $newp |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1688 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1689 set j [lsearch -exact $l $x] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1690 set l [concat [lreplace $l $j $j] $newp] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1691 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1692 set dlist [lreplace $dlist $i $i $l] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1693 if {$room && $isfat && [llength $newp] <= 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1694 set room 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1695 } |
267 | 1696 } |
1697 } | |
1698 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1699 set dlevel [drawslants $id $reins $nohs] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1700 drawcommitline $dlevel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1701 if {[clock clicks -milliseconds] >= $nextupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1702 && $numcommits >= $ncmupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1703 doupdate $reading |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1704 if {$stopped} break |
267 | 1705 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1706 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1707 } |
267 | 1708 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1709 # level here is an index in todo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1710 proc updatetodo {level noshortcut} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1711 global ncleft todo nnewparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1712 global commitlisted parents onscreen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1713 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1714 set id [lindex $todo $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1715 set olds {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1716 if {[info exists commitlisted($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1717 foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1718 if {[lsearch -exact $olds $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1719 lappend olds $p |
267 | 1720 } |
1721 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1722 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1723 if {!$noshortcut && [llength $olds] == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1724 set p [lindex $olds 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1725 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1726 set ncleft($p) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1727 set todo [lreplace $todo $level $level $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1728 set onscreen($p) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1729 set nnewparents($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1730 return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1731 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1732 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1733 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1734 set todo [lreplace $todo $level $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1735 set i $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1736 set n 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1737 foreach p $olds { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1738 incr ncleft($p) -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1739 set k [lsearch -exact $todo $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1740 if {$k < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1741 set todo [linsert $todo $i $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1742 set onscreen($p) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1743 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1744 incr n |
267 | 1745 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1746 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1747 set nnewparents($id) $n |
267 | 1748 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1749 return 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1750 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1751 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1752 proc decidenext {{noread 0}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1753 global ncleft todo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1754 global datemode cdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1755 global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1756 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1757 # choose which one to do next time around |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1758 set todol [llength $todo] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1759 set level -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1760 set latest {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1761 for {set k $todol} {[incr k -1] >= 0} {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1762 set p [lindex $todo $k] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1763 if {$ncleft($p) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1764 if {$datemode} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1765 if {![info exists commitinfo($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1766 if {$noread} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1767 return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1768 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1769 readcommit $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1770 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1771 if {$latest == {} || $cdate($p) > $latest} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1772 set level $k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1773 set latest $cdate($p) |
267 | 1774 } |
1775 } else { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1776 set level $k |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1777 break |
267 | 1778 } |
1779 } | |
1780 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1781 if {$level < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1782 if {$todo != {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1783 puts "ERROR: none of the pending commits can be done yet:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1784 foreach p $todo { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1785 puts " $p ($ncleft($p))" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1786 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1787 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1788 return -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1789 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1790 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1791 return $level |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1792 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1793 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1794 proc drawcommit {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1795 global phase todo nchildren datemode nextupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1796 global numcommits ncmupdate displayorder todo onscreen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1797 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1798 if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1799 set phase incrdraw |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1800 set displayorder {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1801 set todo {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1802 initgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1803 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1804 if {$nchildren($id) == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1805 lappend todo $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1806 set onscreen($id) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1807 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1808 set level [decidenext 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1809 if {$level == {} || $id != [lindex $todo $level]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1810 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1811 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1812 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1813 lappend displayorder [lindex $todo $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1814 if {[updatetodo $level $datemode]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1815 set level [decidenext 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1816 if {$level == {}} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1817 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1818 set id [lindex $todo $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1819 if {![info exists commitlisted($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1820 break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1821 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1822 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1823 drawmore 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1824 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1825 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1826 proc finishcommits {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1827 global phase |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1828 global canv mainfont ctext maincursor textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1829 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1830 if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1831 $canv delete all |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1832 $canv create text 3 3 -anchor nw -text "No commits selected" \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1833 -font $mainfont -tags textitems |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1834 set phase {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1835 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1836 drawrest |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1837 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1838 . config -cursor $maincursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1839 settextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1840 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1841 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1842 # Don't change the text pane cursor if it is currently the hand cursor, |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1843 # showing that we are over a sha1 ID link. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1844 proc settextcursor {c} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1845 global ctext curtextcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1846 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1847 if {[$ctext cget -cursor] == $curtextcursor} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1848 $ctext config -cursor $c |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1849 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1850 set curtextcursor $c |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1851 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1852 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1853 proc drawgraph {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1854 global nextupdate startmsecs ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1855 global displayorder onscreen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1856 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1857 if {$displayorder == {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1858 set startmsecs [clock clicks -milliseconds] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1859 set nextupdate [expr $startmsecs + 100] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1860 set ncmupdate 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1861 initgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1862 foreach id $displayorder { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1863 set onscreen($id) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1864 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1865 drawmore 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1866 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1867 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1868 proc drawrest {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1869 global phase stopped redisplaying selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1870 global datemode todo displayorder |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1871 global numcommits ncmupdate |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1872 global nextupdate startmsecs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1873 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1874 set level [decidenext] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1875 if {$level >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1876 set phase drawgraph |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1877 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1878 lappend displayorder [lindex $todo $level] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1879 set hard [updatetodo $level $datemode] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1880 if {$hard} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1881 set level [decidenext] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1882 if {$level < 0} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1883 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1884 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1885 drawmore 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1886 } |
267 | 1887 set phase {} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1888 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1889 #puts "overall $drawmsecs ms for $numcommits commits" |
267 | 1890 if {$redisplaying} { |
1891 if {$stopped == 0 && [info exists selectedline]} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1892 selectline $selectedline 0 |
267 | 1893 } |
1894 if {$stopped == 1} { | |
1895 set stopped 0 | |
1896 after idle drawgraph | |
1897 } else { | |
1898 set redisplaying 0 | |
1899 } | |
1900 } | |
1901 } | |
1902 | |
1903 proc findmatches {f} { | |
1904 global findtype foundstring foundstrlen | |
1905 if {$findtype == "Regexp"} { | |
1906 set matches [regexp -indices -all -inline $foundstring $f] | |
1907 } else { | |
1908 if {$findtype == "IgnCase"} { | |
1909 set str [string tolower $f] | |
1910 } else { | |
1911 set str $f | |
1912 } | |
1913 set matches {} | |
1914 set i 0 | |
1915 while {[set j [string first $foundstring $str $i]] >= 0} { | |
1916 lappend matches [list $j [expr $j+$foundstrlen-1]] | |
1917 set i [expr $j + $foundstrlen] | |
1918 } | |
1919 } | |
1920 return $matches | |
1921 } | |
1922 | |
1923 proc dofind {} { | |
1924 global findtype findloc findstring markedmatches commitinfo | |
1925 global numcommits lineid linehtag linentag linedtag | |
1926 global mainfont namefont canv canv2 canv3 selectedline | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1927 global matchinglines foundstring foundstrlen |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1928 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1929 stopfindproc |
267 | 1930 unmarkmatches |
1931 focus . | |
1932 set matchinglines {} | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1933 if {$findloc == "Pickaxe"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1934 findpatches |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1935 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1936 } |
267 | 1937 if {$findtype == "IgnCase"} { |
1938 set foundstring [string tolower $findstring] | |
1939 } else { | |
1940 set foundstring $findstring | |
1941 } | |
1942 set foundstrlen [string length $findstring] | |
1943 if {$foundstrlen == 0} return | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1944 if {$findloc == "Files"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1945 findfiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1946 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1947 } |
267 | 1948 if {![info exists selectedline]} { |
1949 set oldsel -1 | |
1950 } else { | |
1951 set oldsel $selectedline | |
1952 } | |
1953 set didsel 0 | |
18801
c84cc0f3364a
hgk: drop committer field from the UI
Andrew Shadura <bugzilla@tut.by>
parents:
18561
diff
changeset
|
1954 set fldtypes {Headline Author Date CDate Comment} |
267 | 1955 for {set l 0} {$l < $numcommits} {incr l} { |
1956 set id $lineid($l) | |
1957 set info $commitinfo($id) | |
1958 set doesmatch 0 | |
1959 foreach f $info ty $fldtypes { | |
1960 if {$findloc != "All fields" && $findloc != $ty} { | |
1961 continue | |
1962 } | |
1963 set matches [findmatches $f] | |
1964 if {$matches == {}} continue | |
1965 set doesmatch 1 | |
1966 if {$ty == "Headline"} { | |
1967 markmatches $canv $l $f $linehtag($l) $matches $mainfont | |
1968 } elseif {$ty == "Author"} { | |
1969 markmatches $canv2 $l $f $linentag($l) $matches $namefont | |
1970 } elseif {$ty == "Date"} { | |
1971 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont | |
1972 } | |
1973 } | |
1974 if {$doesmatch} { | |
1975 lappend matchinglines $l | |
1976 if {!$didsel && $l > $oldsel} { | |
1977 findselectline $l | |
1978 set didsel 1 | |
1979 } | |
1980 } | |
1981 } | |
1982 if {$matchinglines == {}} { | |
1983 bell | |
1984 } elseif {!$didsel} { | |
1985 findselectline [lindex $matchinglines 0] | |
1986 } | |
1987 } | |
1988 | |
1989 proc findselectline {l} { | |
1990 global findloc commentend ctext | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
1991 selectline $l 1 |
267 | 1992 if {$findloc == "All fields" || $findloc == "Comments"} { |
1993 # highlight the matches in the comments | |
1994 set f [$ctext get 1.0 $commentend] | |
1995 set matches [findmatches $f] | |
1996 foreach match $matches { | |
1997 set start [lindex $match 0] | |
1998 set end [expr [lindex $match 1] + 1] | |
1999 $ctext tag add found "1.0 + $start c" "1.0 + $end c" | |
2000 } | |
2001 } | |
2002 } | |
2003 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2004 proc findnext {restart} { |
267 | 2005 global matchinglines selectedline |
2006 if {![info exists matchinglines]} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2007 if {$restart} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2008 dofind |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2009 } |
267 | 2010 return |
2011 } | |
2012 if {![info exists selectedline]} return | |
2013 foreach l $matchinglines { | |
2014 if {$l > $selectedline} { | |
2015 findselectline $l | |
2016 return | |
2017 } | |
2018 } | |
2019 bell | |
2020 } | |
2021 | |
2022 proc findprev {} { | |
2023 global matchinglines selectedline | |
2024 if {![info exists matchinglines]} { | |
2025 dofind | |
2026 return | |
2027 } | |
2028 if {![info exists selectedline]} return | |
2029 set prev {} | |
2030 foreach l $matchinglines { | |
2031 if {$l >= $selectedline} break | |
2032 set prev $l | |
2033 } | |
2034 if {$prev != {}} { | |
2035 findselectline $prev | |
2036 } else { | |
2037 bell | |
2038 } | |
2039 } | |
2040 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2041 proc findlocchange {name ix op} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2042 global findloc findtype findtypemenu |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2043 if {$findloc == "Pickaxe"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2044 set findtype Exact |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2045 set state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2046 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2047 set state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2048 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2049 $findtypemenu entryconf 1 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2050 $findtypemenu entryconf 2 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2051 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2052 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2053 proc stopfindproc {{done 0}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2054 global findprocpid findprocfile findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2055 global ctext findoldcursor phase maincursor textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2056 global findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2057 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2058 catch {unset findids} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2059 if {[info exists findprocpid]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2060 if {!$done} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2061 catch {exec kill $findprocpid} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2062 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2063 catch {close $findprocfile} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2064 unset findprocpid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2065 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2066 if {[info exists findinprogress]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2067 unset findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2068 if {$phase != "incrdraw"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2069 . config -cursor $maincursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2070 settextcursor $textcursor |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2071 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2072 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2073 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2074 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2075 proc findpatches {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2076 global findstring selectedline numcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2077 global findprocpid findprocfile |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2078 global finddidsel ctext lineid findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2079 global findinsertpos |
4688
39001f4b7d99
hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4502
diff
changeset
|
2080 global env |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2081 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2082 if {$numcommits == 0} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2083 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2084 # make a list of all the ids to search, starting at the one |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2085 # after the selected line (if any) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2086 if {[info exists selectedline]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2087 set l $selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2088 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2089 set l -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2090 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2091 set inputids {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2092 for {set i 0} {$i < $numcommits} {incr i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2093 if {[incr l] >= $numcommits} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2094 set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2095 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2096 append inputids $lineid($l) "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2097 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2098 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2099 if {[catch { |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
2100 set f [open [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree --stdin -s -r -S$findstring << $inputids] r] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2101 } err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2102 error_popup "Error starting search process: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2103 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2104 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2105 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2106 set findinsertpos end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2107 set findprocfile $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2108 set findprocpid [pid $f] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2109 fconfigure $f -blocking 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2110 fileevent $f readable readfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2111 set finddidsel 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2112 . config -cursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2113 settextcursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2114 set findinprogress 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2115 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2116 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2117 proc readfindproc {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2118 global findprocfile finddidsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2119 global idline matchinglines findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2120 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2121 set n [gets $findprocfile line] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2122 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2123 if {[eof $findprocfile]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2124 stopfindproc 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2125 if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2126 bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2127 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2128 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2129 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2130 } |
3059
3dab573a4330
hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents:
2297
diff
changeset
|
2131 if {![regexp {^[0-9a-f]{12}} $line id]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2132 error_popup "Can't parse git-diff-tree output: $line" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2133 stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2134 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2135 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2136 if {![info exists idline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2137 puts stderr "spurious id: $id" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2138 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2139 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2140 set l $idline($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2141 insertmatch $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2142 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2143 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2144 proc insertmatch {l id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2145 global matchinglines findinsertpos finddidsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2146 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2147 if {$findinsertpos == "end"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2148 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2149 set matchinglines [linsert $matchinglines 0 $l] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2150 set findinsertpos 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2151 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2152 lappend matchinglines $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2153 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2154 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2155 set matchinglines [linsert $matchinglines $findinsertpos $l] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2156 incr findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2157 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2158 markheadline $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2159 if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2160 findselectline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2161 set finddidsel 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2162 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2163 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2164 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2165 proc findfiles {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2166 global selectedline numcommits lineid ctext |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2167 global ffileline finddidsel parents nparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2168 global findinprogress findstartline findinsertpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2169 global treediffs fdiffids fdiffsneeded fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2170 global findmergefiles |
4688
39001f4b7d99
hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4502
diff
changeset
|
2171 global env |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2172 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2173 if {$numcommits == 0} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2174 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2175 if {[info exists selectedline]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2176 set l [expr {$selectedline + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2177 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2178 set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2179 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2180 set ffileline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2181 set findstartline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2182 set diffsneeded {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2183 set fdiffsneeded {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2184 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2185 set id $lineid($l) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2186 if {$findmergefiles || $nparents($id) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2187 foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2188 if {![info exists treediffs([list $id $p])]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2189 append diffsneeded "$id $p\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2190 lappend fdiffsneeded [list $id $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2191 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2192 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2193 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2194 if {[incr l] >= $numcommits} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2195 set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2196 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2197 if {$l == $findstartline} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2198 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2199 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2200 # start off a git-diff-tree process if needed |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2201 if {$diffsneeded ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2202 if {[catch { |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
2203 set df [open [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -r --stdin << $diffsneeded] r] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2204 } err ]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2205 error_popup "Error starting search process: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2206 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2207 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2208 catch {unset fdiffids} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2209 set fdiffpos 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2210 fconfigure $df -blocking 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2211 fileevent $df readable [list readfilediffs $df] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2212 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2213 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2214 set finddidsel 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2215 set findinsertpos end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2216 set id $lineid($l) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2217 set p [lindex $parents($id) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2218 . config -cursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2219 settextcursor watch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2220 set findinprogress 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2221 findcont [list $id $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2222 update |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2223 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2224 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2225 proc readfilediffs {df} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2226 global findids fdiffids fdiffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2227 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2228 set n [gets $df line] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2229 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2230 if {[eof $df]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2231 donefilediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2232 if {[catch {close $df} err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2233 stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2234 bell |
1278 | 2235 error_popup "Error in hg debug-diff-tree: $err" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2236 } elseif {[info exists findids]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2237 set ids $findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2238 stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2239 bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2240 error_popup "Couldn't find diffs for {$ids}" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2241 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2242 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2243 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2244 } |
3059
3dab573a4330
hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents:
2297
diff
changeset
|
2245 if {[regexp {^([0-9a-f]{12}) \(from ([0-9a-f]{12})\)} $line match id p]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2246 # start of a new string of diffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2247 donefilediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2248 set fdiffids [list $id $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2249 set fdiffs {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2250 } elseif {[string match ":*" $line]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2251 lappend fdiffs [lindex $line 5] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2252 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2253 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2254 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2255 proc donefilediff {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2256 global fdiffids fdiffs treediffs findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2257 global fdiffsneeded fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2258 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2259 if {[info exists fdiffids]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2260 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2261 && $fdiffpos < [llength $fdiffsneeded]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2262 # git-diff-tree doesn't output anything for a commit |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2263 # which doesn't change anything |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2264 set nullids [lindex $fdiffsneeded $fdiffpos] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2265 set treediffs($nullids) {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2266 if {[info exists findids] && $nullids eq $findids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2267 unset findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2268 findcont $nullids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2269 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2270 incr fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2271 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2272 incr fdiffpos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2273 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2274 if {![info exists treediffs($fdiffids)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2275 set treediffs($fdiffids) $fdiffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2276 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2277 if {[info exists findids] && $fdiffids eq $findids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2278 unset findids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2279 findcont $fdiffids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2280 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2281 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2282 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2283 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2284 proc findcont {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2285 global findids treediffs parents nparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2286 global ffileline findstartline finddidsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2287 global lineid numcommits matchinglines findinprogress |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2288 global findmergefiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2289 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2290 set id [lindex $ids 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2291 set p [lindex $ids 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2292 set pi [lsearch -exact $parents($id) $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2293 set l $ffileline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2294 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2295 if {$findmergefiles || $nparents($id) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2296 if {![info exists treediffs($ids)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2297 set findids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2298 set ffileline $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2299 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2300 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2301 set doesmatch 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2302 foreach f $treediffs($ids) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2303 set x [findmatches $f] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2304 if {$x != {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2305 set doesmatch 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2306 break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2307 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2308 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2309 if {$doesmatch} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2310 insertmatch $l $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2311 set pi $nparents($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2312 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2313 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2314 set pi $nparents($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2315 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2316 if {[incr pi] >= $nparents($id)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2317 set pi 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2318 if {[incr l] >= $numcommits} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2319 set l 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2320 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2321 if {$l == $findstartline} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2322 set id $lineid($l) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2323 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2324 set p [lindex $parents($id) $pi] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2325 set ids [list $id $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2326 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2327 stopfindproc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2328 if {!$finddidsel} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2329 bell |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2330 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2331 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2332 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2333 # mark a commit as matching by putting a yellow background |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2334 # behind the headline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2335 proc markheadline {l id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2336 global canv mainfont linehtag commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2337 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2338 set bbox [$canv bbox $linehtag($l)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2339 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2340 $canv lower $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2341 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2342 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2343 # mark the bits of a headline, author or date that match a find string |
267 | 2344 proc markmatches {canv l str tag matches font} { |
2345 set bbox [$canv bbox $tag] | |
2346 set x0 [lindex $bbox 0] | |
2347 set y0 [lindex $bbox 1] | |
2348 set y1 [lindex $bbox 3] | |
2349 foreach match $matches { | |
2350 set start [lindex $match 0] | |
2351 set end [lindex $match 1] | |
2352 if {$start > $end} continue | |
2353 set xoff [font measure $font [string range $str 0 [expr $start-1]]] | |
2354 set xlen [font measure $font [string range $str 0 [expr $end]]] | |
2355 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \ | |
2356 -outline {} -tags matches -fill yellow] | |
2357 $canv lower $t | |
2358 } | |
2359 } | |
2360 | |
2361 proc unmarkmatches {} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2362 global matchinglines findids |
267 | 2363 allcanvs delete matches |
2364 catch {unset matchinglines} | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2365 catch {unset findids} |
267 | 2366 } |
2367 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2368 proc selcanvline {w x y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2369 global canv canvy0 ctext linespc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2370 global lineid linehtag linentag linedtag rowtextx |
267 | 2371 set ymax [lindex [$canv cget -scrollregion] 3] |
2372 if {$ymax == {}} return | |
2373 set yfrac [lindex [$canv yview] 0] | |
2374 set y [expr {$y + $yfrac * $ymax}] | |
2375 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}] | |
2376 if {$l < 0} { | |
2377 set l 0 | |
2378 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2379 if {$w eq $canv} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2380 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2381 } |
267 | 2382 unmarkmatches |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2383 selectline $l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2384 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2385 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2386 proc commit_descriptor {p} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2387 global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2388 set l "..." |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2389 if {[info exists commitinfo($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2390 set l [lindex $commitinfo($p) 0] |
3092
d0fcce3728d1
hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents:
3059
diff
changeset
|
2391 set r [lindex $commitinfo($p) 6] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2392 } |
3092
d0fcce3728d1
hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents:
3059
diff
changeset
|
2393 return "$r:$p ($l)" |
267 | 2394 } |
2395 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2396 # append some text to the ctext widget, and make any SHA1 ID |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2397 # that we know about be a clickable link. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2398 proc appendwithlinks {text} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2399 global ctext idline linknum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2400 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2401 set start [$ctext index "end - 1c"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2402 $ctext insert end $text |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2403 $ctext insert end "\n" |
3059
3dab573a4330
hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents:
2297
diff
changeset
|
2404 set links [regexp -indices -all -inline {[0-9a-f]{12}} $text] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2405 foreach l $links { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2406 set s [lindex $l 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2407 set e [lindex $l 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2408 set linkid [string range $text $s $e] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2409 if {![info exists idline($linkid)]} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2410 incr e |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2411 $ctext tag add link "$start + $s c" "$start + $e c" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2412 $ctext tag add link$linknum "$start + $s c" "$start + $e c" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2413 $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2414 incr linknum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2415 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2416 $ctext tag conf link -foreground blue -underline 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2417 $ctext tag bind link <Enter> { %W configure -cursor hand2 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2418 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2419 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2420 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2421 proc selectline {l isnew} { |
267 | 2422 global canv canv2 canv3 ctext commitinfo selectedline |
2423 global lineid linehtag linentag linedtag | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2424 global canvy0 linespc parents nparents children |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2425 global cflist currentid sha1entry |
13463
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2426 global commentend idtags idbookmarks idline linknum |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2427 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2428 $canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2429 normalline |
267 | 2430 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return |
2431 $canv delete secsel | |
2432 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ | |
2433 -tags secsel -fill [$canv cget -selectbackground]] | |
2434 $canv lower $t | |
2435 $canv2 delete secsel | |
2436 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ | |
2437 -tags secsel -fill [$canv2 cget -selectbackground]] | |
2438 $canv2 lower $t | |
2439 $canv3 delete secsel | |
2440 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ | |
2441 -tags secsel -fill [$canv3 cget -selectbackground]] | |
2442 $canv3 lower $t | |
2443 set y [expr {$canvy0 + $l * $linespc}] | |
2444 set ymax [lindex [$canv cget -scrollregion] 3] | |
2445 set ytop [expr {$y - $linespc - 1}] | |
2446 set ybot [expr {$y + $linespc + 1}] | |
2447 set wnow [$canv yview] | |
2448 set wtop [expr [lindex $wnow 0] * $ymax] | |
2449 set wbot [expr [lindex $wnow 1] * $ymax] | |
2450 set wh [expr {$wbot - $wtop}] | |
2451 set newtop $wtop | |
2452 if {$ytop < $wtop} { | |
2453 if {$ybot < $wtop} { | |
2454 set newtop [expr {$y - $wh / 2.0}] | |
2455 } else { | |
2456 set newtop $ytop | |
2457 if {$newtop > $wtop - $linespc} { | |
2458 set newtop [expr {$wtop - $linespc}] | |
2459 } | |
2460 } | |
2461 } elseif {$ybot > $wbot} { | |
2462 if {$ytop > $wbot} { | |
2463 set newtop [expr {$y - $wh / 2.0}] | |
2464 } else { | |
2465 set newtop [expr {$ybot - $wh}] | |
2466 if {$newtop < $wtop + $linespc} { | |
2467 set newtop [expr {$wtop + $linespc}] | |
2468 } | |
2469 } | |
2470 } | |
2471 if {$newtop != $wtop} { | |
2472 if {$newtop < 0} { | |
2473 set newtop 0 | |
2474 } | |
2475 allcanvs yview moveto [expr $newtop * 1.0 / $ymax] | |
2476 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2477 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2478 if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2479 addtohistory [list selectline $l 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2480 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2481 |
267 | 2482 set selectedline $l |
2483 | |
2484 set id $lineid($l) | |
2485 set currentid $id | |
2486 $sha1entry delete 0 end | |
2487 $sha1entry insert 0 $id | |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
2488 $sha1entry selection range 0 end |
267 | 2489 |
2490 $ctext conf -state normal | |
2491 $ctext delete 0.0 end | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2492 set linknum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2493 $ctext mark set fmark.0 0.0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2494 $ctext mark gravity fmark.0 left |
267 | 2495 set info $commitinfo($id) |
18802
814498f80d7d
hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents:
18801
diff
changeset
|
2496 $ctext insert end "Changeset: [lindex $info 6]\n" |
5859
e0f86c1e3ae5
hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents:
5662
diff
changeset
|
2497 if {[llength [lindex $info 7]] > 0} { |
e0f86c1e3ae5
hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents:
5662
diff
changeset
|
2498 $ctext insert end "Branch: [lindex $info 7]\n" |
e0f86c1e3ae5
hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents:
5662
diff
changeset
|
2499 } |
18802
814498f80d7d
hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents:
18801
diff
changeset
|
2500 $ctext insert end "User: [lindex $info 1]\n" |
814498f80d7d
hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents:
18801
diff
changeset
|
2501 $ctext insert end "Date: [lindex $info 2]\n" |
13463
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2502 if {[info exists idbookmarks($id)]} { |
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2503 $ctext insert end "Bookmarks:" |
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2504 foreach bookmark $idbookmarks($id) { |
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2505 $ctext insert end " $bookmark" |
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2506 } |
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2507 $ctext insert end "\n" |
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2508 } |
22f948c027a9
hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents:
13462
diff
changeset
|
2509 |
267 | 2510 if {[info exists idtags($id)]} { |
2511 $ctext insert end "Tags:" | |
2512 foreach tag $idtags($id) { | |
2513 $ctext insert end " $tag" | |
2514 } | |
2515 $ctext insert end "\n" | |
2516 } | |
1308
2073e5a71008
Cleanup of tabs and trailing spaces.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
1278
diff
changeset
|
2517 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2518 set comment {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2519 if {[info exists parents($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2520 foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2521 append comment "Parent: [commit_descriptor $p]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2522 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2523 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2524 if {[info exists children($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2525 foreach c $children($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2526 append comment "Child: [commit_descriptor $c]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2527 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2528 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2529 append comment "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2530 append comment [lindex $info 5] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2531 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2532 # make anything that looks like a SHA1 ID be a clickable link |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2533 appendwithlinks $comment |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2534 |
267 | 2535 $ctext tag delete Comments |
2536 $ctext tag remove found 1.0 end | |
2537 $ctext conf -state disabled | |
2538 set commentend [$ctext index "end - 1c"] | |
2539 | |
2540 $cflist delete 0 end | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2541 $cflist insert end "Comments" |
6361
9b21faa6f013
hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents:
6322
diff
changeset
|
2542 if {$nparents($id) <= 1} { |
9b21faa6f013
hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents:
6322
diff
changeset
|
2543 set parent "null" |
267 | 2544 if {$nparents($id) == 1} { |
6361
9b21faa6f013
hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents:
6322
diff
changeset
|
2545 set parent $parents($id) |
9b21faa6f013
hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents:
6322
diff
changeset
|
2546 } |
9b21faa6f013
hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents:
6322
diff
changeset
|
2547 startdiff [concat $id $parent] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2548 } elseif {$nparents($id) > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2549 mergediff $id |
267 | 2550 } |
2551 } | |
2552 | |
2553 proc selnextline {dir} { | |
2554 global selectedline | |
2555 if {![info exists selectedline]} return | |
2556 set l [expr $selectedline + $dir] | |
2557 unmarkmatches | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2558 selectline $l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2559 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2560 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2561 proc unselectline {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2562 global selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2563 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2564 catch {unset selectedline} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2565 allcanvs delete secsel |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2566 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2567 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2568 proc addtohistory {cmd} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2569 global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2570 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2571 if {$historyindex > 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2572 && [lindex $history [expr {$historyindex - 1}]] == $cmd} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2573 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2574 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2575 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2576 if {$historyindex < [llength $history]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2577 set history [lreplace $history $historyindex end $cmd] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2578 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2579 lappend history $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2580 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2581 incr historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2582 if {$historyindex > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2583 .ctop.top.bar.leftbut conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2584 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2585 .ctop.top.bar.leftbut conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2586 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2587 .ctop.top.bar.rightbut conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2588 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2589 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2590 proc goback {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2591 global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2592 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2593 if {$historyindex > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2594 incr historyindex -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2595 set cmd [lindex $history [expr {$historyindex - 1}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2596 eval $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2597 .ctop.top.bar.rightbut conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2598 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2599 if {$historyindex <= 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2600 .ctop.top.bar.leftbut conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2601 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2602 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2603 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2604 proc goforw {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2605 global history historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2606 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2607 if {$historyindex < [llength $history]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2608 set cmd [lindex $history $historyindex] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2609 incr historyindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2610 eval $cmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2611 .ctop.top.bar.leftbut conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2612 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2613 if {$historyindex >= [llength $history]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2614 .ctop.top.bar.rightbut conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2615 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2616 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2617 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2618 proc mergediff {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2619 global parents diffmergeid diffmergegca mergefilelist diffpindex |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2620 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2621 set diffmergeid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2622 set diffpindex -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2623 set diffmergegca [findgca $parents($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2624 if {[info exists mergefilelist($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2625 if {$mergefilelist($id) ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2626 showmergediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2627 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2628 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2629 contmergediff {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2630 } |
267 | 2631 } |
2632 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2633 proc findgca {ids} { |
4688
39001f4b7d99
hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4502
diff
changeset
|
2634 global env |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2635 set gca {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2636 foreach id $ids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2637 if {$gca eq {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2638 set gca $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2639 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2640 if {[catch { |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
2641 set gca [exec $env(HG) --config ui.report_untrusted=false debug-merge-base $gca $id] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2642 } err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2643 return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2644 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2645 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2646 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2647 return $gca |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2648 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2649 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2650 proc contmergediff {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2651 global diffmergeid diffpindex parents nparents diffmergegca |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2652 global treediffs mergefilelist diffids treepending |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2653 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2654 # diff the child against each of the parents, and diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2655 # each of the parents against the GCA. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2656 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2657 if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2658 set ids [list [lindex $ids 1] $diffmergegca] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2659 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2660 if {[incr diffpindex] >= $nparents($diffmergeid)} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2661 set p [lindex $parents($diffmergeid) $diffpindex] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2662 set ids [list $diffmergeid $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2663 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2664 if {![info exists treediffs($ids)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2665 set diffids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2666 if {![info exists treepending]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2667 gettreediffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2668 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2669 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2670 } |
267 | 2671 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2672 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2673 # If a file in some parent is different from the child and also |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2674 # different from the GCA, then it's interesting. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2675 # If we don't have a GCA, then a file is interesting if it is |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2676 # different from the child in all the parents. |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2677 if {$diffmergegca ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2678 set files {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2679 foreach p $parents($diffmergeid) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2680 set gcadiffs $treediffs([list $p $diffmergegca]) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2681 foreach f $treediffs([list $diffmergeid $p]) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2682 if {[lsearch -exact $files $f] < 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2683 && [lsearch -exact $gcadiffs $f] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2684 lappend files $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2685 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2686 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2687 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2688 set files [lsort $files] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2689 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2690 set p [lindex $parents($diffmergeid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2691 set files $treediffs([list $diffmergeid $p]) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2692 for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2693 set p [lindex $parents($diffmergeid) $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2694 set df $treediffs([list $diffmergeid $p]) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2695 set nf {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2696 foreach f $files { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2697 if {[lsearch -exact $df $f] >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2698 lappend nf $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2699 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2700 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2701 set files $nf |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2702 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2703 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2704 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2705 set mergefilelist($diffmergeid) $files |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2706 if {$files ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2707 showmergediff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2708 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2709 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2710 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2711 proc showmergediff {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2712 global cflist diffmergeid mergefilelist parents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2713 global diffopts diffinhunk currentfile currenthunk filelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2714 global diffblocked groupfilelast mergefds groupfilenum grouphunks |
4688
39001f4b7d99
hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4502
diff
changeset
|
2715 global env |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2716 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2717 set files $mergefilelist($diffmergeid) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2718 foreach f $files { |
267 | 2719 $cflist insert end $f |
2720 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2721 set env(GIT_DIFF_OPTS) $diffopts |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2722 set flist {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2723 catch {unset currentfile} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2724 catch {unset currenthunk} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2725 catch {unset filelines} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2726 catch {unset groupfilenum} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2727 catch {unset grouphunks} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2728 set groupfilelast -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2729 foreach p $parents($diffmergeid) { |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
2730 set cmd [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -p $p $diffmergeid] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2731 set cmd [concat $cmd $mergefilelist($diffmergeid)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2732 if {[catch {set f [open $cmd r]} err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2733 error_popup "Error getting diffs: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2734 foreach f $flist { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2735 catch {close $f} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2736 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2737 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2738 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2739 lappend flist $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2740 set ids [list $diffmergeid $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2741 set mergefds($ids) $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2742 set diffinhunk($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2743 set diffblocked($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2744 fconfigure $f -blocking 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2745 fileevent $f readable [list getmergediffline $f $ids $diffmergeid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2746 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2747 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2748 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2749 proc getmergediffline {f ids id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2750 global diffmergeid diffinhunk diffoldlines diffnewlines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2751 global currentfile currenthunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2752 global diffoldstart diffnewstart diffoldlno diffnewlno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2753 global diffblocked mergefilelist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2754 global noldlines nnewlines difflcounts filelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2755 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2756 set n [gets $f line] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2757 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2758 if {![eof $f]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2759 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2760 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2761 if {!([info exists diffmergeid] && $diffmergeid == $id)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2762 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2763 close $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2764 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2765 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2766 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2767 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2768 if {$diffinhunk($ids) != 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2769 set fi $currentfile($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2770 if {$n > 0 && [regexp {^[-+ \\]} $line match]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2771 # continuing an existing hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2772 set line [string range $line 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2773 set p [lindex $ids 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2774 if {$match eq "-" || $match eq " "} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2775 set filelines($p,$fi,$diffoldlno($ids)) $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2776 incr diffoldlno($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2777 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2778 if {$match eq "+" || $match eq " "} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2779 set filelines($id,$fi,$diffnewlno($ids)) $line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2780 incr diffnewlno($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2781 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2782 if {$match eq " "} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2783 if {$diffinhunk($ids) == 2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2784 lappend difflcounts($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2785 [list $noldlines($ids) $nnewlines($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2786 set noldlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2787 set diffinhunk($ids) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2788 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2789 incr noldlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2790 } elseif {$match eq "-" || $match eq "+"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2791 if {$diffinhunk($ids) == 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2792 lappend difflcounts($ids) [list $noldlines($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2793 set noldlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2794 set nnewlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2795 set diffinhunk($ids) 2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2796 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2797 if {$match eq "-"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2798 incr noldlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2799 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2800 incr nnewlines($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2801 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2802 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2803 # and if it's \ No newline at end of line, then what? |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2804 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2805 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2806 # end of a hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2807 if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2808 lappend difflcounts($ids) [list $noldlines($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2809 } elseif {$diffinhunk($ids) == 2 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2810 && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2811 lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2812 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2813 set currenthunk($ids) [list $currentfile($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2814 $diffoldstart($ids) $diffnewstart($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2815 $diffoldlno($ids) $diffnewlno($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2816 $difflcounts($ids)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2817 set diffinhunk($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2818 # -1 = need to block, 0 = unblocked, 1 = is blocked |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2819 set diffblocked($ids) -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2820 processhunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2821 if {$diffblocked($ids) == -1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2822 fileevent $f readable {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2823 set diffblocked($ids) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2824 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2825 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2826 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2827 if {$n < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2828 # eof |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2829 if {!$diffblocked($ids)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2830 close $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2831 set currentfile($ids) [llength $mergefilelist($diffmergeid)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2832 set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2833 processhunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2834 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2835 } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2836 # start of a new file |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2837 set currentfile($ids) \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2838 [lsearch -exact $mergefilelist($diffmergeid) $fname] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2839 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2840 $line match f1l f1c f2l f2c rest]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2841 if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2842 # start of a new hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2843 if {$f1l == 0 && $f1c == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2844 set f1l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2845 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2846 if {$f2l == 0 && $f2c == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2847 set f2l 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2848 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2849 set diffinhunk($ids) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2850 set diffoldstart($ids) $f1l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2851 set diffnewstart($ids) $f2l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2852 set diffoldlno($ids) $f1l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2853 set diffnewlno($ids) $f2l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2854 set difflcounts($ids) {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2855 set noldlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2856 set nnewlines($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2857 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2858 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2859 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2860 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2861 proc processhunks {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2862 global diffmergeid parents nparents currenthunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2863 global mergefilelist diffblocked mergefds |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2864 global grouphunks grouplinestart grouplineend groupfilenum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2865 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2866 set nfiles [llength $mergefilelist($diffmergeid)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2867 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2868 set fi $nfiles |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2869 set lno 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2870 # look for the earliest hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2871 foreach p $parents($diffmergeid) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2872 set ids [list $diffmergeid $p] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2873 if {![info exists currenthunk($ids)]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2874 set i [lindex $currenthunk($ids) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2875 set l [lindex $currenthunk($ids) 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2876 if {$i < $fi || ($i == $fi && $l < $lno)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2877 set fi $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2878 set lno $l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2879 set pi $p |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2880 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2881 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2882 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2883 if {$fi < $nfiles} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2884 set ids [list $diffmergeid $pi] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2885 set hunk $currenthunk($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2886 unset currenthunk($ids) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2887 if {$diffblocked($ids) > 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2888 fileevent $mergefds($ids) readable \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2889 [list getmergediffline $mergefds($ids) $ids $diffmergeid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2890 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2891 set diffblocked($ids) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2892 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2893 if {[info exists groupfilenum] && $groupfilenum == $fi |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2894 && $lno <= $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2895 # add this hunk to the pending group |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2896 lappend grouphunks($pi) $hunk |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2897 set endln [lindex $hunk 4] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2898 if {$endln > $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2899 set grouplineend $endln |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2900 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2901 continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2902 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2903 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2904 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2905 # succeeding stuff doesn't belong in this group, so |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2906 # process the group now |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2907 if {[info exists groupfilenum]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2908 processgroup |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2909 unset groupfilenum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2910 unset grouphunks |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2911 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2912 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2913 if {$fi >= $nfiles} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2914 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2915 # start a new group |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2916 set groupfilenum $fi |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2917 set grouphunks($pi) [list $hunk] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2918 set grouplinestart $lno |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2919 set grouplineend [lindex $hunk 4] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2920 } |
267 | 2921 } |
2922 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2923 proc processgroup {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2924 global groupfilelast groupfilenum difffilestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2925 global mergefilelist diffmergeid ctext filelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2926 global parents diffmergeid diffoffset |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2927 global grouphunks grouplinestart grouplineend nparents |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2928 global mergemax |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2929 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2930 $ctext conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2931 set id $diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2932 set f $groupfilenum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2933 if {$groupfilelast != $f} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2934 $ctext insert end "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2935 set here [$ctext index "end - 1c"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2936 set difffilestart($f) $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2937 set mark fmark.[expr {$f + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2938 $ctext mark set $mark $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2939 $ctext mark gravity $mark left |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2940 set header [lindex $mergefilelist($id) $f] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2941 set l [expr {(78 - [string length $header]) / 2}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2942 set pad [string range "----------------------------------------" 1 $l] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2943 $ctext insert end "$pad $header $pad\n" filesep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2944 set groupfilelast $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2945 foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2946 set diffoffset($p) 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2947 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2948 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2949 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2950 $ctext insert end "@@" msep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2951 set nlines [expr {$grouplineend - $grouplinestart}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2952 set events {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2953 set pnum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2954 foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2955 set startline [expr {$grouplinestart + $diffoffset($p)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2956 set ol $startline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2957 set nl $grouplinestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2958 if {[info exists grouphunks($p)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2959 foreach h $grouphunks($p) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2960 set l [lindex $h 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2961 if {$nl < $l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2962 for {} {$nl < $l} {incr nl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2963 set filelines($p,$f,$ol) $filelines($id,$f,$nl) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2964 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2965 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2966 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2967 foreach chunk [lindex $h 5] { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2968 if {[llength $chunk] == 2} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2969 set olc [lindex $chunk 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2970 set nlc [lindex $chunk 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2971 set nnl [expr {$nl + $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2972 lappend events [list $nl $nnl $pnum $olc $nlc] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2973 incr ol $olc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2974 set nl $nnl |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2975 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2976 incr ol [lindex $chunk 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2977 incr nl [lindex $chunk 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2978 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2979 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2980 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2981 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2982 if {$nl < $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2983 for {} {$nl < $grouplineend} {incr nl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2984 set filelines($p,$f,$ol) $filelines($id,$f,$nl) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2985 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2986 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2987 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2988 set nlines [expr {$ol - $startline}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2989 $ctext insert end " -$startline,$nlines" msep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2990 incr pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2991 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2992 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2993 set nlines [expr {$grouplineend - $grouplinestart}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2994 $ctext insert end " +$grouplinestart,$nlines @@\n" msep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2995 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2996 set events [lsort -integer -index 0 $events] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2997 set nevents [llength $events] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2998 set nmerge $nparents($diffmergeid) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
2999 set l $grouplinestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3000 for {set i 0} {$i < $nevents} {set i $j} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3001 set nl [lindex $events $i 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3002 while {$l < $nl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3003 $ctext insert end " $filelines($id,$f,$l)\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3004 incr l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3005 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3006 set e [lindex $events $i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3007 set enl [lindex $e 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3008 set j $i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3009 set active {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3010 while 1 { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3011 set pnum [lindex $e 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3012 set olc [lindex $e 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3013 set nlc [lindex $e 4] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3014 if {![info exists delta($pnum)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3015 set delta($pnum) [expr {$olc - $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3016 lappend active $pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3017 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3018 incr delta($pnum) [expr {$olc - $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3019 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3020 if {[incr j] >= $nevents} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3021 set e [lindex $events $j] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3022 if {[lindex $e 0] >= $enl} break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3023 if {[lindex $e 1] > $enl} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3024 set enl [lindex $e 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3025 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3026 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3027 set nlc [expr {$enl - $l}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3028 set ncol mresult |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3029 set bestpn -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3030 if {[llength $active] == $nmerge - 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3031 # no diff for one of the parents, i.e. it's identical |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3032 for {set pnum 0} {$pnum < $nmerge} {incr pnum} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3033 if {![info exists delta($pnum)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3034 if {$pnum < $mergemax} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3035 lappend ncol m$pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3036 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3037 lappend ncol mmax |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3038 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3039 break |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3040 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3041 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3042 } elseif {[llength $active] == $nmerge} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3043 # all parents are different, see if one is very similar |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3044 set bestsim 30 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3045 for {set pnum 0} {$pnum < $nmerge} {incr pnum} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3046 set sim [similarity $pnum $l $nlc $f \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3047 [lrange $events $i [expr {$j-1}]]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3048 if {$sim > $bestsim} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3049 set bestsim $sim |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3050 set bestpn $pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3051 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3052 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3053 if {$bestpn >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3054 lappend ncol m$bestpn |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3055 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3056 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3057 set pnum -1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3058 foreach p $parents($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3059 incr pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3060 if {![info exists delta($pnum)] || $pnum == $bestpn} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3061 set olc [expr {$nlc + $delta($pnum)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3062 set ol [expr {$l + $diffoffset($p)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3063 incr diffoffset($p) $delta($pnum) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3064 unset delta($pnum) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3065 for {} {$olc > 0} {incr olc -1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3066 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3067 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3068 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3069 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3070 set endl [expr {$l + $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3071 if {$bestpn >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3072 # show this pretty much as a normal diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3073 set p [lindex $parents($id) $bestpn] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3074 set ol [expr {$l + $diffoffset($p)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3075 incr diffoffset($p) $delta($bestpn) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3076 unset delta($bestpn) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3077 for {set k $i} {$k < $j} {incr k} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3078 set e [lindex $events $k] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3079 if {[lindex $e 2] != $bestpn} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3080 set nl [lindex $e 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3081 set ol [expr {$ol + $nl - $l}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3082 for {} {$l < $nl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3083 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3084 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3085 set c [lindex $e 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3086 for {} {$c > 0} {incr c -1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3087 $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3088 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3089 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3090 set nl [lindex $e 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3091 for {} {$l < $nl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3092 $ctext insert end "+$filelines($id,$f,$l)\n" mresult |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3093 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3094 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3095 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3096 for {} {$l < $endl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3097 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3098 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3099 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3100 while {$l < $grouplineend} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3101 $ctext insert end " $filelines($id,$f,$l)\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3102 incr l |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3103 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3104 $ctext conf -state disabled |
267 | 3105 } |
3106 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3107 proc similarity {pnum l nlc f events} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3108 global diffmergeid parents diffoffset filelines |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3109 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3110 set id $diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3111 set p [lindex $parents($id) $pnum] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3112 set ol [expr {$l + $diffoffset($p)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3113 set endl [expr {$l + $nlc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3114 set same 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3115 set diff 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3116 foreach e $events { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3117 if {[lindex $e 2] != $pnum} continue |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3118 set nl [lindex $e 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3119 set ol [expr {$ol + $nl - $l}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3120 for {} {$l < $nl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3121 incr same [string length $filelines($id,$f,$l)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3122 incr same |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3123 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3124 set oc [lindex $e 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3125 for {} {$oc > 0} {incr oc -1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3126 incr diff [string length $filelines($p,$f,$ol)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3127 incr diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3128 incr ol |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3129 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3130 set nl [lindex $e 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3131 for {} {$l < $nl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3132 incr diff [string length $filelines($id,$f,$l)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3133 incr diff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3134 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3135 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3136 for {} {$l < $endl} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3137 incr same [string length $filelines($id,$f,$l)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3138 incr same |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3139 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3140 if {$same == 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3141 return 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3142 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3143 return [expr {200 * $same / (2 * $same + $diff)}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3144 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3145 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3146 proc startdiff {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3147 global treediffs diffids treepending diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3148 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3149 set diffids $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3150 catch {unset diffmergeid} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3151 if {![info exists treediffs($ids)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3152 if {![info exists treepending]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3153 gettreediffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3154 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3155 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3156 addtocflist $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3157 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3158 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3159 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3160 proc addtocflist {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3161 global treediffs cflist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3162 foreach f $treediffs($ids) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3163 $cflist insert end $f |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3164 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3165 getblobdiffs $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3166 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3167 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3168 proc gettreediffs {ids} { |
4688
39001f4b7d99
hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4502
diff
changeset
|
3169 global treediff parents treepending env |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3170 set treepending $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3171 set treediff {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3172 set id [lindex $ids 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3173 set p [lindex $ids 1] |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
3174 if [catch {set gdtf [open "|{$env(HG)} --config ui.report_untrusted=false debug-diff-tree -r $p $id" r]}] return |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3175 fconfigure $gdtf -blocking 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3176 fileevent $gdtf readable [list gettreediffline $gdtf $ids] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3177 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3178 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3179 proc gettreediffline {gdtf ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3180 global treediff treediffs treepending diffids diffmergeid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3181 |
267 | 3182 set n [gets $gdtf line] |
3183 if {$n < 0} { | |
3184 if {![eof $gdtf]} return | |
3185 close $gdtf | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3186 set treediffs($ids) $treediff |
267 | 3187 unset treepending |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3188 if {$ids != $diffids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3189 gettreediffs $diffids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3190 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3191 if {[info exists diffmergeid]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3192 contmergediff $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3193 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3194 addtocflist $ids |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3195 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3196 } |
267 | 3197 return |
3198 } | |
4741
4a84f7421692
Make hgk handle filenames with spaces (issue49)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4740
diff
changeset
|
3199 set tab1 [expr [string first "\t" $line] + 1] |
4a84f7421692
Make hgk handle filenames with spaces (issue49)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4740
diff
changeset
|
3200 set tab2 [expr [string first "\t" $line $tab1] - 1] |
4a84f7421692
Make hgk handle filenames with spaces (issue49)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4740
diff
changeset
|
3201 set file [string range $line $tab1 $tab2] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3202 lappend treediff $file |
267 | 3203 } |
3204 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3205 proc getblobdiffs {ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3206 global diffopts blobdifffd diffids env curdifftag curtagstart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3207 global difffilestart nextupdate diffinhdr treediffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3208 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3209 set id [lindex $ids 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3210 set p [lindex $ids 1] |
267 | 3211 set env(GIT_DIFF_OPTS) $diffopts |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
3212 set cmd [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -r -p -C $p $id] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3213 if {[catch {set bdf [open $cmd r]} err]} { |
267 | 3214 puts "error getting diffs: $err" |
3215 return | |
3216 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3217 set diffinhdr 0 |
267 | 3218 fconfigure $bdf -blocking 0 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3219 set blobdifffd($ids) $bdf |
267 | 3220 set curdifftag Comments |
3221 set curtagstart 0.0 | |
3222 catch {unset difffilestart} | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3223 fileevent $bdf readable [list getblobdiffline $bdf $diffids] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3224 set nextupdate [expr {[clock clicks -milliseconds] + 100}] |
267 | 3225 } |
3226 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3227 proc getblobdiffline {bdf ids} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3228 global diffids blobdifffd ctext curdifftag curtagstart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3229 global diffnexthead diffnextnote difffilestart |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3230 global nextupdate diffinhdr treediffs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3231 global gaudydiff |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3232 |
267 | 3233 set n [gets $bdf line] |
3234 if {$n < 0} { | |
3235 if {[eof $bdf]} { | |
3236 close $bdf | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3237 if {$ids == $diffids && $bdf == $blobdifffd($ids)} { |
267 | 3238 $ctext tag add $curdifftag $curtagstart end |
3239 } | |
3240 } | |
3241 return | |
3242 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3243 if {$ids != $diffids || $bdf != $blobdifffd($ids)} { |
267 | 3244 return |
3245 } | |
3940
a33ddd20105c
hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents:
3093
diff
changeset
|
3246 regsub -all "\r" $line "" line |
267 | 3247 $ctext conf -state normal |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3248 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} { |
267 | 3249 # start of a new file |
3250 $ctext insert end "\n" | |
3251 $ctext tag add $curdifftag $curtagstart end | |
3252 set curtagstart [$ctext index "end - 1c"] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3253 set header $newname |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3254 set here [$ctext index "end - 1c"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3255 set i [lsearch -exact $treediffs($diffids) $fname] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3256 if {$i >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3257 set difffilestart($i) $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3258 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3259 $ctext mark set fmark.$i $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3260 $ctext mark gravity fmark.$i left |
267 | 3261 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3262 if {$newname != $fname} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3263 set i [lsearch -exact $treediffs($diffids) $newname] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3264 if {$i >= 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3265 set difffilestart($i) $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3266 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3267 $ctext mark set fmark.$i $here |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3268 $ctext mark gravity fmark.$i left |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3269 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3270 } |
267 | 3271 set curdifftag "f:$fname" |
3272 $ctext tag delete $curdifftag | |
3273 set l [expr {(78 - [string length $header]) / 2}] | |
3274 set pad [string range "----------------------------------------" 1 $l] | |
3275 $ctext insert end "$pad $header $pad\n" filesep | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3276 set diffinhdr 1 |
9989
60cefb8b3c85
hgk: do not ignore ---/+++ lines in diff
Fabian Kreutz <project+hg@fabian-kreutz.de>
parents:
7776
diff
changeset
|
3277 } elseif {[regexp {^(---|\+\+\+) } $line] && $diffinhdr} { |
60cefb8b3c85
hgk: do not ignore ---/+++ lines in diff
Fabian Kreutz <project+hg@fabian-kreutz.de>
parents:
7776
diff
changeset
|
3278 set diffinhdr 1 |
267 | 3279 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ |
3280 $line match f1l f1c f2l f2c rest]} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3281 if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3282 $ctext insert end "\t" hunksep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3283 $ctext insert end " $f1l " d0 " $f2l " d1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3284 $ctext insert end " $rest \n" hunksep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3285 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3286 $ctext insert end "$line\n" hunksep |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3287 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3288 set diffinhdr 0 |
267 | 3289 } else { |
3290 set x [string range $line 0 0] | |
3291 if {$x == "-" || $x == "+"} { | |
3292 set tag [expr {$x == "+"}] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3293 if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3294 set line [string range $line 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3295 } |
267 | 3296 $ctext insert end "$line\n" d$tag |
3297 } elseif {$x == " "} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3298 if {$gaudydiff} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3299 set line [string range $line 1 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3300 } |
267 | 3301 $ctext insert end "$line\n" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3302 } elseif {$diffinhdr || $x == "\\"} { |
267 | 3303 # e.g. "\ No newline at end of file" |
3304 $ctext insert end "$line\n" filesep | |
3940
a33ddd20105c
hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents:
3093
diff
changeset
|
3305 } elseif {$line != ""} { |
267 | 3306 # Something else we don't recognize |
3307 if {$curdifftag != "Comments"} { | |
3308 $ctext insert end "\n" | |
3309 $ctext tag add $curdifftag $curtagstart end | |
3310 set curtagstart [$ctext index "end - 1c"] | |
3311 set curdifftag Comments | |
3312 } | |
3313 $ctext insert end "$line\n" filesep | |
3314 } | |
3315 } | |
3316 $ctext conf -state disabled | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3317 if {[clock clicks -milliseconds] >= $nextupdate} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3318 incr nextupdate 100 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3319 fileevent $bdf readable {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3320 update |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3321 fileevent $bdf readable "getblobdiffline $bdf {$ids}" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3322 } |
267 | 3323 } |
3324 | |
3325 proc nextfile {} { | |
3326 global difffilestart ctext | |
3327 set here [$ctext index @0,0] | |
3328 for {set i 0} {[info exists difffilestart($i)]} {incr i} { | |
3329 if {[$ctext compare $difffilestart($i) > $here]} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3330 if {![info exists pos] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3331 || [$ctext compare $difffilestart($i) < $pos]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3332 set pos $difffilestart($i) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3333 } |
267 | 3334 } |
3335 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3336 if {[info exists pos]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3337 $ctext yview $pos |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3338 } |
267 | 3339 } |
3340 | |
3341 proc listboxsel {} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3342 global ctext cflist currentid |
267 | 3343 if {![info exists currentid]} return |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3344 set sel [lsort [$cflist curselection]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3345 if {$sel eq {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3346 set first [lindex $sel 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3347 catch {$ctext yview fmark.$first} |
267 | 3348 } |
3349 | |
3350 proc setcoords {} { | |
3351 global linespc charspc canvx0 canvy0 mainfont | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3352 global xspc1 xspc2 lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3353 |
267 | 3354 set linespc [font metrics $mainfont -linespace] |
3355 set charspc [font measure $mainfont "m"] | |
3356 set canvy0 [expr 3 + 0.5 * $linespc] | |
3357 set canvx0 [expr 3 + 0.5 * $linespc] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3358 set lthickness [expr {int($linespc / 9) + 1}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3359 set xspc1(0) $linespc |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3360 set xspc2 $linespc |
267 | 3361 } |
3362 | |
3363 proc redisplay {} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3364 global stopped redisplaying phase |
267 | 3365 if {$stopped > 1} return |
3366 if {$phase == "getcommits"} return | |
3367 set redisplaying 1 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3368 if {$phase == "drawgraph" || $phase == "incrdraw"} { |
267 | 3369 set stopped 1 |
3370 } else { | |
3371 drawgraph | |
3372 } | |
3373 } | |
3374 | |
3375 proc incrfont {inc} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3376 global mainfont namefont textfont ctext canv phase |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
3377 global stopped entries curidfont |
267 | 3378 unmarkmatches |
3379 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] | |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
3380 set curidfont [lreplace $curidfont 1 1 [expr {[lindex $curidfont 1] + $inc}]] |
267 | 3381 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]] |
3382 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]] | |
3383 setcoords | |
3384 $ctext conf -font $textfont | |
3385 $ctext tag conf filesep -font [concat $textfont bold] | |
3386 foreach e $entries { | |
3387 $e conf -font $mainfont | |
3388 } | |
3389 if {$phase == "getcommits"} { | |
3390 $canv itemconf textitems -font $mainfont | |
3391 } | |
3392 redisplay | |
3393 } | |
3394 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3395 proc clearsha1 {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3396 global sha1entry sha1string |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3397 if {[string length $sha1string] == 40} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3398 $sha1entry delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3399 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3400 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3401 |
267 | 3402 proc sha1change {n1 n2 op} { |
3403 global sha1string currentid sha1but | |
3404 if {$sha1string == {} | |
3405 || ([info exists currentid] && $sha1string == $currentid)} { | |
3406 set state disabled | |
3407 } else { | |
3408 set state normal | |
3409 } | |
3410 if {[$sha1but cget -state] == $state} return | |
3411 if {$state == "normal"} { | |
3412 $sha1but conf -state normal -relief raised -text "Goto: " | |
3413 } else { | |
3414 $sha1but conf -state disabled -relief flat -text "SHA1 ID: " | |
3415 } | |
3416 } | |
3417 | |
3418 proc gotocommit {} { | |
3419 global sha1string currentid idline tagids | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3420 global lineid numcommits |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3421 |
267 | 3422 if {$sha1string == {} |
3423 || ([info exists currentid] && $sha1string == $currentid)} return | |
3424 if {[info exists tagids($sha1string)]} { | |
3425 set id $tagids($sha1string) | |
3426 } else { | |
3427 set id [string tolower $sha1string] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3428 if {[regexp {^[0-9a-f]{4,39}$} $id]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3429 set matches {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3430 for {set l 0} {$l < $numcommits} {incr l} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3431 if {[string match $id* $lineid($l)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3432 lappend matches $lineid($l) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3433 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3434 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3435 if {$matches ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3436 if {[llength $matches] > 1} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3437 error_popup "Short SHA1 id $id is ambiguous" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3438 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3439 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3440 set id [lindex $matches 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3441 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3442 } |
267 | 3443 } |
3444 if {[info exists idline($id)]} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3445 selectline $idline($id) 1 |
267 | 3446 return |
3447 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3448 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { |
267 | 3449 set type "SHA1 id" |
3450 } else { | |
3451 set type "Tag" | |
3452 } | |
3453 error_popup "$type $sha1string is not known" | |
3454 } | |
3455 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3456 proc lineenter {x y id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3457 global hoverx hovery hoverid hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3458 global commitinfo canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3459 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3460 if {![info exists commitinfo($id)]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3461 set hoverx $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3462 set hovery $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3463 set hoverid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3464 if {[info exists hovertimer]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3465 after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3466 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3467 set hovertimer [after 500 linehover] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3468 $canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3469 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3470 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3471 proc linemotion {x y id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3472 global hoverx hovery hoverid hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3473 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3474 if {[info exists hoverid] && $id == $hoverid} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3475 set hoverx $x |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3476 set hovery $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3477 if {[info exists hovertimer]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3478 after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3479 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3480 set hovertimer [after 500 linehover] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3481 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3482 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3483 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3484 proc lineleave {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3485 global hoverid hovertimer canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3486 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3487 if {[info exists hoverid] && $id == $hoverid} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3488 $canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3489 if {[info exists hovertimer]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3490 after cancel $hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3491 unset hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3492 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3493 unset hoverid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3494 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3495 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3496 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3497 proc linehover {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3498 global hoverx hovery hoverid hovertimer |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3499 global canv linespc lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3500 global commitinfo mainfont |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3501 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3502 set text [lindex $commitinfo($hoverid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3503 set ymax [lindex [$canv cget -scrollregion] 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3504 if {$ymax == {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3505 set yfrac [lindex [$canv yview] 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3506 set x [expr {$hoverx + 2 * $linespc}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3507 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3508 set x0 [expr {$x - 2 * $lthickness}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3509 set y0 [expr {$y - 2 * $lthickness}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3510 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3511 set y1 [expr {$y + $linespc + 2 * $lthickness}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3512 set t [$canv create rectangle $x0 $y0 $x1 $y1 \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3513 -fill \#ffff80 -outline black -width 1 -tags hover] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3514 $canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3515 set t [$canv create text $x $y -anchor nw -text $text -tags hover] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3516 $canv raise $t |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3517 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3518 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3519 proc clickisonarrow {id y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3520 global mainline mainlinearrow sidelines lthickness |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3521 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3522 set thresh [expr {2 * $lthickness + 6}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3523 if {[info exists mainline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3524 if {$mainlinearrow($id) ne "none"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3525 if {abs([lindex $mainline($id) 1] - $y) < $thresh} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3526 return "up" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3527 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3528 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3529 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3530 if {[info exists sidelines($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3531 foreach ls $sidelines($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3532 set coords [lindex $ls 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3533 set arrow [lindex $ls 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3534 if {$arrow eq "first" || $arrow eq "both"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3535 if {abs([lindex $coords 1] - $y) < $thresh} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3536 return "up" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3537 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3538 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3539 if {$arrow eq "last" || $arrow eq "both"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3540 if {abs([lindex $coords end] - $y) < $thresh} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3541 return "down" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3542 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3543 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3544 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3545 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3546 return {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3547 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3548 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3549 proc arrowjump {id dirn y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3550 global mainline sidelines canv |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3551 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3552 set yt {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3553 if {$dirn eq "down"} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3554 if {[info exists mainline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3555 set y1 [lindex $mainline($id) 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3556 if {$y1 > $y} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3557 set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3558 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3559 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3560 if {[info exists sidelines($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3561 foreach ls $sidelines($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3562 set y1 [lindex $ls 0 1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3563 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3564 set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3565 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3566 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3567 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3568 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3569 if {[info exists sidelines($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3570 foreach ls $sidelines($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3571 set y1 [lindex $ls 0 end] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3572 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3573 set yt $y1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3574 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3575 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3576 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3577 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3578 if {$yt eq {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3579 set ymax [lindex [$canv cget -scrollregion] 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3580 if {$ymax eq {} || $ymax <= 0} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3581 set view [$canv yview] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3582 set yspan [expr {[lindex $view 1] - [lindex $view 0]}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3583 set yfrac [expr {$yt / $ymax - $yspan / 2}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3584 if {$yfrac < 0} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3585 set yfrac 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3586 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3587 $canv yview moveto $yfrac |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3588 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3589 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3590 proc lineclick {x y id isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3591 global ctext commitinfo children cflist canv thickerline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3592 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3593 unmarkmatches |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3594 unselectline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3595 normalline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3596 $canv delete hover |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3597 # draw this line thicker than normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3598 drawlines $id 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3599 set thickerline $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3600 if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3601 set ymax [lindex [$canv cget -scrollregion] 3] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3602 if {$ymax eq {}} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3603 set yfrac [lindex [$canv yview] 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3604 set y [expr {$y + $yfrac * $ymax}] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3605 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3606 set dirn [clickisonarrow $id $y] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3607 if {$dirn ne {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3608 arrowjump $id $dirn $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3609 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3610 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3611 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3612 if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3613 addtohistory [list lineclick $x $y $id 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3614 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3615 # fill the details pane with info about this line |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3616 $ctext conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3617 $ctext delete 0.0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3618 $ctext tag conf link -foreground blue -underline 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3619 $ctext tag bind link <Enter> { %W configure -cursor hand2 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3620 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3621 $ctext insert end "Parent:\t" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3622 $ctext insert end $id [list link link0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3623 $ctext tag bind link0 <1> [list selbyid $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3624 set info $commitinfo($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3625 $ctext insert end "\n\t[lindex $info 0]\n" |
18802
814498f80d7d
hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents:
18801
diff
changeset
|
3626 $ctext insert end "\tUser:\t[lindex $info 1]\n" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3627 $ctext insert end "\tDate:\t[lindex $info 2]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3628 if {[info exists children($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3629 $ctext insert end "\nChildren:" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3630 set i 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3631 foreach child $children($id) { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3632 incr i |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3633 set info $commitinfo($child) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3634 $ctext insert end "\n\t" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3635 $ctext insert end $child [list link link$i] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3636 $ctext tag bind link$i <1> [list selbyid $child] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3637 $ctext insert end "\n\t[lindex $info 0]" |
18802
814498f80d7d
hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents:
18801
diff
changeset
|
3638 $ctext insert end "\n\tUser:\t[lindex $info 1]" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3639 $ctext insert end "\n\tDate:\t[lindex $info 2]\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3640 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3641 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3642 $ctext conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3643 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3644 $cflist delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3645 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3646 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3647 proc normalline {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3648 global thickerline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3649 if {[info exists thickerline]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3650 drawlines $thickerline 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3651 unset thickerline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3652 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3653 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3654 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3655 proc selbyid {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3656 global idline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3657 if {[info exists idline($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3658 selectline $idline($id) 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3659 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3660 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3661 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3662 proc mstime {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3663 global startmstime |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3664 if {![info exists startmstime]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3665 set startmstime [clock clicks -milliseconds] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3666 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3667 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3668 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3669 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3670 proc rowmenu {x y id} { |
5394
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
3671 global rowctxmenu idline selectedline rowmenuid hgvdiff |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3672 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3673 if {![info exists selectedline] || $idline($id) eq $selectedline} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3674 set state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3675 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3676 set state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3677 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3678 $rowctxmenu entryconfigure 0 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3679 $rowctxmenu entryconfigure 1 -state $state |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3680 $rowctxmenu entryconfigure 2 -state $state |
5394
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
3681 if { $hgvdiff ne "" } { |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
3682 $rowctxmenu entryconfigure 6 -state $state |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
3683 } |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3684 set rowmenuid $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3685 tk_popup $rowctxmenu $x $y |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3686 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3687 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3688 proc diffvssel {dirn} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3689 global rowmenuid selectedline lineid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3690 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3691 if {![info exists selectedline]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3692 if {$dirn} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3693 set oldid $lineid($selectedline) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3694 set newid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3695 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3696 set oldid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3697 set newid $lineid($selectedline) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3698 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3699 addtohistory [list doseldiff $oldid $newid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3700 doseldiff $oldid $newid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3701 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3702 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3703 proc doseldiff {oldid newid} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3704 global ctext cflist |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3705 global commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3706 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3707 $ctext conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3708 $ctext delete 0.0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3709 $ctext mark set fmark.0 0.0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3710 $ctext mark gravity fmark.0 left |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3711 $cflist delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3712 $cflist insert end "Top" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3713 $ctext insert end "From " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3714 $ctext tag conf link -foreground blue -underline 1 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3715 $ctext tag bind link <Enter> { %W configure -cursor hand2 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3716 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3717 $ctext tag bind link0 <1> [list selbyid $oldid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3718 $ctext insert end $oldid [list link link0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3719 $ctext insert end "\n " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3720 $ctext insert end [lindex $commitinfo($oldid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3721 $ctext insert end "\n\nTo " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3722 $ctext tag bind link1 <1> [list selbyid $newid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3723 $ctext insert end $newid [list link link1] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3724 $ctext insert end "\n " |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3725 $ctext insert end [lindex $commitinfo($newid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3726 $ctext insert end "\n" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3727 $ctext conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3728 $ctext tag delete Comments |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3729 $ctext tag remove found 1.0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3730 startdiff [list $newid $oldid] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3731 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3732 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3733 proc mkpatch {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3734 global rowmenuid currentid commitinfo patchtop patchnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3735 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3736 if {![info exists currentid]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3737 set oldid $currentid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3738 set oldhead [lindex $commitinfo($oldid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3739 set newid $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3740 set newhead [lindex $commitinfo($newid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3741 set top .patch |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3742 set patchtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3743 catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3744 toplevel $top |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3745 ttk::label $top.title -text "Generate patch" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3746 grid $top.title - -pady 10 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3747 ttk::label $top.from -text "From:" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3748 ttk::entry $top.fromsha1 -width 40 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3749 $top.fromsha1 insert 0 $oldid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3750 $top.fromsha1 conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3751 grid $top.from $top.fromsha1 -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3752 ttk::entry $top.fromhead -width 60 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3753 $top.fromhead insert 0 $oldhead |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3754 $top.fromhead conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3755 grid x $top.fromhead -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3756 ttk::label $top.to -text "To:" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3757 ttk::entry $top.tosha1 -width 40 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3758 $top.tosha1 insert 0 $newid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3759 $top.tosha1 conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3760 grid $top.to $top.tosha1 -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3761 ttk::entry $top.tohead -width 60 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3762 $top.tohead insert 0 $newhead |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3763 $top.tohead conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3764 grid x $top.tohead -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3765 ttk::button $top.rev -text "Reverse" -command mkpatchrev |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3766 grid $top.rev x -pady 10 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3767 ttk::label $top.flab -text "Output file:" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3768 ttk::entry $top.fname -width 60 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3769 $top.fname insert 0 [file normalize "patch$patchnum.patch"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3770 incr patchnum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3771 grid $top.flab $top.fname -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3772 ttk::frame $top.buts |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3773 ttk::button $top.buts.gen -text "Generate" -command mkpatchgo |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3774 ttk::button $top.buts.can -text "Cancel" -command mkpatchcan |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3775 grid $top.buts.gen $top.buts.can |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3776 grid columnconfigure $top.buts 0 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3777 grid columnconfigure $top.buts 1 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3778 grid $top.buts - -pady 10 -sticky ew |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3779 focus $top.fname |
18804 | 3780 popupify $top |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3781 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3782 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3783 proc mkpatchrev {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3784 global patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3785 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3786 set oldid [$patchtop.fromsha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3787 set oldhead [$patchtop.fromhead get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3788 set newid [$patchtop.tosha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3789 set newhead [$patchtop.tohead get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3790 foreach e [list fromsha1 fromhead tosha1 tohead] \ |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3791 v [list $newid $newhead $oldid $oldhead] { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3792 $patchtop.$e conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3793 $patchtop.$e delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3794 $patchtop.$e insert 0 $v |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3795 $patchtop.$e conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3796 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3797 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3798 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3799 proc mkpatchgo {} { |
4688
39001f4b7d99
hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4502
diff
changeset
|
3800 global patchtop env |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3801 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3802 set oldid [$patchtop.fromsha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3803 set newid [$patchtop.tosha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3804 set fname [$patchtop.fname get] |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
3805 if {[catch {exec $env(HG) --config ui.report_untrusted=false debug-diff-tree -p $oldid $newid >$fname &} err]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3806 error_popup "Error creating patch: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3807 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3808 catch {destroy $patchtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3809 unset patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3810 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3811 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3812 proc mkpatchcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3813 global patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3814 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3815 catch {destroy $patchtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3816 unset patchtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3817 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3818 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3819 proc mktag {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3820 global rowmenuid mktagtop commitinfo |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3821 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3822 set top .maketag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3823 set mktagtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3824 catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3825 toplevel $top |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3826 ttk::label $top.title -text "Create tag" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3827 grid $top.title - -pady 10 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3828 ttk::label $top.id -text "ID:" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3829 ttk::entry $top.sha1 -width 40 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3830 $top.sha1 insert 0 $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3831 $top.sha1 conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3832 grid $top.id $top.sha1 -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3833 ttk::entry $top.head -width 60 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3834 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3835 $top.head conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3836 grid x $top.head -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3837 ttk::label $top.tlab -text "Tag name:" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3838 ttk::entry $top.tag -width 60 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3839 grid $top.tlab $top.tag -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3840 ttk::frame $top.buts |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3841 ttk::button $top.buts.gen -text "Create" -command mktaggo |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3842 ttk::button $top.buts.can -text "Cancel" -command mktagcan |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3843 grid $top.buts.gen $top.buts.can |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3844 grid columnconfigure $top.buts 0 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3845 grid columnconfigure $top.buts 1 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3846 grid $top.buts - -pady 10 -sticky ew |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3847 focus $top.tag |
18804 | 3848 popupify $top |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3849 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3850 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3851 proc domktag {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3852 global mktagtop env tagids idtags |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3853 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3854 set id [$mktagtop.sha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3855 set tag [$mktagtop.tag get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3856 if {$tag == {}} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3857 error_popup "No tag name specified" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3858 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3859 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3860 if {[info exists tagids($tag)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3861 error_popup "Tag \"$tag\" already exists" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3862 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3863 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3864 if {[catch { |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
3865 set out [exec $env(HG) --config ui.report_untrusted=false tag -r $id $tag] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3866 } err]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3867 error_popup "Error creating tag: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3868 return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3869 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3870 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3871 set tagids($tag) $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3872 lappend idtags($id) $tag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3873 redrawtags $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3874 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3875 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3876 proc redrawtags {id} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3877 global canv linehtag idline idpos selectedline |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3878 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3879 if {![info exists idline($id)]} return |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3880 $canv delete tag.$id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3881 set xt [eval drawtags $id $idpos($id)] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3882 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3883 if {[info exists selectedline] && $selectedline == $idline($id)} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3884 selectline $selectedline 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3885 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3886 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3887 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3888 proc mktagcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3889 global mktagtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3890 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3891 catch {destroy $mktagtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3892 unset mktagtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3893 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3894 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3895 proc mktaggo {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3896 domktag |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3897 mktagcan |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3898 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3899 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3900 proc writecommit {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3901 global rowmenuid wrcomtop commitinfo wrcomcmd |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3902 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3903 set top .writecommit |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3904 set wrcomtop $top |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3905 catch {destroy $top} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3906 toplevel $top |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3907 ttk::label $top.title -text "Write commit to file" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3908 grid $top.title - -pady 10 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3909 ttk::label $top.id -text "ID:" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3910 ttk::entry $top.sha1 -width 40 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3911 $top.sha1 insert 0 $rowmenuid |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3912 $top.sha1 conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3913 grid $top.id $top.sha1 -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3914 ttk::entry $top.head -width 60 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3915 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3916 $top.head conf -state readonly |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3917 grid x $top.head -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3918 ttk::label $top.clab -text "Command:" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3919 ttk::entry $top.cmd -width 60 -textvariable wrcomcmd |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3920 grid $top.clab $top.cmd -sticky w -pady 10 |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3921 ttk::label $top.flab -text "Output file:" |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3922 ttk::entry $top.fname -width 60 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3923 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3924 grid $top.flab $top.fname -sticky w |
17958
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3925 ttk::frame $top.buts |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3926 ttk::button $top.buts.gen -text "Write" -command wrcomgo |
0f93bbe8deb7
hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents:
13463
diff
changeset
|
3927 ttk::button $top.buts.can -text "Cancel" -command wrcomcan |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3928 grid $top.buts.gen $top.buts.can |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3929 grid columnconfigure $top.buts 0 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3930 grid columnconfigure $top.buts 1 -weight 1 -uniform a |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3931 grid $top.buts - -pady 10 -sticky ew |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3932 focus $top.fname |
18804 | 3933 popupify $top |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3934 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3935 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3936 proc wrcomgo {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3937 global wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3938 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3939 set id [$wrcomtop.sha1 get] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3940 set cmd "echo $id | [$wrcomtop.cmd get]" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3941 set fname [$wrcomtop.fname get] |
4688
39001f4b7d99
hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4502
diff
changeset
|
3942 if {[catch {exec sh -c $cmd > $fname &} err]} { |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3943 error_popup "Error writing commit: $err" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3944 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3945 catch {destroy $wrcomtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3946 unset wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3947 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3948 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3949 proc wrcomcan {} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3950 global wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3951 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3952 catch {destroy $wrcomtop} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3953 unset wrcomtop |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3954 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3955 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3956 proc listrefs {id} { |
13461 | 3957 global idtags idheads idotherrefs idbookmarks |
3958 | |
3959 set w {} | |
3960 if {[info exists idbookmarks($id)]} { | |
3961 set w $idbookmarks($id) | |
3962 } | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3963 set x {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3964 if {[info exists idtags($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3965 set x $idtags($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3966 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3967 set y {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3968 if {[info exists idheads($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3969 set y $idheads($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3970 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3971 set z {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3972 if {[info exists idotherrefs($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3973 set z $idotherrefs($id) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3974 } |
13461 | 3975 return [list $w $x $y $z] |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3976 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3977 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3978 proc rereadrefs {} { |
13461 | 3979 global idbookmarks idtags idheads idotherrefs |
3980 global bookmarkids tagids headids otherrefids | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3981 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3982 set refids [concat [array names idtags] \ |
13461 | 3983 [array names idheads] [array names idotherrefs] \ |
3984 [array names idbookmarks]] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3985 foreach id $refids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3986 if {![info exists ref($id)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3987 set ref($id) [listrefs $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3988 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3989 } |
13461 | 3990 foreach v {tagids idtags headids idheads otherrefids idotherrefs \ |
3991 bookmarkids idbookmarks} { | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3992 catch {unset $v} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3993 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3994 readrefs |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3995 set refids [lsort -unique [concat $refids [array names idtags] \ |
13461 | 3996 [array names idheads] [array names idotherrefs] \ |
3997 [array names idbookmarks]]] | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3998 foreach id $refids { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
3999 set v [listrefs $id] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4000 if {![info exists ref($id)] || $ref($id) != $v} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4001 redrawtags $id |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4002 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4003 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4004 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4005 |
5394
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4006 proc vdiff {withparent} { |
5417
b8872655f951
hgk: allow any extdiff command for visual diff
TK Soh <teekaysoh@yahoo.com>
parents:
5395
diff
changeset
|
4007 global env rowmenuid selectedline lineid hgvdiff |
5394
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4008 |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4009 if {![info exists rowmenuid]} return |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4010 set curid $rowmenuid |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4011 |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4012 if {$withparent} { |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4013 set parents [exec $env(HG) --config ui.report_untrusted=false parents --rev $curid --template "{node}\n"] |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4014 set firstparent [lindex [split $parents "\n"] 0] |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4015 set otherid $firstparent |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4016 } else { |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4017 if {![info exists selectedline]} return |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4018 set otherid $lineid($selectedline) |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4019 } |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4020 set range "$otherid:$curid" |
5417
b8872655f951
hgk: allow any extdiff command for visual diff
TK Soh <teekaysoh@yahoo.com>
parents:
5395
diff
changeset
|
4021 if {[catch {exec $env(HG) --config ui.report_untrusted=false $hgvdiff -r $range} err]} { |
5394
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4022 # Ignore errors, this is just visualization |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4023 } |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4024 } |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4025 |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4026 proc showtag {tag isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4027 global ctext cflist tagcontents tagids linknum |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4028 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4029 if {$isnew} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4030 addtohistory [list showtag $tag 0] |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4031 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4032 $ctext conf -state normal |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4033 $ctext delete 0.0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4034 set linknum 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4035 if {[info exists tagcontents($tag)]} { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4036 set text $tagcontents($tag) |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4037 } else { |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4038 set text "Tag: $tag\nId: $tagids($tag)" |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4039 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4040 appendwithlinks $text |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4041 $ctext conf -state disabled |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4042 $cflist delete 0 end |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4043 } |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4044 |
267 | 4045 proc doquit {} { |
4046 global stopped | |
4047 set stopped 100 | |
4048 destroy . | |
4049 } | |
4050 | |
5393
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4051 proc getconfig {} { |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4052 global env |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4053 |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4054 set lines [exec $env(HG) debug-config] |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4055 regsub -all "\r\n" $lines "\n" config |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4056 set config {} |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4057 foreach line [split $lines "\n"] { |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4058 regsub "^(k|v)=" $line "" line |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4059 lappend config $line |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4060 } |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4061 return $config |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4062 } |
c2ad1890fc53
hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents:
5392
diff
changeset
|
4063 |
267 | 4064 # defaults... |
4065 set datemode 0 | |
4066 set boldnames 0 | |
4067 set diffopts "-U 5 -p" | |
4740
e1d1b22bab57
Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents:
4688
diff
changeset
|
4068 set wrcomcmd "\"\$HG\" --config ui.report_untrusted=false debug-diff-tree --stdin -p --pretty" |
267 | 4069 |
4070 set mainfont {Helvetica 9} | |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
4071 set curidfont {} |
267 | 4072 set textfont {Courier 9} |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4073 set findmergefiles 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4074 set gaudydiff 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4075 set maxgraphpct 50 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4076 set maxwidth 16 |
267 | 4077 |
4078 set colors {green red blue magenta darkgrey brown orange} | |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
4079 set authorcolors { |
5662
ab5a455cb67c
hgk: add black and blue as preferred colors
Steve Borho <steve@borho.org>
parents:
5506
diff
changeset
|
4080 black blue deeppink mediumorchid blue burlywood4 goldenrod slateblue red2 navy dimgrey |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
4081 } |
7738
db366ec8d0a4
hgk: Add background colour setting
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7039
diff
changeset
|
4082 set bgcolor white |
267 | 4083 |
7745
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
4084 # This color should probably be some system color (provided by tk), |
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
4085 # but as the bgcolor has always been set to white, I choose to ignore |
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
4086 set fgcolor black |
7746
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
4087 set diffaddcolor "#00a000" |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
4088 set diffremcolor red |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
4089 set diffmerge1color red |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
4090 set diffmerge2color blue |
59815cef38f0
hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7745
diff
changeset
|
4091 set hunksepcolor blue |
7745
8bfe47e726fe
hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents:
7738
diff
changeset
|
4092 |
5506
be20a42f27a1
hgk: change config file from .gitk to .hgk
bdowning@lavos.net
parents:
5464
diff
changeset
|
4093 catch {source ~/.hgk} |
267 | 4094 |
5464
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
4095 if {$curidfont == ""} { # initialize late based on current mainfont |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
4096 set curidfont "$mainfont bold italic underline" |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
4097 } |
7dafd9ab3979
hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents:
5417
diff
changeset
|
4098 |
267 | 4099 set namefont $mainfont |
4100 if {$boldnames} { | |
4101 lappend namefont bold | |
4102 } | |
4103 | |
4104 set revtreeargs {} | |
4105 foreach arg $argv { | |
4106 switch -regexp -- $arg { | |
4107 "^$" { } | |
4108 "^-b" { set boldnames 1 } | |
4109 "^-d" { set datemode 1 } | |
4110 default { | |
4111 lappend revtreeargs $arg | |
4112 } | |
4113 } | |
4114 } | |
4115 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4116 set history {} |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4117 set historyindex 0 |
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4118 |
267 | 4119 set stopped 0 |
4120 set redisplaying 0 | |
4121 set stuffsaved 0 | |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4122 set patchnum 0 |
5394
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4123 |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4124 array set config [getconfig] |
0ad0e97345eb
hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents:
5393
diff
changeset
|
4125 set hgvdiff $config(vdiff) |
267 | 4126 setcoords |
4127 makewindow | |
4128 readrefs | |
5284
f8c36b215281
hgk: add repo root to window title
Steve Borho <steve@borho.org>
parents:
5143
diff
changeset
|
4129 set hgroot [exec $env(HG) root] |
f8c36b215281
hgk: add repo root to window title
Steve Borho <steve@borho.org>
parents:
5143
diff
changeset
|
4130 wm title . "hgk $hgroot" |
1240
cc756ffd4d04
Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents:
283
diff
changeset
|
4131 getcommits $revtreeargs |