Show More
This diff has been collapsed as it changes many lines, (3345 lines changed) Show them Hide them | |||||
@@ -7,68 +7,170 b' exec wish "$0" -- "${1+$@}"' | |||||
7 | # and distributed under the terms of the GNU General Public Licence, |
|
7 | # and distributed under the terms of the GNU General Public Licence, | |
8 | # either version 2, or (at your option) any later version. |
|
8 | # either version 2, or (at your option) any later version. | |
9 |
|
9 | |||
10 | # CVS $Revision: 1.20 $ |
|
10 | proc gitdir {} { | |
11 |
|
11 | global env | ||
12 | proc readfullcommits {rargs} { |
|
12 | if {[info exists env(GIT_DIR)]} { | |
13 | global commits commfd phase canv mainfont curcommit allcommitstate |
|
13 | return $env(GIT_DIR) | |
14 | if {$rargs == {}} { |
|
14 | } else { | |
15 | set rargs HEAD |
|
15 | return ".hg" | |
16 | } |
|
16 | } | |
17 | set commits {} |
|
17 | } | |
18 | set curcommit {} |
|
18 | ||
19 | set allcommitstate none |
|
19 | proc getcommits {rargs} { | |
20 | set phase getcommits |
|
20 | global commits commfd phase canv mainfont env | |
21 | if [catch {set commfd [open "|hgit rev-list -c $rargs" r]} err] { |
|
21 | global startmsecs nextupdate ncmupdate | |
22 | puts stderr "Error executing hgit rev-list: $err" |
|
22 | global ctext maincursor textcursor leftover | |
|
23 | ||||
|
24 | # check that we can find a .git directory somewhere... | |||
|
25 | set gitdir [gitdir] | |||
|
26 | if {![file isdirectory $gitdir]} { | |||
|
27 | error_popup "Cannot find the git directory \"$gitdir\"." | |||
23 | exit 1 |
|
28 | exit 1 | |
24 | } |
|
29 | } | |
25 | fconfigure $commfd -blocking 0 |
|
30 | set commits {} | |
26 | fileevent $commfd readable "getallcommitline $commfd" |
|
31 | set phase getcommits | |
|
32 | set startmsecs [clock clicks -milliseconds] | |||
|
33 | set nextupdate [expr $startmsecs + 100] | |||
|
34 | set ncmupdate 1 | |||
|
35 | if [catch { | |||
|
36 | set parse_args [concat --default HEAD $rargs] | |||
|
37 | set parsed_args [split [eval exec hg git-rev-parse $parse_args] "\n"] | |||
|
38 | }] { | |||
|
39 | # if git-rev-parse failed for some reason... | |||
|
40 | if {$rargs == {}} { | |||
|
41 | set rargs HEAD | |||
|
42 | } | |||
|
43 | set parsed_args $rargs | |||
|
44 | } | |||
|
45 | if [catch { | |||
|
46 | set commfd [open "|hg git-rev-list --header --topo-order --parents $parsed_args" r] | |||
|
47 | } err] { | |||
|
48 | puts stderr "Error executing hg git-rev-list: $err" | |||
|
49 | exit 1 | |||
|
50 | } | |||
|
51 | set leftover {} | |||
|
52 | fconfigure $commfd -blocking 0 -translation lf | |||
|
53 | fileevent $commfd readable [list getcommitlines $commfd] | |||
27 | $canv delete all |
|
54 | $canv delete all | |
28 |
$canv create text 3 3 -anchor nw -text "Reading |
|
55 | $canv create text 3 3 -anchor nw -text "Reading commits..." \ | |
29 | -font $mainfont -tags textitems |
|
56 | -font $mainfont -tags textitems | |
|
57 | . config -cursor watch | |||
|
58 | settextcursor watch | |||
30 | } |
|
59 | } | |
31 |
|
60 | |||
32 | proc getcommitline {commfd} { |
|
61 | proc getcommitlines {commfd} { | |
33 |
global commits parents cdate |
|
62 | global commits parents cdate children | |
34 | set n [gets $commfd line] |
|
63 | global commitlisted phase commitinfo nextupdate | |
35 | if {$n < 0} { |
|
64 | global stopped redisplaying leftover | |
|
65 | ||||
|
66 | set stuff [read $commfd] | |||
|
67 | if {$stuff == {}} { | |||
36 | if {![eof $commfd]} return |
|
68 | if {![eof $commfd]} return | |
37 | # this works around what is apparently a bug in Tcl... |
|
69 | # set it blocking so we wait for the process to terminate | |
38 | fconfigure $commfd -blocking 1 |
|
70 | fconfigure $commfd -blocking 1 | |
39 | if {![catch {close $commfd} err]} { |
|
71 | if {![catch {close $commfd} err]} { | |
40 |
after idle |
|
72 | after idle finishcommits | |
41 | return |
|
73 | return | |
42 | } |
|
74 | } | |
43 | if {[string range $err 0 4] == "usage"} { |
|
75 | if {[string range $err 0 4] == "usage"} { | |
44 |
set err |
|
76 | set err \ | |
45 |
Gitk: error reading commits: bad arguments to |
|
77 | {Gitk: error reading commits: bad arguments to git-rev-list. | |
46 |
(Note: arguments to gitk are passed to |
|
78 | (Note: arguments to gitk are passed to git-rev-list | |
47 |
to allow selection of commits to be displayed.) |
|
79 | to allow selection of commits to be displayed.)} | |
48 | } else { |
|
80 | } else { | |
49 | set err "Error reading commits: $err" |
|
81 | set err "Error reading commits: $err" | |
50 | } |
|
82 | } | |
51 | error_popup $err |
|
83 | error_popup $err | |
52 | exit 1 |
|
84 | exit 1 | |
53 | } |
|
85 | } | |
54 | if {![regexp {^[0-9a-f]{40}$} $line]} { |
|
86 | set start 0 | |
55 | error_popup "Can't parse hgit rev-tree output: {$line}" |
|
87 | while 1 { | |
56 | exit 1 |
|
88 | set i [string first "\0" $stuff $start] | |
|
89 | if {$i < 0} { | |||
|
90 | append leftover [string range $stuff $start end] | |||
|
91 | return | |||
|
92 | } | |||
|
93 | set cmit [string range $stuff $start [expr {$i - 1}]] | |||
|
94 | if {$start == 0} { | |||
|
95 | set cmit "$leftover$cmit" | |||
|
96 | set leftover {} | |||
|
97 | } | |||
|
98 | set start [expr {$i + 1}] | |||
|
99 | set j [string first "\n" $cmit] | |||
|
100 | set ok 0 | |||
|
101 | if {$j >= 0} { | |||
|
102 | set ids [string range $cmit 0 [expr {$j - 1}]] | |||
|
103 | set ok 1 | |||
|
104 | foreach id $ids { | |||
|
105 | if {![regexp {^[0-9a-f]{40}$} $id]} { | |||
|
106 | set ok 0 | |||
|
107 | break | |||
|
108 | } | |||
|
109 | } | |||
|
110 | } | |||
|
111 | if {!$ok} { | |||
|
112 | set shortcmit $cmit | |||
|
113 | if {[string length $shortcmit] > 80} { | |||
|
114 | set shortcmit "[string range $shortcmit 0 80]..." | |||
|
115 | } | |||
|
116 | error_popup "Can't parse hg git-rev-list output: {$shortcmit}" | |||
|
117 | exit 1 | |||
|
118 | } | |||
|
119 | set id [lindex $ids 0] | |||
|
120 | set olds [lrange $ids 1 end] | |||
|
121 | set cmit [string range $cmit [expr {$j + 1}] end] | |||
|
122 | lappend commits $id | |||
|
123 | set commitlisted($id) 1 | |||
|
124 | parsecommit $id $cmit 1 [lrange $ids 1 end] | |||
|
125 | drawcommit $id | |||
|
126 | if {[clock clicks -milliseconds] >= $nextupdate} { | |||
|
127 | doupdate 1 | |||
|
128 | } | |||
|
129 | while {$redisplaying} { | |||
|
130 | set redisplaying 0 | |||
|
131 | if {$stopped == 1} { | |||
|
132 | set stopped 0 | |||
|
133 | set phase "getcommits" | |||
|
134 | foreach id $commits { | |||
|
135 | drawcommit $id | |||
|
136 | if {$stopped} break | |||
|
137 | if {[clock clicks -milliseconds] >= $nextupdate} { | |||
|
138 | doupdate 1 | |||
|
139 | } | |||
|
140 | } | |||
|
141 | } | |||
|
142 | } | |||
57 | } |
|
143 | } | |
58 | lappend commits $line |
|
|||
59 | } |
|
144 | } | |
60 |
|
145 | |||
61 | proc readallcommits {} { |
|
146 | proc doupdate {reading} { | |
62 | global commits |
|
147 | global commfd nextupdate numcommits ncmupdate | |
63 | foreach id $commits { |
|
148 | ||
64 | readcommit $id |
|
149 | if {$reading} { | |
65 | update |
|
150 | fileevent $commfd readable {} | |
66 | } |
|
151 | } | |
67 | drawgraph |
|
152 | update | |
|
153 | set nextupdate [expr {[clock clicks -milliseconds] + 100}] | |||
|
154 | if {$numcommits < 100} { | |||
|
155 | set ncmupdate [expr {$numcommits + 1}] | |||
|
156 | } elseif {$numcommits < 10000} { | |||
|
157 | set ncmupdate [expr {$numcommits + 10}] | |||
|
158 | } else { | |||
|
159 | set ncmupdate [expr {$numcommits + 100}] | |||
|
160 | } | |||
|
161 | if {$reading} { | |||
|
162 | fileevent $commfd readable [list getcommitlines $commfd] | |||
|
163 | } | |||
68 | } |
|
164 | } | |
69 |
|
165 | |||
70 |
proc read |
|
166 | proc readcommit {id} { | |
71 | global commitinfo children nchildren parents nparents cdate |
|
167 | if [catch {set contents [exec hg git-cat-file commit $id]}] return | |
|
168 | parsecommit $id $contents 0 {} | |||
|
169 | } | |||
|
170 | ||||
|
171 | proc parsecommit {id contents listed olds} { | |||
|
172 | global commitinfo children nchildren parents nparents cdate ncleft | |||
|
173 | ||||
72 | set inhdr 1 |
|
174 | set inhdr 1 | |
73 | set comment {} |
|
175 | set comment {} | |
74 | set headline {} |
|
176 | set headline {} | |
@@ -79,28 +181,28 b' proc readonecommit {id contents} {' | |||||
79 | if {![info exists nchildren($id)]} { |
|
181 | if {![info exists nchildren($id)]} { | |
80 | set children($id) {} |
|
182 | set children($id) {} | |
81 | set nchildren($id) 0 |
|
183 | set nchildren($id) 0 | |
|
184 | set ncleft($id) 0 | |||
82 | } |
|
185 | } | |
83 |
set parents($id) |
|
186 | set parents($id) $olds | |
84 |
set nparents($id) |
|
187 | set nparents($id) [llength $olds] | |
|
188 | foreach p $olds { | |||
|
189 | if {![info exists nchildren($p)]} { | |||
|
190 | set children($p) [list $id] | |||
|
191 | set nchildren($p) 1 | |||
|
192 | set ncleft($p) 1 | |||
|
193 | } elseif {[lsearch -exact $children($p) $id] < 0} { | |||
|
194 | lappend children($p) $id | |||
|
195 | incr nchildren($p) | |||
|
196 | incr ncleft($p) | |||
|
197 | } | |||
|
198 | } | |||
85 | foreach line [split $contents "\n"] { |
|
199 | foreach line [split $contents "\n"] { | |
86 | if {$inhdr} { |
|
200 | if {$inhdr} { | |
87 | if {$line == {}} { |
|
201 | if {$line == {}} { | |
88 | set inhdr 0 |
|
202 | set inhdr 0 | |
89 | } else { |
|
203 | } else { | |
90 | set tag [lindex $line 0] |
|
204 | set tag [lindex $line 0] | |
91 |
if {$tag == " |
|
205 | if {$tag == "author"} { | |
92 | set p [lindex $line 1] |
|
|||
93 | if {![info exists nchildren($p)]} { |
|
|||
94 | set children($p) {} |
|
|||
95 | set nchildren($p) 0 |
|
|||
96 | } |
|
|||
97 | lappend parents($id) $p |
|
|||
98 | incr nparents($id) |
|
|||
99 | if {[lsearch -exact $children($p) $id] < 0} { |
|
|||
100 | lappend children($p) $id |
|
|||
101 | incr nchildren($p) |
|
|||
102 | } |
|
|||
103 | } elseif {$tag == "author"} { |
|
|||
104 | set x [expr {[llength $line] - 2}] |
|
206 | set x [expr {[llength $line] - 2}] | |
105 | set audate [lindex $line $x] |
|
207 | set audate [lindex $line $x] | |
106 | set auname [lrange $line 1 [expr {$x - 1}]] |
|
208 | set auname [lrange $line 1 [expr {$x - 1}]] | |
@@ -112,10 +214,15 b' proc readonecommit {id contents} {' | |||||
112 | } |
|
214 | } | |
113 | } else { |
|
215 | } else { | |
114 | if {$comment == {}} { |
|
216 | if {$comment == {}} { | |
115 | set headline $line |
|
217 | set headline [string trim $line] | |
116 | } else { |
|
218 | } else { | |
117 | append comment "\n" |
|
219 | append comment "\n" | |
118 | } |
|
220 | } | |
|
221 | if {!$listed} { | |||
|
222 | # git-rev-list indents the comment by 4 spaces; | |||
|
223 | # if we got this via git-cat-file, add the indentation | |||
|
224 | append comment " " | |||
|
225 | } | |||
119 | append comment $line |
|
226 | append comment $line | |
120 | } |
|
227 | } | |
121 | } |
|
228 | } | |
@@ -130,115 +237,45 b' proc readonecommit {id contents} {' | |||||
130 | $comname $comdate $comment] |
|
237 | $comname $comdate $comment] | |
131 | } |
|
238 | } | |
132 |
|
239 | |||
133 | proc getallcommitline {commfd} { |
|
240 | proc readrefs {} { | |
134 | global commits allcommitstate curcommit curcommitid |
|
241 | global tagids idtags headids idheads tagcontents | |
135 | set n [gets $commfd line] |
|
242 | ||
136 | set s "\n" |
|
243 | set tags [exec hg tags] | |
137 | if {$n < 0} { |
|
244 | set lines [split $tags '\n'] | |
138 | if {![eof $commfd]} return |
|
245 | foreach f $lines { | |
139 | # this works around what is apparently a bug in Tcl... |
|
246 | set f [regexp -all -inline {\S+} $f] | |
140 | fconfigure $commfd -blocking 1 |
|
247 | set direct [lindex $f 0] | |
141 | if {![catch {close $commfd} err]} { |
|
248 | set full [lindex $f 1] | |
142 | if {$allcommitstate == "indent"} { |
|
249 | set sha [split $full ':'] | |
143 | readonecommit $curcommitid $curcommit |
|
250 | set tag [lindex $sha 1] | |
144 | } |
|
251 | lappend tagids($direct) $tag | |
145 | after idle drawgraph |
|
252 | lappend idtags($tag) $direct | |
146 | return |
|
|||
147 | } |
|
|||
148 | if {[string range $err 0 4] == "usage"} { |
|
|||
149 | set err "\ |
|
|||
150 | Gitk: error reading commits: bad arguments to hgit rev-list.\n\ |
|
|||
151 | (Note: arguments to gitk are passed to hgit rev-list\ |
|
|||
152 | to allow selection of commits to be displayed.)" |
|
|||
153 | } else { |
|
|||
154 | set err "Error reading commits: $err" |
|
|||
155 | } |
|
|||
156 | error_popup $err |
|
|||
157 | exit 1 |
|
|||
158 | } |
|
|||
159 | if {[string range $line 0 1] != " "} { |
|
|||
160 | if {$allcommitstate == "indent"} { |
|
|||
161 | readonecommit $curcommitid $curcommit |
|
|||
162 | } |
|
|||
163 | if {$allcommitstate == "start"} { |
|
|||
164 | set curcommit $curcommit$line$s |
|
|||
165 | set allcommitstate "indent" |
|
|||
166 | } else { |
|
|||
167 | set curcommitid $line |
|
|||
168 | set curcommit {} |
|
|||
169 | set allcommitstate "start" |
|
|||
170 | lappend commits $line |
|
|||
171 | } |
|
|||
172 | } else { |
|
|||
173 | set d [string range $line 2 end] |
|
|||
174 | set curcommit $curcommit$d$s |
|
|||
175 | } |
|
253 | } | |
176 | } |
|
254 | } | |
177 |
|
255 | |||
178 | proc getcommits {rargs} { |
|
256 | proc readotherrefs {base dname excl} { | |
179 | global commits commfd phase canv mainfont |
|
257 | global otherrefids idotherrefs | |
180 | if {$rargs == {}} { |
|
|||
181 | set rargs HEAD |
|
|||
182 | } |
|
|||
183 | set commits {} |
|
|||
184 | set phase getcommits |
|
|||
185 | if [catch {set commfd [open "|hgit rev-list $rargs" r]} err] { |
|
|||
186 | puts stderr "Error executing hgit rev-list: $err" |
|
|||
187 | exit 1 |
|
|||
188 | } |
|
|||
189 | fconfigure $commfd -blocking 0 |
|
|||
190 | fileevent $commfd readable "getcommitline $commfd" |
|
|||
191 | $canv delete all |
|
|||
192 | $canv create text 3 3 -anchor nw -text "Reading commits..." \ |
|
|||
193 | -font $mainfont -tags textitems |
|
|||
194 | } |
|
|||
195 |
|
258 | |||
196 | proc readcommit {id} { |
|
259 | set git [gitdir] | |
197 | global commitinfo children nchildren parents nparents cdate |
|
260 | set files [glob -nocomplain -types f [file join $git $base *]] | |
198 | set inhdr 1 |
|
261 | foreach f $files { | |
199 | set comment {} |
|
|||
200 | set headline {} |
|
|||
201 | set auname {} |
|
|||
202 | set audate {} |
|
|||
203 | set comname {} |
|
|||
204 | set comdate {} |
|
|||
205 | if {![info exists nchildren($id)]} { |
|
|||
206 | set children($id) {} |
|
|||
207 | set nchildren($id) 0 |
|
|||
208 | } |
|
|||
209 | set parents($id) {} |
|
|||
210 | set nparents($id) 0 |
|
|||
211 | if [catch {set contents [exec hgit cat-file commit $id]}] return |
|
|||
212 | readonecommit $id $contents |
|
|||
213 | } |
|
|||
214 |
|
||||
215 | proc readrefs {} { |
|
|||
216 | global tagids idtags |
|
|||
217 | set tags [glob -nocomplain -types f .git/refs/tags/*] |
|
|||
218 | foreach f $tags { |
|
|||
219 | catch { |
|
262 | catch { | |
220 | set fd [open $f r] |
|
263 | set fd [open $f r] | |
221 | set line [read $fd] |
|
264 | set line [read $fd 40] | |
222 | if {[regexp {^[0-9a-f]{40}} $line id]} { |
|
265 | if {[regexp {^[0-9a-f]{40}} $line id]} { | |
223 | set contents [split [exec hgit cat-file tag $id] "\n"] |
|
266 | set name "$dname[file tail $f]" | |
224 | set obj {} |
|
267 | set otherrefids($name) $id | |
225 | set type {} |
|
268 | lappend idotherrefs($id) $name | |
226 | set tag {} |
|
|||
227 | foreach l $contents { |
|
|||
228 | if {$l == {}} break |
|
|||
229 | switch -- [lindex $l 0] { |
|
|||
230 | "object" {set obj [lindex $l 1]} |
|
|||
231 | "type" {set type [lindex $l 1]} |
|
|||
232 | "tag" {set tag [string range $l 4 end]} |
|
|||
233 | } |
|
|||
234 | } |
|
|||
235 | if {$obj != {} && $type == "commit" && $tag != {}} { |
|
|||
236 | set tagids($tag) $obj |
|
|||
237 | lappend idtags($obj) $tag |
|
|||
238 | } |
|
|||
239 | } |
|
269 | } | |
|
270 | close $fd | |||
240 | } |
|
271 | } | |
241 | } |
|
272 | } | |
|
273 | set dirs [glob -nocomplain -types d [file join $git $base *]] | |||
|
274 | foreach d $dirs { | |||
|
275 | set dir [file tail $d] | |||
|
276 | if {[lsearch -exact $excl $dir] >= 0} continue | |||
|
277 | readotherrefs [file join $base $dir] "$dname$dir/" {} | |||
|
278 | } | |||
242 | } |
|
279 | } | |
243 |
|
280 | |||
244 | proc error_popup msg { |
|
281 | proc error_popup msg { | |
@@ -255,12 +292,15 b' proc error_popup msg {' | |||||
255 |
|
292 | |||
256 | proc makewindow {} { |
|
293 | proc makewindow {} { | |
257 | global canv canv2 canv3 linespc charspc ctext cflist textfont |
|
294 | global canv canv2 canv3 linespc charspc ctext cflist textfont | |
258 | global findtype findloc findstring fstring geometry |
|
295 | global findtype findtypemenu findloc findstring fstring geometry | |
259 | global entries sha1entry sha1string sha1but |
|
296 | global entries sha1entry sha1string sha1but | |
|
297 | global maincursor textcursor curtextcursor | |||
|
298 | global rowctxmenu gaudydiff mergemax | |||
260 |
|
299 | |||
261 | menu .bar |
|
300 | menu .bar | |
262 | .bar add cascade -label "File" -menu .bar.file |
|
301 | .bar add cascade -label "File" -menu .bar.file | |
263 | menu .bar.file |
|
302 | menu .bar.file | |
|
303 | .bar.file add command -label "Reread references" -command rereadrefs | |||
264 | .bar.file add command -label "Quit" -command doquit |
|
304 | .bar.file add command -label "Quit" -command doquit | |
265 | menu .bar.help |
|
305 | menu .bar.help | |
266 | .bar add cascade -label "Help" -menu .bar.help |
|
306 | .bar add cascade -label "Help" -menu .bar.help | |
@@ -317,6 +357,30 b' proc makewindow {} {' | |||||
317 | entry $sha1entry -width 40 -font $textfont -textvariable sha1string |
|
357 | entry $sha1entry -width 40 -font $textfont -textvariable sha1string | |
318 | trace add variable sha1string write sha1change |
|
358 | trace add variable sha1string write sha1change | |
319 | pack $sha1entry -side left -pady 2 |
|
359 | pack $sha1entry -side left -pady 2 | |
|
360 | ||||
|
361 | image create bitmap bm-left -data { | |||
|
362 | #define left_width 16 | |||
|
363 | #define left_height 16 | |||
|
364 | static unsigned char left_bits[] = { | |||
|
365 | 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00, | |||
|
366 | 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00, | |||
|
367 | 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01}; | |||
|
368 | } | |||
|
369 | image create bitmap bm-right -data { | |||
|
370 | #define right_width 16 | |||
|
371 | #define right_height 16 | |||
|
372 | static unsigned char right_bits[] = { | |||
|
373 | 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c, | |||
|
374 | 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c, | |||
|
375 | 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01}; | |||
|
376 | } | |||
|
377 | button .ctop.top.bar.leftbut -image bm-left -command goback \ | |||
|
378 | -state disabled -width 26 | |||
|
379 | pack .ctop.top.bar.leftbut -side left -fill y | |||
|
380 | button .ctop.top.bar.rightbut -image bm-right -command goforw \ | |||
|
381 | -state disabled -width 26 | |||
|
382 | pack .ctop.top.bar.rightbut -side left -fill y | |||
|
383 | ||||
320 | button .ctop.top.bar.findbut -text "Find" -command dofind |
|
384 | button .ctop.top.bar.findbut -text "Find" -command dofind | |
321 | pack .ctop.top.bar.findbut -side left |
|
385 | pack .ctop.top.bar.findbut -side left | |
322 | set findstring {} |
|
386 | set findstring {} | |
@@ -325,12 +389,15 b' proc makewindow {} {' | |||||
325 | entry $fstring -width 30 -font $textfont -textvariable findstring |
|
389 | entry $fstring -width 30 -font $textfont -textvariable findstring | |
326 | pack $fstring -side left -expand 1 -fill x |
|
390 | pack $fstring -side left -expand 1 -fill x | |
327 | set findtype Exact |
|
391 | set findtype Exact | |
328 |
tk_optionMenu .ctop.top.bar.findtype |
|
392 | set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \ | |
|
393 | findtype Exact IgnCase Regexp] | |||
329 | set findloc "All fields" |
|
394 | set findloc "All fields" | |
330 | tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ |
|
395 | tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ | |
331 | Comments Author Committer |
|
396 | Comments Author Committer Files Pickaxe | |
332 | pack .ctop.top.bar.findloc -side right |
|
397 | pack .ctop.top.bar.findloc -side right | |
333 | pack .ctop.top.bar.findtype -side right |
|
398 | pack .ctop.top.bar.findtype -side right | |
|
399 | # for making sure type==Exact whenever loc==Pickaxe | |||
|
400 | trace add variable findloc write findlocchange | |||
334 |
|
401 | |||
335 | panedwindow .ctop.cdet -orient horizontal |
|
402 | panedwindow .ctop.cdet -orient horizontal | |
336 | .ctop add .ctop.cdet |
|
403 | .ctop add .ctop.cdet | |
@@ -338,17 +405,32 b' proc makewindow {} {' | |||||
338 | set ctext .ctop.cdet.left.ctext |
|
405 | set ctext .ctop.cdet.left.ctext | |
339 | text $ctext -bg white -state disabled -font $textfont \ |
|
406 | text $ctext -bg white -state disabled -font $textfont \ | |
340 | -width $geometry(ctextw) -height $geometry(ctexth) \ |
|
407 | -width $geometry(ctextw) -height $geometry(ctexth) \ | |
341 | -yscrollcommand ".ctop.cdet.left.sb set" |
|
408 | -yscrollcommand ".ctop.cdet.left.sb set" -wrap none | |
342 | scrollbar .ctop.cdet.left.sb -command "$ctext yview" |
|
409 | scrollbar .ctop.cdet.left.sb -command "$ctext yview" | |
343 | pack .ctop.cdet.left.sb -side right -fill y |
|
410 | pack .ctop.cdet.left.sb -side right -fill y | |
344 | pack $ctext -side left -fill both -expand 1 |
|
411 | pack $ctext -side left -fill both -expand 1 | |
345 | .ctop.cdet add .ctop.cdet.left |
|
412 | .ctop.cdet add .ctop.cdet.left | |
346 |
|
413 | |||
347 | $ctext tag conf filesep -font [concat $textfont bold] |
|
414 | $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" | |
348 | $ctext tag conf hunksep -back blue -fore white |
|
415 | if {$gaudydiff} { | |
349 | $ctext tag conf d0 -back "#ff8080" |
|
416 | $ctext tag conf hunksep -back blue -fore white | |
350 |
|
|
417 | $ctext tag conf d0 -back "#ff8080" | |
351 |
|
|
418 | $ctext tag conf d1 -back green | |
|
419 | } else { | |||
|
420 | $ctext tag conf hunksep -fore blue | |||
|
421 | $ctext tag conf d0 -fore red | |||
|
422 | $ctext tag conf d1 -fore "#00a000" | |||
|
423 | $ctext tag conf m0 -fore red | |||
|
424 | $ctext tag conf m1 -fore blue | |||
|
425 | $ctext tag conf m2 -fore green | |||
|
426 | $ctext tag conf m3 -fore purple | |||
|
427 | $ctext tag conf m4 -fore brown | |||
|
428 | $ctext tag conf mmax -fore darkgrey | |||
|
429 | set mergemax 5 | |||
|
430 | $ctext tag conf mresult -font [concat $textfont bold] | |||
|
431 | $ctext tag conf msep -font [concat $textfont bold] | |||
|
432 | $ctext tag conf found -back yellow | |||
|
433 | } | |||
352 |
|
434 | |||
353 | frame .ctop.cdet.right |
|
435 | frame .ctop.cdet.right | |
354 | set cflist .ctop.cdet.right.cfiles |
|
436 | set cflist .ctop.cdet.right.cfiles | |
@@ -362,8 +444,8 b' proc makewindow {} {' | |||||
362 |
|
444 | |||
363 | pack .ctop -side top -fill both -expand 1 |
|
445 | pack .ctop -side top -fill both -expand 1 | |
364 |
|
446 | |||
365 | bindall <1> {selcanvline %x %y} |
|
447 | bindall <1> {selcanvline %W %x %y} | |
366 | bindall <B1-Motion> {selcanvline %x %y} |
|
448 | #bindall <B1-Motion> {selcanvline %W %x %y} | |
367 | bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" |
|
449 | bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" | |
368 | bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" |
|
450 | bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" | |
369 | bindall <2> "allcanvs scan mark 0 %y" |
|
451 | bindall <2> "allcanvs scan mark 0 %y" | |
@@ -380,12 +462,13 b' proc makewindow {} {' | |||||
380 | bindkey b "$ctext yview scroll -1 pages" |
|
462 | bindkey b "$ctext yview scroll -1 pages" | |
381 | bindkey d "$ctext yview scroll 18 units" |
|
463 | bindkey d "$ctext yview scroll 18 units" | |
382 | bindkey u "$ctext yview scroll -18 units" |
|
464 | bindkey u "$ctext yview scroll -18 units" | |
383 | bindkey / findnext |
|
465 | bindkey / {findnext 1} | |
|
466 | bindkey <Key-Return> {findnext 0} | |||
384 | bindkey ? findprev |
|
467 | bindkey ? findprev | |
385 | bindkey f nextfile |
|
468 | bindkey f nextfile | |
386 | bind . <Control-q> doquit |
|
469 | bind . <Control-q> doquit | |
387 | bind . <Control-f> dofind |
|
470 | bind . <Control-f> dofind | |
388 | bind . <Control-g> findnext |
|
471 | bind . <Control-g> {findnext 0} | |
389 | bind . <Control-r> findprev |
|
472 | bind . <Control-r> findprev | |
390 | bind . <Control-equal> {incrfont 1} |
|
473 | bind . <Control-equal> {incrfont 1} | |
391 | bind . <Control-KP_Add> {incrfont 1} |
|
474 | bind . <Control-KP_Add> {incrfont 1} | |
@@ -396,6 +479,21 b' proc makewindow {} {' | |||||
396 | bind . <Button-1> "click %W" |
|
479 | bind . <Button-1> "click %W" | |
397 | bind $fstring <Key-Return> dofind |
|
480 | bind $fstring <Key-Return> dofind | |
398 | bind $sha1entry <Key-Return> gotocommit |
|
481 | bind $sha1entry <Key-Return> gotocommit | |
|
482 | bind $sha1entry <<PasteSelection>> clearsha1 | |||
|
483 | ||||
|
484 | set maincursor [. cget -cursor] | |||
|
485 | set textcursor [$ctext cget -cursor] | |||
|
486 | set curtextcursor $textcursor | |||
|
487 | ||||
|
488 | set rowctxmenu .rowctxmenu | |||
|
489 | menu $rowctxmenu -tearoff 0 | |||
|
490 | $rowctxmenu add command -label "Diff this -> selected" \ | |||
|
491 | -command {diffvssel 0} | |||
|
492 | $rowctxmenu add command -label "Diff selected -> this" \ | |||
|
493 | -command {diffvssel 1} | |||
|
494 | $rowctxmenu add command -label "Make patch" -command mkpatch | |||
|
495 | $rowctxmenu add command -label "Create tag" -command mktag | |||
|
496 | $rowctxmenu add command -label "Write commit to file" -command writecommit | |||
399 | } |
|
497 | } | |
400 |
|
498 | |||
401 | # when we make a key binding for the toplevel, make sure |
|
499 | # when we make a key binding for the toplevel, make sure | |
@@ -425,13 +523,19 b' proc click {w} {' | |||||
425 |
|
523 | |||
426 | proc savestuff {w} { |
|
524 | proc savestuff {w} { | |
427 | global canv canv2 canv3 ctext cflist mainfont textfont |
|
525 | global canv canv2 canv3 ctext cflist mainfont textfont | |
428 | global stuffsaved |
|
526 | global stuffsaved findmergefiles gaudydiff maxgraphpct | |
|
527 | global maxwidth | |||
|
528 | ||||
429 | if {$stuffsaved} return |
|
529 | if {$stuffsaved} return | |
430 | if {![winfo viewable .]} return |
|
530 | if {![winfo viewable .]} return | |
431 | catch { |
|
531 | catch { | |
432 | set f [open "~/.gitk-new" w] |
|
532 | set f [open "~/.gitk-new" w] | |
433 |
puts $f |
|
533 | puts $f [list set mainfont $mainfont] | |
434 |
puts $f |
|
534 | puts $f [list set textfont $textfont] | |
|
535 | puts $f [list set findmergefiles $findmergefiles] | |||
|
536 | puts $f [list set gaudydiff $gaudydiff] | |||
|
537 | puts $f [list set maxgraphpct $maxgraphpct] | |||
|
538 | puts $f [list set maxwidth $maxwidth] | |||
435 | puts $f "set geometry(width) [winfo width .ctop]" |
|
539 | puts $f "set geometry(width) [winfo width .ctop]" | |
436 | puts $f "set geometry(height) [winfo height .ctop]" |
|
540 | puts $f "set geometry(height) [winfo height .ctop]" | |
437 | puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" |
|
541 | puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" | |
@@ -525,66 +629,60 b' proc about {} {' | |||||
525 | toplevel $w |
|
629 | toplevel $w | |
526 | wm title $w "About gitk" |
|
630 | wm title $w "About gitk" | |
527 | message $w.m -text { |
|
631 | message $w.m -text { | |
528 |
Gitk version 1. |
|
632 | Gitk version 1.2 | |
529 |
|
633 | |||
530 | Copyright οΏ½ 2005 Paul Mackerras |
|
634 | Copyright οΏ½ 2005 Paul Mackerras | |
531 |
|
635 | |||
532 | Use and redistribute under the terms of the GNU General Public License |
|
636 | Use and redistribute under the terms of the GNU General Public License} \ | |
533 |
|
||||
534 | (CVS $Revision: 1.20 $)} \ |
|
|||
535 | -justify center -aspect 400 |
|
637 | -justify center -aspect 400 | |
536 | pack $w.m -side top -fill x -padx 20 -pady 20 |
|
638 | pack $w.m -side top -fill x -padx 20 -pady 20 | |
537 | button $w.ok -text Close -command "destroy $w" |
|
639 | button $w.ok -text Close -command "destroy $w" | |
538 | pack $w.ok -side bottom |
|
640 | pack $w.ok -side bottom | |
539 | } |
|
641 | } | |
540 |
|
642 | |||
541 | proc truncatetofit {str width font} { |
|
|||
542 | if {[font measure $font $str] <= $width} { |
|
|||
543 | return $str |
|
|||
544 | } |
|
|||
545 | set best 0 |
|
|||
546 | set bad [string length $str] |
|
|||
547 | set tmp $str |
|
|||
548 | while {$best < $bad - 1} { |
|
|||
549 | set try [expr {int(($best + $bad) / 2)}] |
|
|||
550 | set tmp "[string range $str 0 [expr $try-1]]..." |
|
|||
551 | if {[font measure $font $tmp] <= $width} { |
|
|||
552 | set best $try |
|
|||
553 | } else { |
|
|||
554 | set bad $try |
|
|||
555 | } |
|
|||
556 | } |
|
|||
557 | return $tmp |
|
|||
558 | } |
|
|||
559 |
|
||||
560 | proc assigncolor {id} { |
|
643 | proc assigncolor {id} { | |
561 | global commitinfo colormap commcolors colors nextcolor |
|
644 | global commitinfo colormap commcolors colors nextcolor | |
562 | global colorbycommitter |
|
|||
563 | global parents nparents children nchildren |
|
645 | global parents nparents children nchildren | |
|
646 | global cornercrossings crossings | |||
|
647 | ||||
564 | if [info exists colormap($id)] return |
|
648 | if [info exists colormap($id)] return | |
565 | set ncolors [llength $colors] |
|
649 | set ncolors [llength $colors] | |
566 | if {$colorbycommitter} { |
|
650 | if {$nparents($id) <= 1 && $nchildren($id) == 1} { | |
567 | if {![info exists commitinfo($id)]} { |
|
651 | set child [lindex $children($id) 0] | |
568 | readcommit $id |
|
652 | if {[info exists colormap($child)] | |
|
653 | && $nparents($child) == 1} { | |||
|
654 | set colormap($id) $colormap($child) | |||
|
655 | return | |||
569 | } |
|
656 | } | |
570 | set comm [lindex $commitinfo($id) 3] |
|
657 | } | |
571 | if {![info exists commcolors($comm)]} { |
|
658 | set badcolors {} | |
572 | set commcolors($comm) [lindex $colors $nextcolor] |
|
659 | if {[info exists cornercrossings($id)]} { | |
573 | if {[incr nextcolor] >= $ncolors} { |
|
660 | foreach x $cornercrossings($id) { | |
574 | set nextcolor 0 |
|
661 | if {[info exists colormap($x)] | |
|
662 | && [lsearch -exact $badcolors $colormap($x)] < 0} { | |||
|
663 | lappend badcolors $colormap($x) | |||
575 | } |
|
664 | } | |
576 | } |
|
665 | } | |
577 | set colormap($id) $commcolors($comm) |
|
666 | if {[llength $badcolors] >= $ncolors} { | |
578 | } else { |
|
667 | set badcolors {} | |
579 | if {$nparents($id) == 1 && $nchildren($id) == 1} { |
|
668 | } | |
580 | set child [lindex $children($id) 0] |
|
669 | } | |
581 | if {[info exists colormap($child)] |
|
670 | set origbad $badcolors | |
582 | && $nparents($child) == 1} { |
|
671 | if {[llength $badcolors] < $ncolors - 1} { | |
583 | set colormap($id) $colormap($child) |
|
672 | if {[info exists crossings($id)]} { | |
584 | return |
|
673 | foreach x $crossings($id) { | |
|
674 | if {[info exists colormap($x)] | |||
|
675 | && [lsearch -exact $badcolors $colormap($x)] < 0} { | |||
|
676 | lappend badcolors $colormap($x) | |||
|
677 | } | |||
|
678 | } | |||
|
679 | if {[llength $badcolors] >= $ncolors} { | |||
|
680 | set badcolors $origbad | |||
585 | } |
|
681 | } | |
586 | } |
|
682 | } | |
587 |
set badcolors |
|
683 | set origbad $badcolors | |
|
684 | } | |||
|
685 | if {[llength $badcolors] < $ncolors - 1} { | |||
588 | foreach child $children($id) { |
|
686 | foreach child $children($id) { | |
589 | if {[info exists colormap($child)] |
|
687 | if {[info exists colormap($child)] | |
590 | && [lsearch -exact $badcolors $colormap($child)] < 0} { |
|
688 | && [lsearch -exact $badcolors $colormap($child)] < 0} { | |
@@ -600,277 +698,810 b' proc assigncolor {id} {' | |||||
600 | } |
|
698 | } | |
601 | } |
|
699 | } | |
602 | if {[llength $badcolors] >= $ncolors} { |
|
700 | if {[llength $badcolors] >= $ncolors} { | |
603 |
set badcolors |
|
701 | set badcolors $origbad | |
|
702 | } | |||
|
703 | } | |||
|
704 | for {set i 0} {$i <= $ncolors} {incr i} { | |||
|
705 | set c [lindex $colors $nextcolor] | |||
|
706 | if {[incr nextcolor] >= $ncolors} { | |||
|
707 | set nextcolor 0 | |||
604 | } |
|
708 | } | |
605 | for {set i 0} {$i <= $ncolors} {incr i} { |
|
709 | if {[lsearch -exact $badcolors $c]} break | |
606 | set c [lindex $colors $nextcolor] |
|
710 | } | |
607 | if {[incr nextcolor] >= $ncolors} { |
|
711 | set colormap($id) $c | |
608 | set nextcolor 0 |
|
712 | } | |
609 | } |
|
713 | ||
610 | if {[lsearch -exact $badcolors $c]} break |
|
714 | proc initgraph {} { | |
|
715 | global canvy canvy0 lineno numcommits nextcolor linespc | |||
|
716 | global mainline mainlinearrow sidelines | |||
|
717 | global nchildren ncleft | |||
|
718 | global displist nhyperspace | |||
|
719 | ||||
|
720 | allcanvs delete all | |||
|
721 | set nextcolor 0 | |||
|
722 | set canvy $canvy0 | |||
|
723 | set lineno -1 | |||
|
724 | set numcommits 0 | |||
|
725 | catch {unset mainline} | |||
|
726 | catch {unset mainlinearrow} | |||
|
727 | catch {unset sidelines} | |||
|
728 | foreach id [array names nchildren] { | |||
|
729 | set ncleft($id) $nchildren($id) | |||
|
730 | } | |||
|
731 | set displist {} | |||
|
732 | set nhyperspace 0 | |||
|
733 | } | |||
|
734 | ||||
|
735 | proc bindline {t id} { | |||
|
736 | global canv | |||
|
737 | ||||
|
738 | $canv bind $t <Enter> "lineenter %x %y $id" | |||
|
739 | $canv bind $t <Motion> "linemotion %x %y $id" | |||
|
740 | $canv bind $t <Leave> "lineleave $id" | |||
|
741 | $canv bind $t <Button-1> "lineclick %x %y $id 1" | |||
|
742 | } | |||
|
743 | ||||
|
744 | proc drawlines {id xtra} { | |||
|
745 | global mainline mainlinearrow sidelines lthickness colormap canv | |||
|
746 | ||||
|
747 | $canv delete lines.$id | |||
|
748 | if {[info exists mainline($id)]} { | |||
|
749 | set t [$canv create line $mainline($id) \ | |||
|
750 | -width [expr {($xtra + 1) * $lthickness}] \ | |||
|
751 | -fill $colormap($id) -tags lines.$id \ | |||
|
752 | -arrow $mainlinearrow($id)] | |||
|
753 | $canv lower $t | |||
|
754 | bindline $t $id | |||
|
755 | } | |||
|
756 | if {[info exists sidelines($id)]} { | |||
|
757 | foreach ls $sidelines($id) { | |||
|
758 | set coords [lindex $ls 0] | |||
|
759 | set thick [lindex $ls 1] | |||
|
760 | set arrow [lindex $ls 2] | |||
|
761 | set t [$canv create line $coords -fill $colormap($id) \ | |||
|
762 | -width [expr {($thick + $xtra) * $lthickness}] \ | |||
|
763 | -arrow $arrow -tags lines.$id] | |||
|
764 | $canv lower $t | |||
|
765 | bindline $t $id | |||
611 | } |
|
766 | } | |
612 | set colormap($id) $c |
|
|||
613 | } |
|
767 | } | |
614 | } |
|
768 | } | |
615 |
|
769 | |||
616 | proc drawgraph {} { |
|
770 | # level here is an index in displist | |
617 | global parents children nparents nchildren commits |
|
771 | proc drawcommitline {level} { | |
618 | global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc |
|
772 | global parents children nparents displist | |
619 | global datemode cdate |
|
773 | global canv canv2 canv3 mainfont namefont canvy linespc | |
620 | global lineid linehtag linentag linedtag commitinfo |
|
774 | global lineid linehtag linentag linedtag commitinfo | |
621 |
global |
|
775 | global colormap numcommits currentparents dupparents | |
622 | global stopped phase redisplaying selectedline idtags idline |
|
776 | global idtags idline idheads idotherrefs | |
|
777 | global lineno lthickness mainline mainlinearrow sidelines | |||
|
778 | global commitlisted rowtextx idpos lastuse displist | |||
|
779 | global oldnlines olddlevel olddisplist | |||
623 |
|
780 | |||
624 | allcanvs delete all |
|
781 | incr numcommits | |
625 | set start {} |
|
782 | incr lineno | |
626 | foreach id [array names nchildren] { |
|
783 | set id [lindex $displist $level] | |
627 | if {$nchildren($id) == 0} { |
|
784 | set lastuse($id) $lineno | |
628 | lappend start $id |
|
785 | set lineid($lineno) $id | |
629 | } |
|
786 | set idline($id) $lineno | |
630 | set ncleft($id) $nchildren($id) |
|
787 | set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}] | |
631 |
|
|
788 | if {![info exists commitinfo($id)]} { | |
|
789 | readcommit $id | |||
|
790 | if {![info exists commitinfo($id)]} { | |||
|
791 | set commitinfo($id) {"No commit information available"} | |||
632 | set nparents($id) 0 |
|
792 | set nparents($id) 0 | |
633 | } |
|
793 | } | |
634 | } |
|
794 | } | |
635 | if {$start == {}} { |
|
795 | assigncolor $id | |
636 | error_popup "Gitk: ERROR: No starting commits found" |
|
796 | set currentparents {} | |
637 | exit 1 |
|
797 | set dupparents {} | |
|
798 | if {[info exists commitlisted($id)] && [info exists parents($id)]} { | |||
|
799 | foreach p $parents($id) { | |||
|
800 | if {[lsearch -exact $currentparents $p] < 0} { | |||
|
801 | lappend currentparents $p | |||
|
802 | } else { | |||
|
803 | # remember that this parent was listed twice | |||
|
804 | lappend dupparents $p | |||
|
805 | } | |||
|
806 | } | |||
|
807 | } | |||
|
808 | set x [xcoord $level $level $lineno] | |||
|
809 | set y1 $canvy | |||
|
810 | set canvy [expr $canvy + $linespc] | |||
|
811 | allcanvs conf -scrollregion \ | |||
|
812 | [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]] | |||
|
813 | if {[info exists mainline($id)]} { | |||
|
814 | lappend mainline($id) $x $y1 | |||
|
815 | if {$mainlinearrow($id) ne "none"} { | |||
|
816 | set mainline($id) [trimdiagstart $mainline($id)] | |||
|
817 | } | |||
|
818 | } | |||
|
819 | drawlines $id 0 | |||
|
820 | set orad [expr {$linespc / 3}] | |||
|
821 | set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \ | |||
|
822 | [expr $x + $orad - 1] [expr $y1 + $orad - 1] \ | |||
|
823 | -fill $ofill -outline black -width 1] | |||
|
824 | $canv raise $t | |||
|
825 | $canv bind $t <1> {selcanvline {} %x %y} | |||
|
826 | set xt [xcoord [llength $displist] $level $lineno] | |||
|
827 | if {[llength $currentparents] > 2} { | |||
|
828 | set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}] | |||
|
829 | } | |||
|
830 | set rowtextx($lineno) $xt | |||
|
831 | set idpos($id) [list $x $xt $y1] | |||
|
832 | if {[info exists idtags($id)] || [info exists idheads($id)] | |||
|
833 | || [info exists idotherrefs($id)]} { | |||
|
834 | set xt [drawtags $id $x $xt $y1] | |||
|
835 | } | |||
|
836 | set headline [lindex $commitinfo($id) 0] | |||
|
837 | set name [lindex $commitinfo($id) 1] | |||
|
838 | set date [lindex $commitinfo($id) 2] | |||
|
839 | set linehtag($lineno) [$canv create text $xt $y1 -anchor w \ | |||
|
840 | -text $headline -font $mainfont ] | |||
|
841 | $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id" | |||
|
842 | set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \ | |||
|
843 | -text $name -font $namefont] | |||
|
844 | set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \ | |||
|
845 | -text $date -font $mainfont] | |||
|
846 | ||||
|
847 | set olddlevel $level | |||
|
848 | set olddisplist $displist | |||
|
849 | set oldnlines [llength $displist] | |||
|
850 | } | |||
|
851 | ||||
|
852 | proc drawtags {id x xt y1} { | |||
|
853 | global idtags idheads idotherrefs | |||
|
854 | global linespc lthickness | |||
|
855 | global canv mainfont idline rowtextx | |||
|
856 | ||||
|
857 | set marks {} | |||
|
858 | set ntags 0 | |||
|
859 | set nheads 0 | |||
|
860 | if {[info exists idtags($id)]} { | |||
|
861 | set marks $idtags($id) | |||
|
862 | set ntags [llength $marks] | |||
|
863 | } | |||
|
864 | if {[info exists idheads($id)]} { | |||
|
865 | set marks [concat $marks $idheads($id)] | |||
|
866 | set nheads [llength $idheads($id)] | |||
|
867 | } | |||
|
868 | if {[info exists idotherrefs($id)]} { | |||
|
869 | set marks [concat $marks $idotherrefs($id)] | |||
|
870 | } | |||
|
871 | if {$marks eq {}} { | |||
|
872 | return $xt | |||
|
873 | } | |||
|
874 | ||||
|
875 | set delta [expr {int(0.5 * ($linespc - $lthickness))}] | |||
|
876 | set yt [expr $y1 - 0.5 * $linespc] | |||
|
877 | set yb [expr $yt + $linespc - 1] | |||
|
878 | set xvals {} | |||
|
879 | set wvals {} | |||
|
880 | foreach tag $marks { | |||
|
881 | set wid [font measure $mainfont $tag] | |||
|
882 | lappend xvals $xt | |||
|
883 | lappend wvals $wid | |||
|
884 | set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] | |||
|
885 | } | |||
|
886 | set t [$canv create line $x $y1 [lindex $xvals end] $y1 \ | |||
|
887 | -width $lthickness -fill black -tags tag.$id] | |||
|
888 | $canv lower $t | |||
|
889 | foreach tag $marks x $xvals wid $wvals { | |||
|
890 | set xl [expr $x + $delta] | |||
|
891 | set xr [expr $x + $delta + $wid + $lthickness] | |||
|
892 | if {[incr ntags -1] >= 0} { | |||
|
893 | # draw a tag | |||
|
894 | set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \ | |||
|
895 | $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ | |||
|
896 | -width 1 -outline black -fill yellow -tags tag.$id] | |||
|
897 | $canv bind $t <1> [list showtag $tag 1] | |||
|
898 | set rowtextx($idline($id)) [expr {$xr + $linespc}] | |||
|
899 | } else { | |||
|
900 | # draw a head or other ref | |||
|
901 | if {[incr nheads -1] >= 0} { | |||
|
902 | set col green | |||
|
903 | } else { | |||
|
904 | set col "#ddddff" | |||
|
905 | } | |||
|
906 | set xl [expr $xl - $delta/2] | |||
|
907 | $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \ | |||
|
908 | -width 1 -outline black -fill $col -tags tag.$id | |||
|
909 | } | |||
|
910 | set t [$canv create text $xl $y1 -anchor w -text $tag \ | |||
|
911 | -font $mainfont -tags tag.$id] | |||
|
912 | if {$ntags >= 0} { | |||
|
913 | $canv bind $t <1> [list showtag $tag 1] | |||
|
914 | } | |||
|
915 | } | |||
|
916 | return $xt | |||
|
917 | } | |||
|
918 | ||||
|
919 | proc notecrossings {id lo hi corner} { | |||
|
920 | global olddisplist crossings cornercrossings | |||
|
921 | ||||
|
922 | for {set i $lo} {[incr i] < $hi} {} { | |||
|
923 | set p [lindex $olddisplist $i] | |||
|
924 | if {$p == {}} continue | |||
|
925 | if {$i == $corner} { | |||
|
926 | if {![info exists cornercrossings($id)] | |||
|
927 | || [lsearch -exact $cornercrossings($id) $p] < 0} { | |||
|
928 | lappend cornercrossings($id) $p | |||
|
929 | } | |||
|
930 | if {![info exists cornercrossings($p)] | |||
|
931 | || [lsearch -exact $cornercrossings($p) $id] < 0} { | |||
|
932 | lappend cornercrossings($p) $id | |||
|
933 | } | |||
|
934 | } else { | |||
|
935 | if {![info exists crossings($id)] | |||
|
936 | || [lsearch -exact $crossings($id) $p] < 0} { | |||
|
937 | lappend crossings($id) $p | |||
|
938 | } | |||
|
939 | if {![info exists crossings($p)] | |||
|
940 | || [lsearch -exact $crossings($p) $id] < 0} { | |||
|
941 | lappend crossings($p) $id | |||
|
942 | } | |||
|
943 | } | |||
|
944 | } | |||
|
945 | } | |||
|
946 | ||||
|
947 | proc xcoord {i level ln} { | |||
|
948 | global canvx0 xspc1 xspc2 | |||
|
949 | ||||
|
950 | set x [expr {$canvx0 + $i * $xspc1($ln)}] | |||
|
951 | if {$i > 0 && $i == $level} { | |||
|
952 | set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}] | |||
|
953 | } elseif {$i > $level} { | |||
|
954 | set x [expr {$x + $xspc2 - $xspc1($ln)}] | |||
|
955 | } | |||
|
956 | return $x | |||
|
957 | } | |||
|
958 | ||||
|
959 | # it seems Tk can't draw arrows on the end of diagonal line segments... | |||
|
960 | proc trimdiagend {line} { | |||
|
961 | while {[llength $line] > 4} { | |||
|
962 | set x1 [lindex $line end-3] | |||
|
963 | set y1 [lindex $line end-2] | |||
|
964 | set x2 [lindex $line end-1] | |||
|
965 | set y2 [lindex $line end] | |||
|
966 | if {($x1 == $x2) != ($y1 == $y2)} break | |||
|
967 | set line [lreplace $line end-1 end] | |||
|
968 | } | |||
|
969 | return $line | |||
|
970 | } | |||
|
971 | ||||
|
972 | proc trimdiagstart {line} { | |||
|
973 | while {[llength $line] > 4} { | |||
|
974 | set x1 [lindex $line 0] | |||
|
975 | set y1 [lindex $line 1] | |||
|
976 | set x2 [lindex $line 2] | |||
|
977 | set y2 [lindex $line 3] | |||
|
978 | if {($x1 == $x2) != ($y1 == $y2)} break | |||
|
979 | set line [lreplace $line 0 1] | |||
|
980 | } | |||
|
981 | return $line | |||
|
982 | } | |||
|
983 | ||||
|
984 | proc drawslants {id needonscreen nohs} { | |||
|
985 | global canv mainline mainlinearrow sidelines | |||
|
986 | global canvx0 canvy xspc1 xspc2 lthickness | |||
|
987 | global currentparents dupparents | |||
|
988 | global lthickness linespc canvy colormap lineno geometry | |||
|
989 | global maxgraphpct maxwidth | |||
|
990 | global displist onscreen lastuse | |||
|
991 | global parents commitlisted | |||
|
992 | global oldnlines olddlevel olddisplist | |||
|
993 | global nhyperspace numcommits nnewparents | |||
|
994 | ||||
|
995 | if {$lineno < 0} { | |||
|
996 | lappend displist $id | |||
|
997 | set onscreen($id) 1 | |||
|
998 | return 0 | |||
|
999 | } | |||
|
1000 | ||||
|
1001 | set y1 [expr {$canvy - $linespc}] | |||
|
1002 | set y2 $canvy | |||
|
1003 | ||||
|
1004 | # work out what we need to get back on screen | |||
|
1005 | set reins {} | |||
|
1006 | if {$onscreen($id) < 0} { | |||
|
1007 | # next to do isn't displayed, better get it on screen... | |||
|
1008 | lappend reins [list $id 0] | |||
|
1009 | } | |||
|
1010 | # make sure all the previous commits's parents are on the screen | |||
|
1011 | foreach p $currentparents { | |||
|
1012 | if {$onscreen($p) < 0} { | |||
|
1013 | lappend reins [list $p 0] | |||
|
1014 | } | |||
|
1015 | } | |||
|
1016 | # bring back anything requested by caller | |||
|
1017 | if {$needonscreen ne {}} { | |||
|
1018 | lappend reins $needonscreen | |||
638 | } |
|
1019 | } | |
639 |
|
1020 | |||
640 | set nextcolor 0 |
|
1021 | # try the shortcut | |
641 | foreach id $start { |
|
1022 | if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} { | |
642 | assigncolor $id |
|
1023 | set dlevel $olddlevel | |
|
1024 | set x [xcoord $dlevel $dlevel $lineno] | |||
|
1025 | set mainline($id) [list $x $y1] | |||
|
1026 | set mainlinearrow($id) none | |||
|
1027 | set lastuse($id) $lineno | |||
|
1028 | set displist [lreplace $displist $dlevel $dlevel $id] | |||
|
1029 | set onscreen($id) 1 | |||
|
1030 | set xspc1([expr {$lineno + 1}]) $xspc1($lineno) | |||
|
1031 | return $dlevel | |||
|
1032 | } | |||
|
1033 | ||||
|
1034 | # update displist | |||
|
1035 | set displist [lreplace $displist $olddlevel $olddlevel] | |||
|
1036 | set j $olddlevel | |||
|
1037 | foreach p $currentparents { | |||
|
1038 | set lastuse($p) $lineno | |||
|
1039 | if {$onscreen($p) == 0} { | |||
|
1040 | set displist [linsert $displist $j $p] | |||
|
1041 | set onscreen($p) 1 | |||
|
1042 | incr j | |||
|
1043 | } | |||
|
1044 | } | |||
|
1045 | if {$onscreen($id) == 0} { | |||
|
1046 | lappend displist $id | |||
|
1047 | set onscreen($id) 1 | |||
|
1048 | } | |||
|
1049 | ||||
|
1050 | # remove the null entry if present | |||
|
1051 | set nullentry [lsearch -exact $displist {}] | |||
|
1052 | if {$nullentry >= 0} { | |||
|
1053 | set displist [lreplace $displist $nullentry $nullentry] | |||
|
1054 | } | |||
|
1055 | ||||
|
1056 | # bring back the ones we need now (if we did it earlier | |||
|
1057 | # it would change displist and invalidate olddlevel) | |||
|
1058 | foreach pi $reins { | |||
|
1059 | # test again in case of duplicates in reins | |||
|
1060 | set p [lindex $pi 0] | |||
|
1061 | if {$onscreen($p) < 0} { | |||
|
1062 | set onscreen($p) 1 | |||
|
1063 | set lastuse($p) $lineno | |||
|
1064 | set displist [linsert $displist [lindex $pi 1] $p] | |||
|
1065 | incr nhyperspace -1 | |||
|
1066 | } | |||
|
1067 | } | |||
|
1068 | ||||
|
1069 | set lastuse($id) $lineno | |||
|
1070 | ||||
|
1071 | # see if we need to make any lines jump off into hyperspace | |||
|
1072 | set displ [llength $displist] | |||
|
1073 | if {$displ > $maxwidth} { | |||
|
1074 | set ages {} | |||
|
1075 | foreach x $displist { | |||
|
1076 | lappend ages [list $lastuse($x) $x] | |||
|
1077 | } | |||
|
1078 | set ages [lsort -integer -index 0 $ages] | |||
|
1079 | set k 0 | |||
|
1080 | while {$displ > $maxwidth} { | |||
|
1081 | set use [lindex $ages $k 0] | |||
|
1082 | set victim [lindex $ages $k 1] | |||
|
1083 | if {$use >= $lineno - 5} break | |||
|
1084 | incr k | |||
|
1085 | if {[lsearch -exact $nohs $victim] >= 0} continue | |||
|
1086 | set i [lsearch -exact $displist $victim] | |||
|
1087 | set displist [lreplace $displist $i $i] | |||
|
1088 | set onscreen($victim) -1 | |||
|
1089 | incr nhyperspace | |||
|
1090 | incr displ -1 | |||
|
1091 | if {$i < $nullentry} { | |||
|
1092 | incr nullentry -1 | |||
|
1093 | } | |||
|
1094 | set x [lindex $mainline($victim) end-1] | |||
|
1095 | lappend mainline($victim) $x $y1 | |||
|
1096 | set line [trimdiagend $mainline($victim)] | |||
|
1097 | set arrow "last" | |||
|
1098 | if {$mainlinearrow($victim) ne "none"} { | |||
|
1099 | set line [trimdiagstart $line] | |||
|
1100 | set arrow "both" | |||
|
1101 | } | |||
|
1102 | lappend sidelines($victim) [list $line 1 $arrow] | |||
|
1103 | unset mainline($victim) | |||
|
1104 | } | |||
643 | } |
|
1105 | } | |
644 | set todo $start |
|
1106 | ||
645 | set level [expr [llength $todo] - 1] |
|
1107 | set dlevel [lsearch -exact $displist $id] | |
646 | set y2 $canvy0 |
|
1108 | ||
647 | set nullentry -1 |
|
1109 | # If we are reducing, put in a null entry | |
648 | set lineno -1 |
|
1110 | if {$displ < $oldnlines} { | |
649 | set numcommits 0 |
|
1111 | # does the next line look like a merge? | |
650 | set phase drawgraph |
|
1112 | # i.e. does it have > 1 new parent? | |
651 | set lthickness [expr {($linespc / 9) + 1}] |
|
1113 | if {$nnewparents($id) > 1} { | |
652 | while 1 { |
|
1114 | set i [expr {$dlevel + 1}] | |
653 | set canvy $y2 |
|
1115 | } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} { | |
654 | allcanvs conf -scrollregion \ |
|
1116 | set i $olddlevel | |
655 | [list 0 0 0 [expr $canvy + 0.5 * $linespc + 2]] |
|
1117 | if {$nullentry >= 0 && $nullentry < $i} { | |
656 | update |
|
1118 | incr i -1 | |
657 | if {$stopped} break |
|
1119 | } | |
658 | incr numcommits |
|
1120 | } elseif {$nullentry >= 0} { | |
659 | incr lineno |
|
1121 | set i $nullentry | |
660 | set nlines [llength $todo] |
|
1122 | while {$i < $displ | |
661 | set id [lindex $todo $level] |
|
1123 | && [lindex $olddisplist $i] == [lindex $displist $i]} { | |
662 | set lineid($lineno) $id |
|
1124 | incr i | |
663 | set idline($id) $lineno |
|
1125 | } | |
664 | set actualparents {} |
|
1126 | } else { | |
665 | set ofill white |
|
1127 | set i $olddlevel | |
666 | if {[info exists parents($id)]} { |
|
1128 | if {$dlevel >= $i} { | |
667 | foreach p $parents($id) { |
|
1129 | incr i | |
668 | if {[info exists ncleft($p)]} { |
|
1130 | } | |
669 | incr ncleft($p) -1 |
|
1131 | } | |
670 | if {![info exists commitinfo($p)]} { |
|
1132 | if {$i < $displ} { | |
671 | readcommit $p |
|
1133 | set displist [linsert $displist $i {}] | |
672 | if {![info exists commitinfo($p)]} continue |
|
1134 | incr displ | |
|
1135 | if {$dlevel >= $i} { | |||
|
1136 | incr dlevel | |||
|
1137 | } | |||
|
1138 | } | |||
|
1139 | } | |||
|
1140 | ||||
|
1141 | # decide on the line spacing for the next line | |||
|
1142 | set lj [expr {$lineno + 1}] | |||
|
1143 | set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}] | |||
|
1144 | if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} { | |||
|
1145 | set xspc1($lj) $xspc2 | |||
|
1146 | } else { | |||
|
1147 | set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}] | |||
|
1148 | if {$xspc1($lj) < $lthickness} { | |||
|
1149 | set xspc1($lj) $lthickness | |||
|
1150 | } | |||
|
1151 | } | |||
|
1152 | ||||
|
1153 | foreach idi $reins { | |||
|
1154 | set id [lindex $idi 0] | |||
|
1155 | set j [lsearch -exact $displist $id] | |||
|
1156 | set xj [xcoord $j $dlevel $lj] | |||
|
1157 | set mainline($id) [list $xj $y2] | |||
|
1158 | set mainlinearrow($id) first | |||
|
1159 | } | |||
|
1160 | ||||
|
1161 | set i -1 | |||
|
1162 | foreach id $olddisplist { | |||
|
1163 | incr i | |||
|
1164 | if {$id == {}} continue | |||
|
1165 | if {$onscreen($id) <= 0} continue | |||
|
1166 | set xi [xcoord $i $olddlevel $lineno] | |||
|
1167 | if {$i == $olddlevel} { | |||
|
1168 | foreach p $currentparents { | |||
|
1169 | set j [lsearch -exact $displist $p] | |||
|
1170 | set coords [list $xi $y1] | |||
|
1171 | set xj [xcoord $j $dlevel $lj] | |||
|
1172 | if {$xj < $xi - $linespc} { | |||
|
1173 | lappend coords [expr {$xj + $linespc}] $y1 | |||
|
1174 | notecrossings $p $j $i [expr {$j + 1}] | |||
|
1175 | } elseif {$xj > $xi + $linespc} { | |||
|
1176 | lappend coords [expr {$xj - $linespc}] $y1 | |||
|
1177 | notecrossings $p $i $j [expr {$j - 1}] | |||
|
1178 | } | |||
|
1179 | if {[lsearch -exact $dupparents $p] >= 0} { | |||
|
1180 | # draw a double-width line to indicate the doubled parent | |||
|
1181 | lappend coords $xj $y2 | |||
|
1182 | lappend sidelines($p) [list $coords 2 none] | |||
|
1183 | if {![info exists mainline($p)]} { | |||
|
1184 | set mainline($p) [list $xj $y2] | |||
|
1185 | set mainlinearrow($p) none | |||
673 | } |
|
1186 | } | |
674 | lappend actualparents $p |
|
1187 | } else { | |
675 | set ofill blue |
|
1188 | # normal case, no parent duplicated | |
|
1189 | set yb $y2 | |||
|
1190 | set dx [expr {abs($xi - $xj)}] | |||
|
1191 | if {0 && $dx < $linespc} { | |||
|
1192 | set yb [expr {$y1 + $dx}] | |||
|
1193 | } | |||
|
1194 | if {![info exists mainline($p)]} { | |||
|
1195 | if {$xi != $xj} { | |||
|
1196 | lappend coords $xj $yb | |||
|
1197 | } | |||
|
1198 | set mainline($p) $coords | |||
|
1199 | set mainlinearrow($p) none | |||
|
1200 | } else { | |||
|
1201 | lappend coords $xj $yb | |||
|
1202 | if {$yb < $y2} { | |||
|
1203 | lappend coords $xj $y2 | |||
|
1204 | } | |||
|
1205 | lappend sidelines($p) [list $coords 1 none] | |||
|
1206 | } | |||
|
1207 | } | |||
|
1208 | } | |||
|
1209 | } else { | |||
|
1210 | set j $i | |||
|
1211 | if {[lindex $displist $i] != $id} { | |||
|
1212 | set j [lsearch -exact $displist $id] | |||
|
1213 | } | |||
|
1214 | if {$j != $i || $xspc1($lineno) != $xspc1($lj) | |||
|
1215 | || ($olddlevel < $i && $i < $dlevel) | |||
|
1216 | || ($dlevel < $i && $i < $olddlevel)} { | |||
|
1217 | set xj [xcoord $j $dlevel $lj] | |||
|
1218 | lappend mainline($id) $xi $y1 $xj $y2 | |||
|
1219 | } | |||
|
1220 | } | |||
|
1221 | } | |||
|
1222 | return $dlevel | |||
|
1223 | } | |||
|
1224 | ||||
|
1225 | # search for x in a list of lists | |||
|
1226 | proc llsearch {llist x} { | |||
|
1227 | set i 0 | |||
|
1228 | foreach l $llist { | |||
|
1229 | if {$l == $x || [lsearch -exact $l $x] >= 0} { | |||
|
1230 | return $i | |||
|
1231 | } | |||
|
1232 | incr i | |||
|
1233 | } | |||
|
1234 | return -1 | |||
|
1235 | } | |||
|
1236 | ||||
|
1237 | proc drawmore {reading} { | |||
|
1238 | global displayorder numcommits ncmupdate nextupdate | |||
|
1239 | global stopped nhyperspace parents commitlisted | |||
|
1240 | global maxwidth onscreen displist currentparents olddlevel | |||
|
1241 | ||||
|
1242 | set n [llength $displayorder] | |||
|
1243 | while {$numcommits < $n} { | |||
|
1244 | set id [lindex $displayorder $numcommits] | |||
|
1245 | set ctxend [expr {$numcommits + 10}] | |||
|
1246 | if {!$reading && $ctxend > $n} { | |||
|
1247 | set ctxend $n | |||
|
1248 | } | |||
|
1249 | set dlist {} | |||
|
1250 | if {$numcommits > 0} { | |||
|
1251 | set dlist [lreplace $displist $olddlevel $olddlevel] | |||
|
1252 | set i $olddlevel | |||
|
1253 | foreach p $currentparents { | |||
|
1254 | if {$onscreen($p) == 0} { | |||
|
1255 | set dlist [linsert $dlist $i $p] | |||
|
1256 | incr i | |||
676 | } |
|
1257 | } | |
677 | } |
|
1258 | } | |
678 | } |
|
1259 | } | |
679 | if {![info exists commitinfo($id)]} { |
|
1260 | set nohs {} | |
680 | readcommit $id |
|
1261 | set reins {} | |
681 | if {![info exists commitinfo($id)]} { |
|
1262 | set isfat [expr {[llength $dlist] > $maxwidth}] | |
682 | set commitinfo($id) {"No commit information available"} |
|
1263 | if {$nhyperspace > 0 || $isfat} { | |
683 | } |
|
1264 | if {$ctxend > $n} break | |
684 | } |
|
1265 | # work out what to bring back and | |
685 | set x [expr $canvx0 + $level * $linespc] |
|
1266 | # what we want to don't want to send into hyperspace | |
686 | set y2 [expr $canvy + $linespc] |
|
1267 | set room 1 | |
687 | if {[info exists linestarty($level)] && $linestarty($level) < $canvy} { |
|
1268 | for {set k $numcommits} {$k < $ctxend} {incr k} { | |
688 | set t [$canv create line $x $linestarty($level) $x $canvy \ |
|
1269 | set x [lindex $displayorder $k] | |
689 | -width $lthickness -fill $colormap($id)] |
|
1270 | set i [llsearch $dlist $x] | |
690 | $canv lower $t |
|
1271 | if {$i < 0} { | |
691 | } |
|
1272 | set i [llength $dlist] | |
692 | set linestarty($level) $canvy |
|
1273 | lappend dlist $x | |
693 | set orad [expr {$linespc / 3}] |
|
1274 | } | |
694 | set t [$canv create oval [expr $x - $orad] [expr $canvy - $orad] \ |
|
1275 | if {[lsearch -exact $nohs $x] < 0} { | |
695 | [expr $x + $orad - 1] [expr $canvy + $orad - 1] \ |
|
1276 | lappend nohs $x | |
696 | -fill $ofill -outline black -width 1] |
|
1277 | } | |
697 | $canv raise $t |
|
1278 | if {$reins eq {} && $onscreen($x) < 0 && $room} { | |
698 | set xt [expr $canvx0 + $nlines * $linespc] |
|
1279 | set reins [list $x $i] | |
699 | if {$nparents($id) > 2} { |
|
1280 | } | |
700 | set xt [expr {$xt + ($nparents($id) - 2) * $linespc}] |
|
1281 | set newp {} | |
701 | } |
|
1282 | if {[info exists commitlisted($x)]} { | |
702 | if {[info exists idtags($id)] && $idtags($id) != {}} { |
|
1283 | set right 0 | |
703 | set delta [expr {int(0.5 * ($linespc - $lthickness))}] |
|
1284 | foreach p $parents($x) { | |
704 | set yt [expr $canvy - 0.5 * $linespc] |
|
1285 | if {[llsearch $dlist $p] < 0} { | |
705 | set yb [expr $yt + $linespc - 1] |
|
1286 | lappend newp $p | |
706 | set xvals {} |
|
1287 | if {[lsearch -exact $nohs $p] < 0} { | |
707 | set wvals {} |
|
1288 | lappend nohs $p | |
708 | foreach tag $idtags($id) { |
|
1289 | } | |
709 | set wid [font measure $mainfont $tag] |
|
1290 | if {$reins eq {} && $onscreen($p) < 0 && $room} { | |
710 | lappend xvals $xt |
|
1291 | set reins [list $p [expr {$i + $right}]] | |
711 | lappend wvals $wid |
|
1292 | } | |
712 | set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}] |
|
1293 | } | |
713 | } |
|
1294 | set right 1 | |
714 | set t [$canv create line $x $canvy [lindex $xvals end] $canvy \ |
|
1295 | } | |
715 | -width $lthickness -fill black] |
|
1296 | } | |
716 | $canv lower $t |
|
1297 | set l [lindex $dlist $i] | |
717 | foreach tag $idtags($id) x $xvals wid $wvals { |
|
1298 | if {[llength $l] == 1} { | |
718 | set xl [expr $x + $delta] |
|
1299 | set l $newp | |
719 | set xr [expr $x + $delta + $wid + $lthickness] |
|
1300 | } else { | |
720 | $canv create polygon $x [expr $yt + $delta] $xl $yt\ |
|
1301 | set j [lsearch -exact $l $x] | |
721 | $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \ |
|
1302 | set l [concat [lreplace $l $j $j] $newp] | |
722 | -width 1 -outline black -fill yellow |
|
1303 | } | |
723 | $canv create text $xl $canvy -anchor w -text $tag \ |
|
1304 | set dlist [lreplace $dlist $i $i $l] | |
724 | -font $mainfont |
|
1305 | if {$room && $isfat && [llength $newp] <= 1} { | |
725 | } |
|
1306 | set room 0 | |
726 | } |
|
1307 | } | |
727 | set headline [lindex $commitinfo($id) 0] |
|
|||
728 | set name [lindex $commitinfo($id) 1] |
|
|||
729 | set date [lindex $commitinfo($id) 2] |
|
|||
730 | set linehtag($lineno) [$canv create text $xt $canvy -anchor w \ |
|
|||
731 | -text $headline -font $mainfont ] |
|
|||
732 | set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \ |
|
|||
733 | -text $name -font $namefont] |
|
|||
734 | set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \ |
|
|||
735 | -text $date -font $mainfont] |
|
|||
736 | if {!$datemode && [llength $actualparents] == 1} { |
|
|||
737 | set p [lindex $actualparents 0] |
|
|||
738 | if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} { |
|
|||
739 | assigncolor $p |
|
|||
740 | set todo [lreplace $todo $level $level $p] |
|
|||
741 | continue |
|
|||
742 | } |
|
|||
743 | } |
|
|||
744 |
|
||||
745 | set oldtodo $todo |
|
|||
746 | set oldlevel $level |
|
|||
747 | set lines {} |
|
|||
748 | for {set i 0} {$i < $nlines} {incr i} { |
|
|||
749 | if {[lindex $todo $i] == {}} continue |
|
|||
750 | if {[info exists linestarty($i)]} { |
|
|||
751 | set oldstarty($i) $linestarty($i) |
|
|||
752 | unset linestarty($i) |
|
|||
753 | } |
|
|||
754 | if {$i != $level} { |
|
|||
755 | lappend lines [list $i [lindex $todo $i]] |
|
|||
756 | } |
|
|||
757 | } |
|
|||
758 | if {$nullentry >= 0} { |
|
|||
759 | set todo [lreplace $todo $nullentry $nullentry] |
|
|||
760 | if {$nullentry < $level} { |
|
|||
761 | incr level -1 |
|
|||
762 | } |
|
1308 | } | |
763 | } |
|
1309 | } | |
764 |
|
1310 | |||
765 | set todo [lreplace $todo $level $level] |
|
1311 | set dlevel [drawslants $id $reins $nohs] | |
766 | if {$nullentry > $level} { |
|
1312 | drawcommitline $dlevel | |
767 | incr nullentry -1 |
|
1313 | if {[clock clicks -milliseconds] >= $nextupdate | |
|
1314 | && $numcommits >= $ncmupdate} { | |||
|
1315 | doupdate $reading | |||
|
1316 | if {$stopped} break | |||
768 | } |
|
1317 | } | |
769 | set i $level |
|
1318 | } | |
770 | foreach p $actualparents { |
|
1319 | } | |
771 | set k [lsearch -exact $todo $p] |
|
|||
772 | if {$k < 0} { |
|
|||
773 | assigncolor $p |
|
|||
774 | set todo [linsert $todo $i $p] |
|
|||
775 | if {$nullentry >= $i} { |
|
|||
776 | incr nullentry |
|
|||
777 | } |
|
|||
778 | incr i |
|
|||
779 | } |
|
|||
780 | lappend lines [list $oldlevel $p] |
|
|||
781 | } |
|
|||
782 |
|
1320 | |||
783 | # choose which one to do next time around |
|
1321 | # level here is an index in todo | |
784 | set todol [llength $todo] |
|
1322 | proc updatetodo {level noshortcut} { | |
785 | set level -1 |
|
1323 | global ncleft todo nnewparents | |
786 | set latest {} |
|
1324 | global commitlisted parents onscreen | |
787 | for {set k $todol} {[incr k -1] >= 0} {} { |
|
1325 | ||
788 |
|
|
1326 | set id [lindex $todo $level] | |
789 | if {$p == {}} continue |
|
1327 | set olds {} | |
790 | if {$ncleft($p) == 0} { |
|
1328 | if {[info exists commitlisted($id)]} { | |
791 | if {$datemode} { |
|
1329 | foreach p $parents($id) { | |
792 | if {$latest == {} || $cdate($p) > $latest} { |
|
1330 | if {[lsearch -exact $olds $p] < 0} { | |
793 | set level $k |
|
1331 | lappend olds $p | |
794 | set latest $cdate($p) |
|
|||
795 | } |
|
|||
796 | } else { |
|
|||
797 | set level $k |
|
|||
798 | break |
|
|||
799 | } |
|
|||
800 | } |
|
1332 | } | |
801 | } |
|
1333 | } | |
802 | if {$level < 0} { |
|
1334 | } | |
803 | if {$todo != {}} { |
|
1335 | if {!$noshortcut && [llength $olds] == 1} { | |
804 | puts "ERROR: none of the pending commits can be done yet:" |
|
1336 | set p [lindex $olds 0] | |
805 | foreach p $todo { |
|
1337 | if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} { | |
806 | puts " $p" |
|
1338 | set ncleft($p) 0 | |
807 | } |
|
1339 | set todo [lreplace $todo $level $level $p] | |
808 | } |
|
1340 | set onscreen($p) 0 | |
809 | break |
|
1341 | set nnewparents($id) 1 | |
|
1342 | return 0 | |||
|
1343 | } | |||
|
1344 | } | |||
|
1345 | ||||
|
1346 | set todo [lreplace $todo $level $level] | |||
|
1347 | set i $level | |||
|
1348 | set n 0 | |||
|
1349 | foreach p $olds { | |||
|
1350 | incr ncleft($p) -1 | |||
|
1351 | set k [lsearch -exact $todo $p] | |||
|
1352 | if {$k < 0} { | |||
|
1353 | set todo [linsert $todo $i $p] | |||
|
1354 | set onscreen($p) 0 | |||
|
1355 | incr i | |||
|
1356 | incr n | |||
810 | } |
|
1357 | } | |
|
1358 | } | |||
|
1359 | set nnewparents($id) $n | |||
811 |
|
1360 | |||
812 | # If we are reducing, put in a null entry |
|
1361 | return 1 | |
813 | if {$todol < $nlines} { |
|
1362 | } | |
814 | if {$nullentry >= 0} { |
|
1363 | ||
815 | set i $nullentry |
|
1364 | proc decidenext {{noread 0}} { | |
816 | while {$i < $todol |
|
1365 | global ncleft todo | |
817 | && [lindex $oldtodo $i] == [lindex $todo $i]} { |
|
1366 | global datemode cdate | |
818 | incr i |
|
1367 | global commitinfo | |
|
1368 | ||||
|
1369 | # choose which one to do next time around | |||
|
1370 | set todol [llength $todo] | |||
|
1371 | set level -1 | |||
|
1372 | set latest {} | |||
|
1373 | for {set k $todol} {[incr k -1] >= 0} {} { | |||
|
1374 | set p [lindex $todo $k] | |||
|
1375 | if {$ncleft($p) == 0} { | |||
|
1376 | if {$datemode} { | |||
|
1377 | if {![info exists commitinfo($p)]} { | |||
|
1378 | if {$noread} { | |||
|
1379 | return {} | |||
|
1380 | } | |||
|
1381 | readcommit $p | |||
|
1382 | } | |||
|
1383 | if {$latest == {} || $cdate($p) > $latest} { | |||
|
1384 | set level $k | |||
|
1385 | set latest $cdate($p) | |||
819 | } |
|
1386 | } | |
820 | } else { |
|
1387 | } else { | |
821 |
set |
|
1388 | set level $k | |
822 | if {$level >= $i} { |
|
1389 | break | |
823 | incr i |
|
|||
824 | } |
|
|||
825 | } |
|
|||
826 | if {$i >= $todol} { |
|
|||
827 | set nullentry -1 |
|
|||
828 | } else { |
|
|||
829 | set nullentry $i |
|
|||
830 | set todo [linsert $todo $nullentry {}] |
|
|||
831 | if {$level >= $i} { |
|
|||
832 | incr level |
|
|||
833 | } |
|
|||
834 | } |
|
|||
835 | } else { |
|
|||
836 | set nullentry -1 |
|
|||
837 | } |
|
|||
838 |
|
||||
839 | foreach l $lines { |
|
|||
840 | set i [lindex $l 0] |
|
|||
841 | set dst [lindex $l 1] |
|
|||
842 | set j [lsearch -exact $todo $dst] |
|
|||
843 | if {$i == $j} { |
|
|||
844 | if {[info exists oldstarty($i)]} { |
|
|||
845 | set linestarty($i) $oldstarty($i) |
|
|||
846 | } |
|
|||
847 | continue |
|
|||
848 | } |
|
|||
849 | set xi [expr {$canvx0 + $i * $linespc}] |
|
|||
850 | set xj [expr {$canvx0 + $j * $linespc}] |
|
|||
851 | set coords {} |
|
|||
852 | if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} { |
|
|||
853 | lappend coords $xi $oldstarty($i) |
|
|||
854 | } |
|
|||
855 | lappend coords $xi $canvy |
|
|||
856 | if {$j < $i - 1} { |
|
|||
857 | lappend coords [expr $xj + $linespc] $canvy |
|
|||
858 | } elseif {$j > $i + 1} { |
|
|||
859 | lappend coords [expr $xj - $linespc] $canvy |
|
|||
860 | } |
|
|||
861 | lappend coords $xj $y2 |
|
|||
862 | set t [$canv create line $coords -width $lthickness \ |
|
|||
863 | -fill $colormap($dst)] |
|
|||
864 | $canv lower $t |
|
|||
865 | if {![info exists linestarty($j)]} { |
|
|||
866 | set linestarty($j) $y2 |
|
|||
867 | } |
|
1390 | } | |
868 | } |
|
1391 | } | |
869 | } |
|
1392 | } | |
|
1393 | if {$level < 0} { | |||
|
1394 | if {$todo != {}} { | |||
|
1395 | puts "ERROR: none of the pending commits can be done yet:" | |||
|
1396 | foreach p $todo { | |||
|
1397 | puts " $p ($ncleft($p))" | |||
|
1398 | } | |||
|
1399 | } | |||
|
1400 | return -1 | |||
|
1401 | } | |||
|
1402 | ||||
|
1403 | return $level | |||
|
1404 | } | |||
|
1405 | ||||
|
1406 | proc drawcommit {id} { | |||
|
1407 | global phase todo nchildren datemode nextupdate | |||
|
1408 | global numcommits ncmupdate displayorder todo onscreen | |||
|
1409 | ||||
|
1410 | if {$phase != "incrdraw"} { | |||
|
1411 | set phase incrdraw | |||
|
1412 | set displayorder {} | |||
|
1413 | set todo {} | |||
|
1414 | initgraph | |||
|
1415 | } | |||
|
1416 | if {$nchildren($id) == 0} { | |||
|
1417 | lappend todo $id | |||
|
1418 | set onscreen($id) 0 | |||
|
1419 | } | |||
|
1420 | set level [decidenext 1] | |||
|
1421 | if {$level == {} || $id != [lindex $todo $level]} { | |||
|
1422 | return | |||
|
1423 | } | |||
|
1424 | while 1 { | |||
|
1425 | lappend displayorder [lindex $todo $level] | |||
|
1426 | if {[updatetodo $level $datemode]} { | |||
|
1427 | set level [decidenext 1] | |||
|
1428 | if {$level == {}} break | |||
|
1429 | } | |||
|
1430 | set id [lindex $todo $level] | |||
|
1431 | if {![info exists commitlisted($id)]} { | |||
|
1432 | break | |||
|
1433 | } | |||
|
1434 | } | |||
|
1435 | drawmore 1 | |||
|
1436 | } | |||
|
1437 | ||||
|
1438 | proc finishcommits {} { | |||
|
1439 | global phase | |||
|
1440 | global canv mainfont ctext maincursor textcursor | |||
|
1441 | ||||
|
1442 | if {$phase != "incrdraw"} { | |||
|
1443 | $canv delete all | |||
|
1444 | $canv create text 3 3 -anchor nw -text "No commits selected" \ | |||
|
1445 | -font $mainfont -tags textitems | |||
|
1446 | set phase {} | |||
|
1447 | } else { | |||
|
1448 | drawrest | |||
|
1449 | } | |||
|
1450 | . config -cursor $maincursor | |||
|
1451 | settextcursor $textcursor | |||
|
1452 | } | |||
|
1453 | ||||
|
1454 | # Don't change the text pane cursor if it is currently the hand cursor, | |||
|
1455 | # showing that we are over a sha1 ID link. | |||
|
1456 | proc settextcursor {c} { | |||
|
1457 | global ctext curtextcursor | |||
|
1458 | ||||
|
1459 | if {[$ctext cget -cursor] == $curtextcursor} { | |||
|
1460 | $ctext config -cursor $c | |||
|
1461 | } | |||
|
1462 | set curtextcursor $c | |||
|
1463 | } | |||
|
1464 | ||||
|
1465 | proc drawgraph {} { | |||
|
1466 | global nextupdate startmsecs ncmupdate | |||
|
1467 | global displayorder onscreen | |||
|
1468 | ||||
|
1469 | if {$displayorder == {}} return | |||
|
1470 | set startmsecs [clock clicks -milliseconds] | |||
|
1471 | set nextupdate [expr $startmsecs + 100] | |||
|
1472 | set ncmupdate 1 | |||
|
1473 | initgraph | |||
|
1474 | foreach id $displayorder { | |||
|
1475 | set onscreen($id) 0 | |||
|
1476 | } | |||
|
1477 | drawmore 0 | |||
|
1478 | } | |||
|
1479 | ||||
|
1480 | proc drawrest {} { | |||
|
1481 | global phase stopped redisplaying selectedline | |||
|
1482 | global datemode todo displayorder | |||
|
1483 | global numcommits ncmupdate | |||
|
1484 | global nextupdate startmsecs | |||
|
1485 | ||||
|
1486 | set level [decidenext] | |||
|
1487 | if {$level >= 0} { | |||
|
1488 | set phase drawgraph | |||
|
1489 | while 1 { | |||
|
1490 | lappend displayorder [lindex $todo $level] | |||
|
1491 | set hard [updatetodo $level $datemode] | |||
|
1492 | if {$hard} { | |||
|
1493 | set level [decidenext] | |||
|
1494 | if {$level < 0} break | |||
|
1495 | } | |||
|
1496 | } | |||
|
1497 | drawmore 0 | |||
|
1498 | } | |||
870 | set phase {} |
|
1499 | set phase {} | |
|
1500 | set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs] | |||
|
1501 | #puts "overall $drawmsecs ms for $numcommits commits" | |||
871 | if {$redisplaying} { |
|
1502 | if {$redisplaying} { | |
872 | if {$stopped == 0 && [info exists selectedline]} { |
|
1503 | if {$stopped == 0 && [info exists selectedline]} { | |
873 | selectline $selectedline |
|
1504 | selectline $selectedline 0 | |
874 | } |
|
1505 | } | |
875 | if {$stopped == 1} { |
|
1506 | if {$stopped == 1} { | |
876 | set stopped 0 |
|
1507 | set stopped 0 | |
@@ -905,11 +1536,16 b' proc dofind {} {' | |||||
905 | global findtype findloc findstring markedmatches commitinfo |
|
1536 | global findtype findloc findstring markedmatches commitinfo | |
906 | global numcommits lineid linehtag linentag linedtag |
|
1537 | global numcommits lineid linehtag linentag linedtag | |
907 | global mainfont namefont canv canv2 canv3 selectedline |
|
1538 | global mainfont namefont canv canv2 canv3 selectedline | |
908 |
global matchinglines foundstring foundstrlen |
|
1539 | global matchinglines foundstring foundstrlen | |
|
1540 | ||||
|
1541 | stopfindproc | |||
909 | unmarkmatches |
|
1542 | unmarkmatches | |
910 | focus . |
|
1543 | focus . | |
911 | set matchinglines {} |
|
1544 | set matchinglines {} | |
912 | set fldtypes {Headline Author Date Committer CDate Comment} |
|
1545 | if {$findloc == "Pickaxe"} { | |
|
1546 | findpatches | |||
|
1547 | return | |||
|
1548 | } | |||
913 | if {$findtype == "IgnCase"} { |
|
1549 | if {$findtype == "IgnCase"} { | |
914 | set foundstring [string tolower $findstring] |
|
1550 | set foundstring [string tolower $findstring] | |
915 | } else { |
|
1551 | } else { | |
@@ -917,12 +1553,17 b' proc dofind {} {' | |||||
917 | } |
|
1553 | } | |
918 | set foundstrlen [string length $findstring] |
|
1554 | set foundstrlen [string length $findstring] | |
919 | if {$foundstrlen == 0} return |
|
1555 | if {$foundstrlen == 0} return | |
|
1556 | if {$findloc == "Files"} { | |||
|
1557 | findfiles | |||
|
1558 | return | |||
|
1559 | } | |||
920 | if {![info exists selectedline]} { |
|
1560 | if {![info exists selectedline]} { | |
921 | set oldsel -1 |
|
1561 | set oldsel -1 | |
922 | } else { |
|
1562 | } else { | |
923 | set oldsel $selectedline |
|
1563 | set oldsel $selectedline | |
924 | } |
|
1564 | } | |
925 | set didsel 0 |
|
1565 | set didsel 0 | |
|
1566 | set fldtypes {Headline Author Date Committer CDate Comment} | |||
926 | for {set l 0} {$l < $numcommits} {incr l} { |
|
1567 | for {set l 0} {$l < $numcommits} {incr l} { | |
927 | set id $lineid($l) |
|
1568 | set id $lineid($l) | |
928 | set info $commitinfo($id) |
|
1569 | set info $commitinfo($id) | |
@@ -959,7 +1600,7 b' proc dofind {} {' | |||||
959 |
|
1600 | |||
960 | proc findselectline {l} { |
|
1601 | proc findselectline {l} { | |
961 | global findloc commentend ctext |
|
1602 | global findloc commentend ctext | |
962 | selectline $l |
|
1603 | selectline $l 1 | |
963 | if {$findloc == "All fields" || $findloc == "Comments"} { |
|
1604 | if {$findloc == "All fields" || $findloc == "Comments"} { | |
964 | # highlight the matches in the comments |
|
1605 | # highlight the matches in the comments | |
965 | set f [$ctext get 1.0 $commentend] |
|
1606 | set f [$ctext get 1.0 $commentend] | |
@@ -972,10 +1613,12 b' proc findselectline {l} {' | |||||
972 | } |
|
1613 | } | |
973 | } |
|
1614 | } | |
974 |
|
1615 | |||
975 | proc findnext {} { |
|
1616 | proc findnext {restart} { | |
976 | global matchinglines selectedline |
|
1617 | global matchinglines selectedline | |
977 | if {![info exists matchinglines]} { |
|
1618 | if {![info exists matchinglines]} { | |
978 | dofind |
|
1619 | if {$restart} { | |
|
1620 | dofind | |||
|
1621 | } | |||
979 | return |
|
1622 | return | |
980 | } |
|
1623 | } | |
981 | if {![info exists selectedline]} return |
|
1624 | if {![info exists selectedline]} return | |
@@ -1007,6 +1650,308 b' proc findprev {} {' | |||||
1007 | } |
|
1650 | } | |
1008 | } |
|
1651 | } | |
1009 |
|
1652 | |||
|
1653 | proc findlocchange {name ix op} { | |||
|
1654 | global findloc findtype findtypemenu | |||
|
1655 | if {$findloc == "Pickaxe"} { | |||
|
1656 | set findtype Exact | |||
|
1657 | set state disabled | |||
|
1658 | } else { | |||
|
1659 | set state normal | |||
|
1660 | } | |||
|
1661 | $findtypemenu entryconf 1 -state $state | |||
|
1662 | $findtypemenu entryconf 2 -state $state | |||
|
1663 | } | |||
|
1664 | ||||
|
1665 | proc stopfindproc {{done 0}} { | |||
|
1666 | global findprocpid findprocfile findids | |||
|
1667 | global ctext findoldcursor phase maincursor textcursor | |||
|
1668 | global findinprogress | |||
|
1669 | ||||
|
1670 | catch {unset findids} | |||
|
1671 | if {[info exists findprocpid]} { | |||
|
1672 | if {!$done} { | |||
|
1673 | catch {exec kill $findprocpid} | |||
|
1674 | } | |||
|
1675 | catch {close $findprocfile} | |||
|
1676 | unset findprocpid | |||
|
1677 | } | |||
|
1678 | if {[info exists findinprogress]} { | |||
|
1679 | unset findinprogress | |||
|
1680 | if {$phase != "incrdraw"} { | |||
|
1681 | . config -cursor $maincursor | |||
|
1682 | settextcursor $textcursor | |||
|
1683 | } | |||
|
1684 | } | |||
|
1685 | } | |||
|
1686 | ||||
|
1687 | proc findpatches {} { | |||
|
1688 | global findstring selectedline numcommits | |||
|
1689 | global findprocpid findprocfile | |||
|
1690 | global finddidsel ctext lineid findinprogress | |||
|
1691 | global findinsertpos | |||
|
1692 | ||||
|
1693 | if {$numcommits == 0} return | |||
|
1694 | ||||
|
1695 | # make a list of all the ids to search, starting at the one | |||
|
1696 | # after the selected line (if any) | |||
|
1697 | if {[info exists selectedline]} { | |||
|
1698 | set l $selectedline | |||
|
1699 | } else { | |||
|
1700 | set l -1 | |||
|
1701 | } | |||
|
1702 | set inputids {} | |||
|
1703 | for {set i 0} {$i < $numcommits} {incr i} { | |||
|
1704 | if {[incr l] >= $numcommits} { | |||
|
1705 | set l 0 | |||
|
1706 | } | |||
|
1707 | append inputids $lineid($l) "\n" | |||
|
1708 | } | |||
|
1709 | ||||
|
1710 | if {[catch { | |||
|
1711 | set f [open [list | hg git-diff-tree --stdin -s -r -S$findstring \ | |||
|
1712 | << $inputids] r] | |||
|
1713 | } err]} { | |||
|
1714 | error_popup "Error starting search process: $err" | |||
|
1715 | return | |||
|
1716 | } | |||
|
1717 | ||||
|
1718 | set findinsertpos end | |||
|
1719 | set findprocfile $f | |||
|
1720 | set findprocpid [pid $f] | |||
|
1721 | fconfigure $f -blocking 0 | |||
|
1722 | fileevent $f readable readfindproc | |||
|
1723 | set finddidsel 0 | |||
|
1724 | . config -cursor watch | |||
|
1725 | settextcursor watch | |||
|
1726 | set findinprogress 1 | |||
|
1727 | } | |||
|
1728 | ||||
|
1729 | proc readfindproc {} { | |||
|
1730 | global findprocfile finddidsel | |||
|
1731 | global idline matchinglines findinsertpos | |||
|
1732 | ||||
|
1733 | set n [gets $findprocfile line] | |||
|
1734 | if {$n < 0} { | |||
|
1735 | if {[eof $findprocfile]} { | |||
|
1736 | stopfindproc 1 | |||
|
1737 | if {!$finddidsel} { | |||
|
1738 | bell | |||
|
1739 | } | |||
|
1740 | } | |||
|
1741 | return | |||
|
1742 | } | |||
|
1743 | if {![regexp {^[0-9a-f]{40}} $line id]} { | |||
|
1744 | error_popup "Can't parse git-diff-tree output: $line" | |||
|
1745 | stopfindproc | |||
|
1746 | return | |||
|
1747 | } | |||
|
1748 | if {![info exists idline($id)]} { | |||
|
1749 | puts stderr "spurious id: $id" | |||
|
1750 | return | |||
|
1751 | } | |||
|
1752 | set l $idline($id) | |||
|
1753 | insertmatch $l $id | |||
|
1754 | } | |||
|
1755 | ||||
|
1756 | proc insertmatch {l id} { | |||
|
1757 | global matchinglines findinsertpos finddidsel | |||
|
1758 | ||||
|
1759 | if {$findinsertpos == "end"} { | |||
|
1760 | if {$matchinglines != {} && $l < [lindex $matchinglines 0]} { | |||
|
1761 | set matchinglines [linsert $matchinglines 0 $l] | |||
|
1762 | set findinsertpos 1 | |||
|
1763 | } else { | |||
|
1764 | lappend matchinglines $l | |||
|
1765 | } | |||
|
1766 | } else { | |||
|
1767 | set matchinglines [linsert $matchinglines $findinsertpos $l] | |||
|
1768 | incr findinsertpos | |||
|
1769 | } | |||
|
1770 | markheadline $l $id | |||
|
1771 | if {!$finddidsel} { | |||
|
1772 | findselectline $l | |||
|
1773 | set finddidsel 1 | |||
|
1774 | } | |||
|
1775 | } | |||
|
1776 | ||||
|
1777 | proc findfiles {} { | |||
|
1778 | global selectedline numcommits lineid ctext | |||
|
1779 | global ffileline finddidsel parents nparents | |||
|
1780 | global findinprogress findstartline findinsertpos | |||
|
1781 | global treediffs fdiffids fdiffsneeded fdiffpos | |||
|
1782 | global findmergefiles | |||
|
1783 | ||||
|
1784 | if {$numcommits == 0} return | |||
|
1785 | ||||
|
1786 | if {[info exists selectedline]} { | |||
|
1787 | set l [expr {$selectedline + 1}] | |||
|
1788 | } else { | |||
|
1789 | set l 0 | |||
|
1790 | } | |||
|
1791 | set ffileline $l | |||
|
1792 | set findstartline $l | |||
|
1793 | set diffsneeded {} | |||
|
1794 | set fdiffsneeded {} | |||
|
1795 | while 1 { | |||
|
1796 | set id $lineid($l) | |||
|
1797 | if {$findmergefiles || $nparents($id) == 1} { | |||
|
1798 | foreach p $parents($id) { | |||
|
1799 | if {![info exists treediffs([list $id $p])]} { | |||
|
1800 | append diffsneeded "$id $p\n" | |||
|
1801 | lappend fdiffsneeded [list $id $p] | |||
|
1802 | } | |||
|
1803 | } | |||
|
1804 | } | |||
|
1805 | if {[incr l] >= $numcommits} { | |||
|
1806 | set l 0 | |||
|
1807 | } | |||
|
1808 | if {$l == $findstartline} break | |||
|
1809 | } | |||
|
1810 | ||||
|
1811 | # start off a git-diff-tree process if needed | |||
|
1812 | if {$diffsneeded ne {}} { | |||
|
1813 | if {[catch { | |||
|
1814 | set df [open [list | hg git-diff-tree -r --stdin << $diffsneeded] r] | |||
|
1815 | } err ]} { | |||
|
1816 | error_popup "Error starting search process: $err" | |||
|
1817 | return | |||
|
1818 | } | |||
|
1819 | catch {unset fdiffids} | |||
|
1820 | set fdiffpos 0 | |||
|
1821 | fconfigure $df -blocking 0 | |||
|
1822 | fileevent $df readable [list readfilediffs $df] | |||
|
1823 | } | |||
|
1824 | ||||
|
1825 | set finddidsel 0 | |||
|
1826 | set findinsertpos end | |||
|
1827 | set id $lineid($l) | |||
|
1828 | set p [lindex $parents($id) 0] | |||
|
1829 | . config -cursor watch | |||
|
1830 | settextcursor watch | |||
|
1831 | set findinprogress 1 | |||
|
1832 | findcont [list $id $p] | |||
|
1833 | update | |||
|
1834 | } | |||
|
1835 | ||||
|
1836 | proc readfilediffs {df} { | |||
|
1837 | global findids fdiffids fdiffs | |||
|
1838 | ||||
|
1839 | set n [gets $df line] | |||
|
1840 | if {$n < 0} { | |||
|
1841 | if {[eof $df]} { | |||
|
1842 | donefilediff | |||
|
1843 | if {[catch {close $df} err]} { | |||
|
1844 | stopfindproc | |||
|
1845 | bell | |||
|
1846 | error_popup "Error in hg git-diff-tree: $err" | |||
|
1847 | } elseif {[info exists findids]} { | |||
|
1848 | set ids $findids | |||
|
1849 | stopfindproc | |||
|
1850 | bell | |||
|
1851 | error_popup "Couldn't find diffs for {$ids}" | |||
|
1852 | } | |||
|
1853 | } | |||
|
1854 | return | |||
|
1855 | } | |||
|
1856 | if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} { | |||
|
1857 | # start of a new string of diffs | |||
|
1858 | donefilediff | |||
|
1859 | set fdiffids [list $id $p] | |||
|
1860 | set fdiffs {} | |||
|
1861 | } elseif {[string match ":*" $line]} { | |||
|
1862 | lappend fdiffs [lindex $line 5] | |||
|
1863 | } | |||
|
1864 | } | |||
|
1865 | ||||
|
1866 | proc donefilediff {} { | |||
|
1867 | global fdiffids fdiffs treediffs findids | |||
|
1868 | global fdiffsneeded fdiffpos | |||
|
1869 | ||||
|
1870 | if {[info exists fdiffids]} { | |||
|
1871 | while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids | |||
|
1872 | && $fdiffpos < [llength $fdiffsneeded]} { | |||
|
1873 | # git-diff-tree doesn't output anything for a commit | |||
|
1874 | # which doesn't change anything | |||
|
1875 | set nullids [lindex $fdiffsneeded $fdiffpos] | |||
|
1876 | set treediffs($nullids) {} | |||
|
1877 | if {[info exists findids] && $nullids eq $findids} { | |||
|
1878 | unset findids | |||
|
1879 | findcont $nullids | |||
|
1880 | } | |||
|
1881 | incr fdiffpos | |||
|
1882 | } | |||
|
1883 | incr fdiffpos | |||
|
1884 | ||||
|
1885 | if {![info exists treediffs($fdiffids)]} { | |||
|
1886 | set treediffs($fdiffids) $fdiffs | |||
|
1887 | } | |||
|
1888 | if {[info exists findids] && $fdiffids eq $findids} { | |||
|
1889 | unset findids | |||
|
1890 | findcont $fdiffids | |||
|
1891 | } | |||
|
1892 | } | |||
|
1893 | } | |||
|
1894 | ||||
|
1895 | proc findcont {ids} { | |||
|
1896 | global findids treediffs parents nparents | |||
|
1897 | global ffileline findstartline finddidsel | |||
|
1898 | global lineid numcommits matchinglines findinprogress | |||
|
1899 | global findmergefiles | |||
|
1900 | ||||
|
1901 | set id [lindex $ids 0] | |||
|
1902 | set p [lindex $ids 1] | |||
|
1903 | set pi [lsearch -exact $parents($id) $p] | |||
|
1904 | set l $ffileline | |||
|
1905 | while 1 { | |||
|
1906 | if {$findmergefiles || $nparents($id) == 1} { | |||
|
1907 | if {![info exists treediffs($ids)]} { | |||
|
1908 | set findids $ids | |||
|
1909 | set ffileline $l | |||
|
1910 | return | |||
|
1911 | } | |||
|
1912 | set doesmatch 0 | |||
|
1913 | foreach f $treediffs($ids) { | |||
|
1914 | set x [findmatches $f] | |||
|
1915 | if {$x != {}} { | |||
|
1916 | set doesmatch 1 | |||
|
1917 | break | |||
|
1918 | } | |||
|
1919 | } | |||
|
1920 | if {$doesmatch} { | |||
|
1921 | insertmatch $l $id | |||
|
1922 | set pi $nparents($id) | |||
|
1923 | } | |||
|
1924 | } else { | |||
|
1925 | set pi $nparents($id) | |||
|
1926 | } | |||
|
1927 | if {[incr pi] >= $nparents($id)} { | |||
|
1928 | set pi 0 | |||
|
1929 | if {[incr l] >= $numcommits} { | |||
|
1930 | set l 0 | |||
|
1931 | } | |||
|
1932 | if {$l == $findstartline} break | |||
|
1933 | set id $lineid($l) | |||
|
1934 | } | |||
|
1935 | set p [lindex $parents($id) $pi] | |||
|
1936 | set ids [list $id $p] | |||
|
1937 | } | |||
|
1938 | stopfindproc | |||
|
1939 | if {!$finddidsel} { | |||
|
1940 | bell | |||
|
1941 | } | |||
|
1942 | } | |||
|
1943 | ||||
|
1944 | # mark a commit as matching by putting a yellow background | |||
|
1945 | # behind the headline | |||
|
1946 | proc markheadline {l id} { | |||
|
1947 | global canv mainfont linehtag commitinfo | |||
|
1948 | ||||
|
1949 | set bbox [$canv bbox $linehtag($l)] | |||
|
1950 | set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] | |||
|
1951 | $canv lower $t | |||
|
1952 | } | |||
|
1953 | ||||
|
1954 | # mark the bits of a headline, author or date that match a find string | |||
1010 | proc markmatches {canv l str tag matches font} { |
|
1955 | proc markmatches {canv l str tag matches font} { | |
1011 | set bbox [$canv bbox $tag] |
|
1956 | set bbox [$canv bbox $tag] | |
1012 | set x0 [lindex $bbox 0] |
|
1957 | set x0 [lindex $bbox 0] | |
@@ -1025,14 +1970,15 b' proc markmatches {canv l str tag matches' | |||||
1025 | } |
|
1970 | } | |
1026 |
|
1971 | |||
1027 | proc unmarkmatches {} { |
|
1972 | proc unmarkmatches {} { | |
1028 | global matchinglines |
|
1973 | global matchinglines findids | |
1029 | allcanvs delete matches |
|
1974 | allcanvs delete matches | |
1030 | catch {unset matchinglines} |
|
1975 | catch {unset matchinglines} | |
|
1976 | catch {unset findids} | |||
1031 | } |
|
1977 | } | |
1032 |
|
1978 | |||
1033 | proc selcanvline {x y} { |
|
1979 | proc selcanvline {w x y} { | |
1034 |
global canv canvy0 ctext linespc |
|
1980 | global canv canvy0 ctext linespc | |
1035 | global lineid linehtag linentag linedtag |
|
1981 | global lineid linehtag linentag linedtag rowtextx | |
1036 | set ymax [lindex [$canv cget -scrollregion] 3] |
|
1982 | set ymax [lindex [$canv cget -scrollregion] 3] | |
1037 | if {$ymax == {}} return |
|
1983 | if {$ymax == {}} return | |
1038 | set yfrac [lindex [$canv yview] 0] |
|
1984 | set yfrac [lindex [$canv yview] 0] | |
@@ -1041,17 +1987,56 b' proc selcanvline {x y} {' | |||||
1041 | if {$l < 0} { |
|
1987 | if {$l < 0} { | |
1042 | set l 0 |
|
1988 | set l 0 | |
1043 | } |
|
1989 | } | |
1044 | if {[info exists selectedline] && $selectedline == $l} return |
|
1990 | if {$w eq $canv} { | |
|
1991 | if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return | |||
|
1992 | } | |||
1045 | unmarkmatches |
|
1993 | unmarkmatches | |
1046 | selectline $l |
|
1994 | selectline $l 1 | |
|
1995 | } | |||
|
1996 | ||||
|
1997 | proc commit_descriptor {p} { | |||
|
1998 | global commitinfo | |||
|
1999 | set l "..." | |||
|
2000 | if {[info exists commitinfo($p)]} { | |||
|
2001 | set l [lindex $commitinfo($p) 0] | |||
|
2002 | } | |||
|
2003 | return "$p ($l)" | |||
1047 | } |
|
2004 | } | |
1048 |
|
2005 | |||
1049 | proc selectline {l} { |
|
2006 | # append some text to the ctext widget, and make any SHA1 ID | |
|
2007 | # that we know about be a clickable link. | |||
|
2008 | proc appendwithlinks {text} { | |||
|
2009 | global ctext idline linknum | |||
|
2010 | ||||
|
2011 | set start [$ctext index "end - 1c"] | |||
|
2012 | $ctext insert end $text | |||
|
2013 | $ctext insert end "\n" | |||
|
2014 | set links [regexp -indices -all -inline {[0-9a-f]{40}} $text] | |||
|
2015 | foreach l $links { | |||
|
2016 | set s [lindex $l 0] | |||
|
2017 | set e [lindex $l 1] | |||
|
2018 | set linkid [string range $text $s $e] | |||
|
2019 | if {![info exists idline($linkid)]} continue | |||
|
2020 | incr e | |||
|
2021 | $ctext tag add link "$start + $s c" "$start + $e c" | |||
|
2022 | $ctext tag add link$linknum "$start + $s c" "$start + $e c" | |||
|
2023 | $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1] | |||
|
2024 | incr linknum | |||
|
2025 | } | |||
|
2026 | $ctext tag conf link -foreground blue -underline 1 | |||
|
2027 | $ctext tag bind link <Enter> { %W configure -cursor hand2 } | |||
|
2028 | $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } | |||
|
2029 | } | |||
|
2030 | ||||
|
2031 | proc selectline {l isnew} { | |||
1050 | global canv canv2 canv3 ctext commitinfo selectedline |
|
2032 | global canv canv2 canv3 ctext commitinfo selectedline | |
1051 | global lineid linehtag linentag linedtag |
|
2033 | global lineid linehtag linentag linedtag | |
1052 |
global canvy0 linespc nparents |
|
2034 | global canvy0 linespc parents nparents children | |
1053 |
global cflist |
|
2035 | global cflist currentid sha1entry | |
1054 |
global commentend |
|
2036 | global commentend idtags idline linknum | |
|
2037 | ||||
|
2038 | $canv delete hover | |||
|
2039 | normalline | |||
1055 | if {![info exists lineid($l)] || ![info exists linehtag($l)]} return |
|
2040 | if {![info exists lineid($l)] || ![info exists linehtag($l)]} return | |
1056 | $canv delete secsel |
|
2041 | $canv delete secsel | |
1057 | set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ |
|
2042 | set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ | |
@@ -1099,6 +2084,11 b' proc selectline {l} {' | |||||
1099 | } |
|
2084 | } | |
1100 | allcanvs yview moveto [expr $newtop * 1.0 / $ymax] |
|
2085 | allcanvs yview moveto [expr $newtop * 1.0 / $ymax] | |
1101 | } |
|
2086 | } | |
|
2087 | ||||
|
2088 | if {$isnew} { | |||
|
2089 | addtohistory [list selectline $l 0] | |||
|
2090 | } | |||
|
2091 | ||||
1102 | set selectedline $l |
|
2092 | set selectedline $l | |
1103 |
|
2093 | |||
1104 | set id $lineid($l) |
|
2094 | set id $lineid($l) | |
@@ -1110,6 +2100,9 b' proc selectline {l} {' | |||||
1110 |
|
2100 | |||
1111 | $ctext conf -state normal |
|
2101 | $ctext conf -state normal | |
1112 | $ctext delete 0.0 end |
|
2102 | $ctext delete 0.0 end | |
|
2103 | set linknum 0 | |||
|
2104 | $ctext mark set fmark.0 0.0 | |||
|
2105 | $ctext mark gravity fmark.0 left | |||
1113 | set info $commitinfo($id) |
|
2106 | set info $commitinfo($id) | |
1114 | $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" |
|
2107 | $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n" | |
1115 | $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" |
|
2108 | $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n" | |
@@ -1120,25 +2113,36 b' proc selectline {l} {' | |||||
1120 | } |
|
2113 | } | |
1121 | $ctext insert end "\n" |
|
2114 | $ctext insert end "\n" | |
1122 | } |
|
2115 | } | |
1123 | $ctext insert end "\n" |
|
2116 | ||
1124 | $ctext insert end [lindex $info 5] |
|
2117 | set comment {} | |
1125 | $ctext insert end "\n" |
|
2118 | if {[info exists parents($id)]} { | |
|
2119 | foreach p $parents($id) { | |||
|
2120 | append comment "Parent: [commit_descriptor $p]\n" | |||
|
2121 | } | |||
|
2122 | } | |||
|
2123 | if {[info exists children($id)]} { | |||
|
2124 | foreach c $children($id) { | |||
|
2125 | append comment "Child: [commit_descriptor $c]\n" | |||
|
2126 | } | |||
|
2127 | } | |||
|
2128 | append comment "\n" | |||
|
2129 | append comment [lindex $info 5] | |||
|
2130 | ||||
|
2131 | # make anything that looks like a SHA1 ID be a clickable link | |||
|
2132 | appendwithlinks $comment | |||
|
2133 | ||||
1126 | $ctext tag delete Comments |
|
2134 | $ctext tag delete Comments | |
1127 | $ctext tag remove found 1.0 end |
|
2135 | $ctext tag remove found 1.0 end | |
1128 | $ctext conf -state disabled |
|
2136 | $ctext conf -state disabled | |
1129 | set commentend [$ctext index "end - 1c"] |
|
2137 | set commentend [$ctext index "end - 1c"] | |
1130 |
|
2138 | |||
1131 | $cflist delete 0 end |
|
2139 | $cflist delete 0 end | |
|
2140 | $cflist insert end "Comments" | |||
1132 | if {$nparents($id) == 1} { |
|
2141 | if {$nparents($id) == 1} { | |
1133 | if {![info exists treediffs($id)]} { |
|
2142 | startdiff [concat $id $parents($id)] | |
1134 | if {![info exists treepending]} { |
|
2143 | } elseif {$nparents($id) > 1} { | |
1135 |
|
|
2144 | mergediff $id | |
1136 | } |
|
|||
1137 | } else { |
|
|||
1138 | addtocflist $id |
|
|||
1139 | } |
|
|||
1140 | } |
|
2145 | } | |
1141 | catch {unset seenfile} |
|
|||
1142 | } |
|
2146 | } | |
1143 |
|
2147 | |||
1144 | proc selnextline {dir} { |
|
2148 | proc selnextline {dir} { | |
@@ -1146,132 +2150,746 b' proc selnextline {dir} {' | |||||
1146 | if {![info exists selectedline]} return |
|
2150 | if {![info exists selectedline]} return | |
1147 | set l [expr $selectedline + $dir] |
|
2151 | set l [expr $selectedline + $dir] | |
1148 | unmarkmatches |
|
2152 | unmarkmatches | |
1149 | selectline $l |
|
2153 | selectline $l 1 | |
|
2154 | } | |||
|
2155 | ||||
|
2156 | proc unselectline {} { | |||
|
2157 | global selectedline | |||
|
2158 | ||||
|
2159 | catch {unset selectedline} | |||
|
2160 | allcanvs delete secsel | |||
|
2161 | } | |||
|
2162 | ||||
|
2163 | proc addtohistory {cmd} { | |||
|
2164 | global history historyindex | |||
|
2165 | ||||
|
2166 | if {$historyindex > 0 | |||
|
2167 | && [lindex $history [expr {$historyindex - 1}]] == $cmd} { | |||
|
2168 | return | |||
|
2169 | } | |||
|
2170 | ||||
|
2171 | if {$historyindex < [llength $history]} { | |||
|
2172 | set history [lreplace $history $historyindex end $cmd] | |||
|
2173 | } else { | |||
|
2174 | lappend history $cmd | |||
|
2175 | } | |||
|
2176 | incr historyindex | |||
|
2177 | if {$historyindex > 1} { | |||
|
2178 | .ctop.top.bar.leftbut conf -state normal | |||
|
2179 | } else { | |||
|
2180 | .ctop.top.bar.leftbut conf -state disabled | |||
|
2181 | } | |||
|
2182 | .ctop.top.bar.rightbut conf -state disabled | |||
|
2183 | } | |||
|
2184 | ||||
|
2185 | proc goback {} { | |||
|
2186 | global history historyindex | |||
|
2187 | ||||
|
2188 | if {$historyindex > 1} { | |||
|
2189 | incr historyindex -1 | |||
|
2190 | set cmd [lindex $history [expr {$historyindex - 1}]] | |||
|
2191 | eval $cmd | |||
|
2192 | .ctop.top.bar.rightbut conf -state normal | |||
|
2193 | } | |||
|
2194 | if {$historyindex <= 1} { | |||
|
2195 | .ctop.top.bar.leftbut conf -state disabled | |||
|
2196 | } | |||
|
2197 | } | |||
|
2198 | ||||
|
2199 | proc goforw {} { | |||
|
2200 | global history historyindex | |||
|
2201 | ||||
|
2202 | if {$historyindex < [llength $history]} { | |||
|
2203 | set cmd [lindex $history $historyindex] | |||
|
2204 | incr historyindex | |||
|
2205 | eval $cmd | |||
|
2206 | .ctop.top.bar.leftbut conf -state normal | |||
|
2207 | } | |||
|
2208 | if {$historyindex >= [llength $history]} { | |||
|
2209 | .ctop.top.bar.rightbut conf -state disabled | |||
|
2210 | } | |||
|
2211 | } | |||
|
2212 | ||||
|
2213 | proc mergediff {id} { | |||
|
2214 | global parents diffmergeid diffmergegca mergefilelist diffpindex | |||
|
2215 | ||||
|
2216 | set diffmergeid $id | |||
|
2217 | set diffpindex -1 | |||
|
2218 | set diffmergegca [findgca $parents($id)] | |||
|
2219 | if {[info exists mergefilelist($id)]} { | |||
|
2220 | if {$mergefilelist($id) ne {}} { | |||
|
2221 | showmergediff | |||
|
2222 | } | |||
|
2223 | } else { | |||
|
2224 | contmergediff {} | |||
|
2225 | } | |||
1150 | } |
|
2226 | } | |
1151 |
|
2227 | |||
1152 |
proc |
|
2228 | proc findgca {ids} { | |
1153 | global currentid treediffs cflist treepending |
|
2229 | set gca {} | |
1154 | if {$id != $currentid} { |
|
2230 | foreach id $ids { | |
1155 | gettreediffs $currentid |
|
2231 | if {$gca eq {}} { | |
1156 | return |
|
2232 | set gca $id | |
|
2233 | } else { | |||
|
2234 | if {[catch { | |||
|
2235 | set gca [exec hg git-merge-base $gca $id] | |||
|
2236 | } err]} { | |||
|
2237 | return {} | |||
|
2238 | } | |||
|
2239 | } | |||
|
2240 | } | |||
|
2241 | return $gca | |||
|
2242 | } | |||
|
2243 | ||||
|
2244 | proc contmergediff {ids} { | |||
|
2245 | global diffmergeid diffpindex parents nparents diffmergegca | |||
|
2246 | global treediffs mergefilelist diffids treepending | |||
|
2247 | ||||
|
2248 | # diff the child against each of the parents, and diff | |||
|
2249 | # each of the parents against the GCA. | |||
|
2250 | while 1 { | |||
|
2251 | if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} { | |||
|
2252 | set ids [list [lindex $ids 1] $diffmergegca] | |||
|
2253 | } else { | |||
|
2254 | if {[incr diffpindex] >= $nparents($diffmergeid)} break | |||
|
2255 | set p [lindex $parents($diffmergeid) $diffpindex] | |||
|
2256 | set ids [list $diffmergeid $p] | |||
|
2257 | } | |||
|
2258 | if {![info exists treediffs($ids)]} { | |||
|
2259 | set diffids $ids | |||
|
2260 | if {![info exists treepending]} { | |||
|
2261 | gettreediffs $ids | |||
|
2262 | } | |||
|
2263 | return | |||
|
2264 | } | |||
1157 | } |
|
2265 | } | |
1158 | $cflist insert end "All files" |
|
2266 | ||
1159 | foreach f $treediffs($currentid) { |
|
2267 | # If a file in some parent is different from the child and also | |
|
2268 | # different from the GCA, then it's interesting. | |||
|
2269 | # If we don't have a GCA, then a file is interesting if it is | |||
|
2270 | # different from the child in all the parents. | |||
|
2271 | if {$diffmergegca ne {}} { | |||
|
2272 | set files {} | |||
|
2273 | foreach p $parents($diffmergeid) { | |||
|
2274 | set gcadiffs $treediffs([list $p $diffmergegca]) | |||
|
2275 | foreach f $treediffs([list $diffmergeid $p]) { | |||
|
2276 | if {[lsearch -exact $files $f] < 0 | |||
|
2277 | && [lsearch -exact $gcadiffs $f] >= 0} { | |||
|
2278 | lappend files $f | |||
|
2279 | } | |||
|
2280 | } | |||
|
2281 | } | |||
|
2282 | set files [lsort $files] | |||
|
2283 | } else { | |||
|
2284 | set p [lindex $parents($diffmergeid) 0] | |||
|
2285 | set files $treediffs([list $diffmergeid $p]) | |||
|
2286 | for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} { | |||
|
2287 | set p [lindex $parents($diffmergeid) $i] | |||
|
2288 | set df $treediffs([list $diffmergeid $p]) | |||
|
2289 | set nf {} | |||
|
2290 | foreach f $files { | |||
|
2291 | if {[lsearch -exact $df $f] >= 0} { | |||
|
2292 | lappend nf $f | |||
|
2293 | } | |||
|
2294 | } | |||
|
2295 | set files $nf | |||
|
2296 | } | |||
|
2297 | } | |||
|
2298 | ||||
|
2299 | set mergefilelist($diffmergeid) $files | |||
|
2300 | if {$files ne {}} { | |||
|
2301 | showmergediff | |||
|
2302 | } | |||
|
2303 | } | |||
|
2304 | ||||
|
2305 | proc showmergediff {} { | |||
|
2306 | global cflist diffmergeid mergefilelist parents | |||
|
2307 | global diffopts diffinhunk currentfile currenthunk filelines | |||
|
2308 | global diffblocked groupfilelast mergefds groupfilenum grouphunks | |||
|
2309 | ||||
|
2310 | set files $mergefilelist($diffmergeid) | |||
|
2311 | foreach f $files { | |||
1160 | $cflist insert end $f |
|
2312 | $cflist insert end $f | |
1161 | } |
|
2313 | } | |
1162 | getblobdiffs $id |
|
2314 | set env(GIT_DIFF_OPTS) $diffopts | |
|
2315 | set flist {} | |||
|
2316 | catch {unset currentfile} | |||
|
2317 | catch {unset currenthunk} | |||
|
2318 | catch {unset filelines} | |||
|
2319 | catch {unset groupfilenum} | |||
|
2320 | catch {unset grouphunks} | |||
|
2321 | set groupfilelast -1 | |||
|
2322 | foreach p $parents($diffmergeid) { | |||
|
2323 | set cmd [list | hg git-diff-tree -p $p $diffmergeid] | |||
|
2324 | set cmd [concat $cmd $mergefilelist($diffmergeid)] | |||
|
2325 | if {[catch {set f [open $cmd r]} err]} { | |||
|
2326 | error_popup "Error getting diffs: $err" | |||
|
2327 | foreach f $flist { | |||
|
2328 | catch {close $f} | |||
|
2329 | } | |||
|
2330 | return | |||
|
2331 | } | |||
|
2332 | lappend flist $f | |||
|
2333 | set ids [list $diffmergeid $p] | |||
|
2334 | set mergefds($ids) $f | |||
|
2335 | set diffinhunk($ids) 0 | |||
|
2336 | set diffblocked($ids) 0 | |||
|
2337 | fconfigure $f -blocking 0 | |||
|
2338 | fileevent $f readable [list getmergediffline $f $ids $diffmergeid] | |||
|
2339 | } | |||
|
2340 | } | |||
|
2341 | ||||
|
2342 | proc getmergediffline {f ids id} { | |||
|
2343 | global diffmergeid diffinhunk diffoldlines diffnewlines | |||
|
2344 | global currentfile currenthunk | |||
|
2345 | global diffoldstart diffnewstart diffoldlno diffnewlno | |||
|
2346 | global diffblocked mergefilelist | |||
|
2347 | global noldlines nnewlines difflcounts filelines | |||
|
2348 | ||||
|
2349 | set n [gets $f line] | |||
|
2350 | if {$n < 0} { | |||
|
2351 | if {![eof $f]} return | |||
|
2352 | } | |||
|
2353 | ||||
|
2354 | if {!([info exists diffmergeid] && $diffmergeid == $id)} { | |||
|
2355 | if {$n < 0} { | |||
|
2356 | close $f | |||
|
2357 | } | |||
|
2358 | return | |||
|
2359 | } | |||
|
2360 | ||||
|
2361 | if {$diffinhunk($ids) != 0} { | |||
|
2362 | set fi $currentfile($ids) | |||
|
2363 | if {$n > 0 && [regexp {^[-+ \\]} $line match]} { | |||
|
2364 | # continuing an existing hunk | |||
|
2365 | set line [string range $line 1 end] | |||
|
2366 | set p [lindex $ids 1] | |||
|
2367 | if {$match eq "-" || $match eq " "} { | |||
|
2368 | set filelines($p,$fi,$diffoldlno($ids)) $line | |||
|
2369 | incr diffoldlno($ids) | |||
|
2370 | } | |||
|
2371 | if {$match eq "+" || $match eq " "} { | |||
|
2372 | set filelines($id,$fi,$diffnewlno($ids)) $line | |||
|
2373 | incr diffnewlno($ids) | |||
|
2374 | } | |||
|
2375 | if {$match eq " "} { | |||
|
2376 | if {$diffinhunk($ids) == 2} { | |||
|
2377 | lappend difflcounts($ids) \ | |||
|
2378 | [list $noldlines($ids) $nnewlines($ids)] | |||
|
2379 | set noldlines($ids) 0 | |||
|
2380 | set diffinhunk($ids) 1 | |||
|
2381 | } | |||
|
2382 | incr noldlines($ids) | |||
|
2383 | } elseif {$match eq "-" || $match eq "+"} { | |||
|
2384 | if {$diffinhunk($ids) == 1} { | |||
|
2385 | lappend difflcounts($ids) [list $noldlines($ids)] | |||
|
2386 | set noldlines($ids) 0 | |||
|
2387 | set nnewlines($ids) 0 | |||
|
2388 | set diffinhunk($ids) 2 | |||
|
2389 | } | |||
|
2390 | if {$match eq "-"} { | |||
|
2391 | incr noldlines($ids) | |||
|
2392 | } else { | |||
|
2393 | incr nnewlines($ids) | |||
|
2394 | } | |||
|
2395 | } | |||
|
2396 | # and if it's \ No newline at end of line, then what? | |||
|
2397 | return | |||
|
2398 | } | |||
|
2399 | # end of a hunk | |||
|
2400 | if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} { | |||
|
2401 | lappend difflcounts($ids) [list $noldlines($ids)] | |||
|
2402 | } elseif {$diffinhunk($ids) == 2 | |||
|
2403 | && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} { | |||
|
2404 | lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)] | |||
|
2405 | } | |||
|
2406 | set currenthunk($ids) [list $currentfile($ids) \ | |||
|
2407 | $diffoldstart($ids) $diffnewstart($ids) \ | |||
|
2408 | $diffoldlno($ids) $diffnewlno($ids) \ | |||
|
2409 | $difflcounts($ids)] | |||
|
2410 | set diffinhunk($ids) 0 | |||
|
2411 | # -1 = need to block, 0 = unblocked, 1 = is blocked | |||
|
2412 | set diffblocked($ids) -1 | |||
|
2413 | processhunks | |||
|
2414 | if {$diffblocked($ids) == -1} { | |||
|
2415 | fileevent $f readable {} | |||
|
2416 | set diffblocked($ids) 1 | |||
|
2417 | } | |||
|
2418 | } | |||
|
2419 | ||||
|
2420 | if {$n < 0} { | |||
|
2421 | # eof | |||
|
2422 | if {!$diffblocked($ids)} { | |||
|
2423 | close $f | |||
|
2424 | set currentfile($ids) [llength $mergefilelist($diffmergeid)] | |||
|
2425 | set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}] | |||
|
2426 | processhunks | |||
|
2427 | } | |||
|
2428 | } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} { | |||
|
2429 | # start of a new file | |||
|
2430 | set currentfile($ids) \ | |||
|
2431 | [lsearch -exact $mergefilelist($diffmergeid) $fname] | |||
|
2432 | } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ | |||
|
2433 | $line match f1l f1c f2l f2c rest]} { | |||
|
2434 | if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} { | |||
|
2435 | # start of a new hunk | |||
|
2436 | if {$f1l == 0 && $f1c == 0} { | |||
|
2437 | set f1l 1 | |||
|
2438 | } | |||
|
2439 | if {$f2l == 0 && $f2c == 0} { | |||
|
2440 | set f2l 1 | |||
|
2441 | } | |||
|
2442 | set diffinhunk($ids) 1 | |||
|
2443 | set diffoldstart($ids) $f1l | |||
|
2444 | set diffnewstart($ids) $f2l | |||
|
2445 | set diffoldlno($ids) $f1l | |||
|
2446 | set diffnewlno($ids) $f2l | |||
|
2447 | set difflcounts($ids) {} | |||
|
2448 | set noldlines($ids) 0 | |||
|
2449 | set nnewlines($ids) 0 | |||
|
2450 | } | |||
|
2451 | } | |||
|
2452 | } | |||
|
2453 | ||||
|
2454 | proc processhunks {} { | |||
|
2455 | global diffmergeid parents nparents currenthunk | |||
|
2456 | global mergefilelist diffblocked mergefds | |||
|
2457 | global grouphunks grouplinestart grouplineend groupfilenum | |||
|
2458 | ||||
|
2459 | set nfiles [llength $mergefilelist($diffmergeid)] | |||
|
2460 | while 1 { | |||
|
2461 | set fi $nfiles | |||
|
2462 | set lno 0 | |||
|
2463 | # look for the earliest hunk | |||
|
2464 | foreach p $parents($diffmergeid) { | |||
|
2465 | set ids [list $diffmergeid $p] | |||
|
2466 | if {![info exists currenthunk($ids)]} return | |||
|
2467 | set i [lindex $currenthunk($ids) 0] | |||
|
2468 | set l [lindex $currenthunk($ids) 2] | |||
|
2469 | if {$i < $fi || ($i == $fi && $l < $lno)} { | |||
|
2470 | set fi $i | |||
|
2471 | set lno $l | |||
|
2472 | set pi $p | |||
|
2473 | } | |||
|
2474 | } | |||
|
2475 | ||||
|
2476 | if {$fi < $nfiles} { | |||
|
2477 | set ids [list $diffmergeid $pi] | |||
|
2478 | set hunk $currenthunk($ids) | |||
|
2479 | unset currenthunk($ids) | |||
|
2480 | if {$diffblocked($ids) > 0} { | |||
|
2481 | fileevent $mergefds($ids) readable \ | |||
|
2482 | [list getmergediffline $mergefds($ids) $ids $diffmergeid] | |||
|
2483 | } | |||
|
2484 | set diffblocked($ids) 0 | |||
|
2485 | ||||
|
2486 | if {[info exists groupfilenum] && $groupfilenum == $fi | |||
|
2487 | && $lno <= $grouplineend} { | |||
|
2488 | # add this hunk to the pending group | |||
|
2489 | lappend grouphunks($pi) $hunk | |||
|
2490 | set endln [lindex $hunk 4] | |||
|
2491 | if {$endln > $grouplineend} { | |||
|
2492 | set grouplineend $endln | |||
|
2493 | } | |||
|
2494 | continue | |||
|
2495 | } | |||
|
2496 | } | |||
|
2497 | ||||
|
2498 | # succeeding stuff doesn't belong in this group, so | |||
|
2499 | # process the group now | |||
|
2500 | if {[info exists groupfilenum]} { | |||
|
2501 | processgroup | |||
|
2502 | unset groupfilenum | |||
|
2503 | unset grouphunks | |||
|
2504 | } | |||
|
2505 | ||||
|
2506 | if {$fi >= $nfiles} break | |||
|
2507 | ||||
|
2508 | # start a new group | |||
|
2509 | set groupfilenum $fi | |||
|
2510 | set grouphunks($pi) [list $hunk] | |||
|
2511 | set grouplinestart $lno | |||
|
2512 | set grouplineend [lindex $hunk 4] | |||
|
2513 | } | |||
1163 | } |
|
2514 | } | |
1164 |
|
2515 | |||
1165 | proc gettreediffs {id} { |
|
2516 | proc processgroup {} { | |
1166 | global treediffs parents treepending |
|
2517 | global groupfilelast groupfilenum difffilestart | |
1167 | set treepending $id |
|
2518 | global mergefilelist diffmergeid ctext filelines | |
1168 | set treediffs($id) {} |
|
2519 | global parents diffmergeid diffoffset | |
1169 | set p [lindex $parents($id) 0] |
|
2520 | global grouphunks grouplinestart grouplineend nparents | |
1170 | if [catch {set gdtf [open "|hgit diff-tree -r $p $id" r]}] return |
|
2521 | global mergemax | |
1171 | fconfigure $gdtf -blocking 0 |
|
2522 | ||
1172 | fileevent $gdtf readable "gettreediffline $gdtf $id" |
|
2523 | $ctext conf -state normal | |
|
2524 | set id $diffmergeid | |||
|
2525 | set f $groupfilenum | |||
|
2526 | if {$groupfilelast != $f} { | |||
|
2527 | $ctext insert end "\n" | |||
|
2528 | set here [$ctext index "end - 1c"] | |||
|
2529 | set difffilestart($f) $here | |||
|
2530 | set mark fmark.[expr {$f + 1}] | |||
|
2531 | $ctext mark set $mark $here | |||
|
2532 | $ctext mark gravity $mark left | |||
|
2533 | set header [lindex $mergefilelist($id) $f] | |||
|
2534 | set l [expr {(78 - [string length $header]) / 2}] | |||
|
2535 | set pad [string range "----------------------------------------" 1 $l] | |||
|
2536 | $ctext insert end "$pad $header $pad\n" filesep | |||
|
2537 | set groupfilelast $f | |||
|
2538 | foreach p $parents($id) { | |||
|
2539 | set diffoffset($p) 0 | |||
|
2540 | } | |||
|
2541 | } | |||
|
2542 | ||||
|
2543 | $ctext insert end "@@" msep | |||
|
2544 | set nlines [expr {$grouplineend - $grouplinestart}] | |||
|
2545 | set events {} | |||
|
2546 | set pnum 0 | |||
|
2547 | foreach p $parents($id) { | |||
|
2548 | set startline [expr {$grouplinestart + $diffoffset($p)}] | |||
|
2549 | set ol $startline | |||
|
2550 | set nl $grouplinestart | |||
|
2551 | if {[info exists grouphunks($p)]} { | |||
|
2552 | foreach h $grouphunks($p) { | |||
|
2553 | set l [lindex $h 2] | |||
|
2554 | if {$nl < $l} { | |||
|
2555 | for {} {$nl < $l} {incr nl} { | |||
|
2556 | set filelines($p,$f,$ol) $filelines($id,$f,$nl) | |||
|
2557 | incr ol | |||
|
2558 | } | |||
|
2559 | } | |||
|
2560 | foreach chunk [lindex $h 5] { | |||
|
2561 | if {[llength $chunk] == 2} { | |||
|
2562 | set olc [lindex $chunk 0] | |||
|
2563 | set nlc [lindex $chunk 1] | |||
|
2564 | set nnl [expr {$nl + $nlc}] | |||
|
2565 | lappend events [list $nl $nnl $pnum $olc $nlc] | |||
|
2566 | incr ol $olc | |||
|
2567 | set nl $nnl | |||
|
2568 | } else { | |||
|
2569 | incr ol [lindex $chunk 0] | |||
|
2570 | incr nl [lindex $chunk 0] | |||
|
2571 | } | |||
|
2572 | } | |||
|
2573 | } | |||
|
2574 | } | |||
|
2575 | if {$nl < $grouplineend} { | |||
|
2576 | for {} {$nl < $grouplineend} {incr nl} { | |||
|
2577 | set filelines($p,$f,$ol) $filelines($id,$f,$nl) | |||
|
2578 | incr ol | |||
|
2579 | } | |||
|
2580 | } | |||
|
2581 | set nlines [expr {$ol - $startline}] | |||
|
2582 | $ctext insert end " -$startline,$nlines" msep | |||
|
2583 | incr pnum | |||
|
2584 | } | |||
|
2585 | ||||
|
2586 | set nlines [expr {$grouplineend - $grouplinestart}] | |||
|
2587 | $ctext insert end " +$grouplinestart,$nlines @@\n" msep | |||
|
2588 | ||||
|
2589 | set events [lsort -integer -index 0 $events] | |||
|
2590 | set nevents [llength $events] | |||
|
2591 | set nmerge $nparents($diffmergeid) | |||
|
2592 | set l $grouplinestart | |||
|
2593 | for {set i 0} {$i < $nevents} {set i $j} { | |||
|
2594 | set nl [lindex $events $i 0] | |||
|
2595 | while {$l < $nl} { | |||
|
2596 | $ctext insert end " $filelines($id,$f,$l)\n" | |||
|
2597 | incr l | |||
|
2598 | } | |||
|
2599 | set e [lindex $events $i] | |||
|
2600 | set enl [lindex $e 1] | |||
|
2601 | set j $i | |||
|
2602 | set active {} | |||
|
2603 | while 1 { | |||
|
2604 | set pnum [lindex $e 2] | |||
|
2605 | set olc [lindex $e 3] | |||
|
2606 | set nlc [lindex $e 4] | |||
|
2607 | if {![info exists delta($pnum)]} { | |||
|
2608 | set delta($pnum) [expr {$olc - $nlc}] | |||
|
2609 | lappend active $pnum | |||
|
2610 | } else { | |||
|
2611 | incr delta($pnum) [expr {$olc - $nlc}] | |||
|
2612 | } | |||
|
2613 | if {[incr j] >= $nevents} break | |||
|
2614 | set e [lindex $events $j] | |||
|
2615 | if {[lindex $e 0] >= $enl} break | |||
|
2616 | if {[lindex $e 1] > $enl} { | |||
|
2617 | set enl [lindex $e 1] | |||
|
2618 | } | |||
|
2619 | } | |||
|
2620 | set nlc [expr {$enl - $l}] | |||
|
2621 | set ncol mresult | |||
|
2622 | set bestpn -1 | |||
|
2623 | if {[llength $active] == $nmerge - 1} { | |||
|
2624 | # no diff for one of the parents, i.e. it's identical | |||
|
2625 | for {set pnum 0} {$pnum < $nmerge} {incr pnum} { | |||
|
2626 | if {![info exists delta($pnum)]} { | |||
|
2627 | if {$pnum < $mergemax} { | |||
|
2628 | lappend ncol m$pnum | |||
|
2629 | } else { | |||
|
2630 | lappend ncol mmax | |||
|
2631 | } | |||
|
2632 | break | |||
|
2633 | } | |||
|
2634 | } | |||
|
2635 | } elseif {[llength $active] == $nmerge} { | |||
|
2636 | # all parents are different, see if one is very similar | |||
|
2637 | set bestsim 30 | |||
|
2638 | for {set pnum 0} {$pnum < $nmerge} {incr pnum} { | |||
|
2639 | set sim [similarity $pnum $l $nlc $f \ | |||
|
2640 | [lrange $events $i [expr {$j-1}]]] | |||
|
2641 | if {$sim > $bestsim} { | |||
|
2642 | set bestsim $sim | |||
|
2643 | set bestpn $pnum | |||
|
2644 | } | |||
|
2645 | } | |||
|
2646 | if {$bestpn >= 0} { | |||
|
2647 | lappend ncol m$bestpn | |||
|
2648 | } | |||
|
2649 | } | |||
|
2650 | set pnum -1 | |||
|
2651 | foreach p $parents($id) { | |||
|
2652 | incr pnum | |||
|
2653 | if {![info exists delta($pnum)] || $pnum == $bestpn} continue | |||
|
2654 | set olc [expr {$nlc + $delta($pnum)}] | |||
|
2655 | set ol [expr {$l + $diffoffset($p)}] | |||
|
2656 | incr diffoffset($p) $delta($pnum) | |||
|
2657 | unset delta($pnum) | |||
|
2658 | for {} {$olc > 0} {incr olc -1} { | |||
|
2659 | $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum | |||
|
2660 | incr ol | |||
|
2661 | } | |||
|
2662 | } | |||
|
2663 | set endl [expr {$l + $nlc}] | |||
|
2664 | if {$bestpn >= 0} { | |||
|
2665 | # show this pretty much as a normal diff | |||
|
2666 | set p [lindex $parents($id) $bestpn] | |||
|
2667 | set ol [expr {$l + $diffoffset($p)}] | |||
|
2668 | incr diffoffset($p) $delta($bestpn) | |||
|
2669 | unset delta($bestpn) | |||
|
2670 | for {set k $i} {$k < $j} {incr k} { | |||
|
2671 | set e [lindex $events $k] | |||
|
2672 | if {[lindex $e 2] != $bestpn} continue | |||
|
2673 | set nl [lindex $e 0] | |||
|
2674 | set ol [expr {$ol + $nl - $l}] | |||
|
2675 | for {} {$l < $nl} {incr l} { | |||
|
2676 | $ctext insert end "+$filelines($id,$f,$l)\n" $ncol | |||
|
2677 | } | |||
|
2678 | set c [lindex $e 3] | |||
|
2679 | for {} {$c > 0} {incr c -1} { | |||
|
2680 | $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn | |||
|
2681 | incr ol | |||
|
2682 | } | |||
|
2683 | set nl [lindex $e 1] | |||
|
2684 | for {} {$l < $nl} {incr l} { | |||
|
2685 | $ctext insert end "+$filelines($id,$f,$l)\n" mresult | |||
|
2686 | } | |||
|
2687 | } | |||
|
2688 | } | |||
|
2689 | for {} {$l < $endl} {incr l} { | |||
|
2690 | $ctext insert end "+$filelines($id,$f,$l)\n" $ncol | |||
|
2691 | } | |||
|
2692 | } | |||
|
2693 | while {$l < $grouplineend} { | |||
|
2694 | $ctext insert end " $filelines($id,$f,$l)\n" | |||
|
2695 | incr l | |||
|
2696 | } | |||
|
2697 | $ctext conf -state disabled | |||
1173 | } |
|
2698 | } | |
1174 |
|
2699 | |||
1175 | proc gettreediffline {gdtf id} { |
|
2700 | proc similarity {pnum l nlc f events} { | |
1176 | global treediffs treepending |
|
2701 | global diffmergeid parents diffoffset filelines | |
|
2702 | ||||
|
2703 | set id $diffmergeid | |||
|
2704 | set p [lindex $parents($id) $pnum] | |||
|
2705 | set ol [expr {$l + $diffoffset($p)}] | |||
|
2706 | set endl [expr {$l + $nlc}] | |||
|
2707 | set same 0 | |||
|
2708 | set diff 0 | |||
|
2709 | foreach e $events { | |||
|
2710 | if {[lindex $e 2] != $pnum} continue | |||
|
2711 | set nl [lindex $e 0] | |||
|
2712 | set ol [expr {$ol + $nl - $l}] | |||
|
2713 | for {} {$l < $nl} {incr l} { | |||
|
2714 | incr same [string length $filelines($id,$f,$l)] | |||
|
2715 | incr same | |||
|
2716 | } | |||
|
2717 | set oc [lindex $e 3] | |||
|
2718 | for {} {$oc > 0} {incr oc -1} { | |||
|
2719 | incr diff [string length $filelines($p,$f,$ol)] | |||
|
2720 | incr diff | |||
|
2721 | incr ol | |||
|
2722 | } | |||
|
2723 | set nl [lindex $e 1] | |||
|
2724 | for {} {$l < $nl} {incr l} { | |||
|
2725 | incr diff [string length $filelines($id,$f,$l)] | |||
|
2726 | incr diff | |||
|
2727 | } | |||
|
2728 | } | |||
|
2729 | for {} {$l < $endl} {incr l} { | |||
|
2730 | incr same [string length $filelines($id,$f,$l)] | |||
|
2731 | incr same | |||
|
2732 | } | |||
|
2733 | if {$same == 0} { | |||
|
2734 | return 0 | |||
|
2735 | } | |||
|
2736 | return [expr {200 * $same / (2 * $same + $diff)}] | |||
|
2737 | } | |||
|
2738 | ||||
|
2739 | proc startdiff {ids} { | |||
|
2740 | global treediffs diffids treepending diffmergeid | |||
|
2741 | ||||
|
2742 | set diffids $ids | |||
|
2743 | catch {unset diffmergeid} | |||
|
2744 | if {![info exists treediffs($ids)]} { | |||
|
2745 | if {![info exists treepending]} { | |||
|
2746 | gettreediffs $ids | |||
|
2747 | } | |||
|
2748 | } else { | |||
|
2749 | addtocflist $ids | |||
|
2750 | } | |||
|
2751 | } | |||
|
2752 | ||||
|
2753 | proc addtocflist {ids} { | |||
|
2754 | global treediffs cflist | |||
|
2755 | foreach f $treediffs($ids) { | |||
|
2756 | $cflist insert end $f | |||
|
2757 | } | |||
|
2758 | getblobdiffs $ids | |||
|
2759 | } | |||
|
2760 | ||||
|
2761 | proc gettreediffs {ids} { | |||
|
2762 | global treediff parents treepending | |||
|
2763 | set treepending $ids | |||
|
2764 | set treediff {} | |||
|
2765 | set id [lindex $ids 0] | |||
|
2766 | set p [lindex $ids 1] | |||
|
2767 | if [catch {set gdtf [open "|hg git-diff-tree -r $p $id" r]}] return | |||
|
2768 | fconfigure $gdtf -blocking 0 | |||
|
2769 | fileevent $gdtf readable [list gettreediffline $gdtf $ids] | |||
|
2770 | } | |||
|
2771 | ||||
|
2772 | proc gettreediffline {gdtf ids} { | |||
|
2773 | global treediff treediffs treepending diffids diffmergeid | |||
|
2774 | ||||
1177 | set n [gets $gdtf line] |
|
2775 | set n [gets $gdtf line] | |
1178 | if {$n < 0} { |
|
2776 | if {$n < 0} { | |
1179 | if {![eof $gdtf]} return |
|
2777 | if {![eof $gdtf]} return | |
1180 | close $gdtf |
|
2778 | close $gdtf | |
|
2779 | set treediffs($ids) $treediff | |||
1181 | unset treepending |
|
2780 | unset treepending | |
1182 | addtocflist $id |
|
2781 | if {$ids != $diffids} { | |
|
2782 | gettreediffs $diffids | |||
|
2783 | } else { | |||
|
2784 | if {[info exists diffmergeid]} { | |||
|
2785 | contmergediff $ids | |||
|
2786 | } else { | |||
|
2787 | addtocflist $ids | |||
|
2788 | } | |||
|
2789 | } | |||
1183 | return |
|
2790 | return | |
1184 | } |
|
2791 | } | |
1185 | set file [lindex $line 5] |
|
2792 | set file [lindex $line 5] | |
1186 |
lappend treediff |
|
2793 | lappend treediff $file | |
1187 | } |
|
2794 | } | |
1188 |
|
2795 | |||
1189 | proc getblobdiffs {id} { |
|
2796 | proc getblobdiffs {ids} { | |
1190 |
global |
|
2797 | global diffopts blobdifffd diffids env curdifftag curtagstart | |
1191 | global diffindex difffilestart |
|
2798 | global difffilestart nextupdate diffinhdr treediffs | |
1192 | set p [lindex $parents($id) 0] |
|
2799 | ||
|
2800 | set id [lindex $ids 0] | |||
|
2801 | set p [lindex $ids 1] | |||
1193 | set env(GIT_DIFF_OPTS) $diffopts |
|
2802 | set env(GIT_DIFF_OPTS) $diffopts | |
1194 |
|
|
2803 | set cmd [list | hg git-diff-tree -r -p -C $p $id] | |
|
2804 | if {[catch {set bdf [open $cmd r]} err]} { | |||
1195 | puts "error getting diffs: $err" |
|
2805 | puts "error getting diffs: $err" | |
1196 | return |
|
2806 | return | |
1197 | } |
|
2807 | } | |
|
2808 | set diffinhdr 0 | |||
1198 | fconfigure $bdf -blocking 0 |
|
2809 | fconfigure $bdf -blocking 0 | |
1199 | set blobdifffd($id) $bdf |
|
2810 | set blobdifffd($ids) $bdf | |
1200 | set curdifftag Comments |
|
2811 | set curdifftag Comments | |
1201 | set curtagstart 0.0 |
|
2812 | set curtagstart 0.0 | |
1202 | set diffindex 0 |
|
|||
1203 | catch {unset difffilestart} |
|
2813 | catch {unset difffilestart} | |
1204 |
fileevent $bdf readable |
|
2814 | fileevent $bdf readable [list getblobdiffline $bdf $diffids] | |
|
2815 | set nextupdate [expr {[clock clicks -milliseconds] + 100}] | |||
1205 | } |
|
2816 | } | |
1206 |
|
2817 | |||
1207 | proc getblobdiffline {bdf id} { |
|
2818 | proc getblobdiffline {bdf ids} { | |
1208 |
global |
|
2819 | global diffids blobdifffd ctext curdifftag curtagstart | |
1209 |
global diffnexthead diffnextnote diff |
|
2820 | global diffnexthead diffnextnote difffilestart | |
|
2821 | global nextupdate diffinhdr treediffs | |||
|
2822 | global gaudydiff | |||
|
2823 | ||||
1210 | set n [gets $bdf line] |
|
2824 | set n [gets $bdf line] | |
1211 | if {$n < 0} { |
|
2825 | if {$n < 0} { | |
1212 | if {[eof $bdf]} { |
|
2826 | if {[eof $bdf]} { | |
1213 | close $bdf |
|
2827 | close $bdf | |
1214 |
if {$id |
|
2828 | if {$ids == $diffids && $bdf == $blobdifffd($ids)} { | |
1215 | $ctext tag add $curdifftag $curtagstart end |
|
2829 | $ctext tag add $curdifftag $curtagstart end | |
1216 | set seenfile($curdifftag) 1 |
|
|||
1217 | } |
|
2830 | } | |
1218 | } |
|
2831 | } | |
1219 | return |
|
2832 | return | |
1220 | } |
|
2833 | } | |
1221 |
if {$id |
|
2834 | if {$ids != $diffids || $bdf != $blobdifffd($ids)} { | |
1222 | return |
|
2835 | return | |
1223 | } |
|
2836 | } | |
1224 | $ctext conf -state normal |
|
2837 | $ctext conf -state normal | |
1225 |
if {[regexp {^ |
|
2838 | if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} { | |
1226 | # start of a new file |
|
2839 | # start of a new file | |
1227 | $ctext insert end "\n" |
|
2840 | $ctext insert end "\n" | |
1228 | $ctext tag add $curdifftag $curtagstart end |
|
2841 | $ctext tag add $curdifftag $curtagstart end | |
1229 | set seenfile($curdifftag) 1 |
|
|||
1230 | set curtagstart [$ctext index "end - 1c"] |
|
2842 | set curtagstart [$ctext index "end - 1c"] | |
1231 |
set header $ |
|
2843 | set header $newname | |
1232 | if {[info exists diffnexthead]} { |
|
2844 | set here [$ctext index "end - 1c"] | |
1233 | set fname $diffnexthead |
|
2845 | set i [lsearch -exact $treediffs($diffids) $fname] | |
1234 | set header "$diffnexthead ($diffnextnote)" |
|
2846 | if {$i >= 0} { | |
1235 |
|
|
2847 | set difffilestart($i) $here | |
|
2848 | incr i | |||
|
2849 | $ctext mark set fmark.$i $here | |||
|
2850 | $ctext mark gravity fmark.$i left | |||
1236 | } |
|
2851 | } | |
1237 | set difffilestart($diffindex) [$ctext index "end - 1c"] |
|
2852 | if {$newname != $fname} { | |
1238 | incr diffindex |
|
2853 | set i [lsearch -exact $treediffs($diffids) $newname] | |
|
2854 | if {$i >= 0} { | |||
|
2855 | set difffilestart($i) $here | |||
|
2856 | incr i | |||
|
2857 | $ctext mark set fmark.$i $here | |||
|
2858 | $ctext mark gravity fmark.$i left | |||
|
2859 | } | |||
|
2860 | } | |||
1239 | set curdifftag "f:$fname" |
|
2861 | set curdifftag "f:$fname" | |
1240 | $ctext tag delete $curdifftag |
|
2862 | $ctext tag delete $curdifftag | |
1241 | set l [expr {(78 - [string length $header]) / 2}] |
|
2863 | set l [expr {(78 - [string length $header]) / 2}] | |
1242 | set pad [string range "----------------------------------------" 1 $l] |
|
2864 | set pad [string range "----------------------------------------" 1 $l] | |
1243 | $ctext insert end "$pad $header $pad\n" filesep |
|
2865 | $ctext insert end "$pad $header $pad\n" filesep | |
1244 | } elseif {[string range $line 0 2] == "+++"} { |
|
2866 | set diffinhdr 1 | |
1245 | # no need to do anything with this |
|
2867 | } elseif {[regexp {^(---|\+\+\+)} $line]} { | |
1246 | } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} { |
|
2868 | set diffinhdr 0 | |
1247 | set diffnexthead $fn |
|
|||
1248 | set diffnextnote "created, mode $m" |
|
|||
1249 | } elseif {[string range $line 0 8] == "Deleted: "} { |
|
|||
1250 | set diffnexthead [string range $line 9 end] |
|
|||
1251 | set diffnextnote "deleted" |
|
|||
1252 | } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} { |
|
|||
1253 | # save the filename in case the next thing is "new file mode ..." |
|
|||
1254 | set diffnexthead $fn |
|
|||
1255 | set diffnextnote "modified" |
|
|||
1256 | } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} { |
|
|||
1257 | set diffnextnote "new file, mode $m" |
|
|||
1258 | } elseif {[string range $line 0 11] == "deleted file"} { |
|
|||
1259 | set diffnextnote "deleted" |
|
|||
1260 | } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ |
|
2869 | } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ | |
1261 | $line match f1l f1c f2l f2c rest]} { |
|
2870 | $line match f1l f1c f2l f2c rest]} { | |
1262 | $ctext insert end "\t" hunksep |
|
2871 | if {$gaudydiff} { | |
1263 | $ctext insert end " $f1l " d0 " $f2l " d1 |
|
2872 | $ctext insert end "\t" hunksep | |
1264 | $ctext insert end " $rest \n" hunksep |
|
2873 | $ctext insert end " $f1l " d0 " $f2l " d1 | |
|
2874 | $ctext insert end " $rest \n" hunksep | |||
|
2875 | } else { | |||
|
2876 | $ctext insert end "$line\n" hunksep | |||
|
2877 | } | |||
|
2878 | set diffinhdr 0 | |||
1265 | } else { |
|
2879 | } else { | |
1266 | set x [string range $line 0 0] |
|
2880 | set x [string range $line 0 0] | |
1267 | if {$x == "-" || $x == "+"} { |
|
2881 | if {$x == "-" || $x == "+"} { | |
1268 | set tag [expr {$x == "+"}] |
|
2882 | set tag [expr {$x == "+"}] | |
1269 | set line [string range $line 1 end] |
|
2883 | if {$gaudydiff} { | |
|
2884 | set line [string range $line 1 end] | |||
|
2885 | } | |||
1270 | $ctext insert end "$line\n" d$tag |
|
2886 | $ctext insert end "$line\n" d$tag | |
1271 | } elseif {$x == " "} { |
|
2887 | } elseif {$x == " "} { | |
1272 | set line [string range $line 1 end] |
|
2888 | if {$gaudydiff} { | |
|
2889 | set line [string range $line 1 end] | |||
|
2890 | } | |||
1273 | $ctext insert end "$line\n" |
|
2891 | $ctext insert end "$line\n" | |
1274 | } elseif {$x == "\\"} { |
|
2892 | } elseif {$diffinhdr || $x == "\\"} { | |
1275 | # e.g. "\ No newline at end of file" |
|
2893 | # e.g. "\ No newline at end of file" | |
1276 | $ctext insert end "$line\n" filesep |
|
2894 | $ctext insert end "$line\n" filesep | |
1277 | } else { |
|
2895 | } else { | |
@@ -1279,7 +2897,6 b' proc getblobdiffline {bdf id} {' | |||||
1279 | if {$curdifftag != "Comments"} { |
|
2897 | if {$curdifftag != "Comments"} { | |
1280 | $ctext insert end "\n" |
|
2898 | $ctext insert end "\n" | |
1281 | $ctext tag add $curdifftag $curtagstart end |
|
2899 | $ctext tag add $curdifftag $curtagstart end | |
1282 | set seenfile($curdifftag) 1 |
|
|||
1283 | set curtagstart [$ctext index "end - 1c"] |
|
2900 | set curtagstart [$ctext index "end - 1c"] | |
1284 | set curdifftag Comments |
|
2901 | set curdifftag Comments | |
1285 | } |
|
2902 | } | |
@@ -1287,6 +2904,12 b' proc getblobdiffline {bdf id} {' | |||||
1287 | } |
|
2904 | } | |
1288 | } |
|
2905 | } | |
1289 | $ctext conf -state disabled |
|
2906 | $ctext conf -state disabled | |
|
2907 | if {[clock clicks -milliseconds] >= $nextupdate} { | |||
|
2908 | incr nextupdate 100 | |||
|
2909 | fileevent $bdf readable {} | |||
|
2910 | update | |||
|
2911 | fileevent $bdf readable "getblobdiffline $bdf {$ids}" | |||
|
2912 | } | |||
1290 | } |
|
2913 | } | |
1291 |
|
2914 | |||
1292 | proc nextfile {} { |
|
2915 | proc nextfile {} { | |
@@ -1294,52 +2917,45 b' proc nextfile {} {' | |||||
1294 | set here [$ctext index @0,0] |
|
2917 | set here [$ctext index @0,0] | |
1295 | for {set i 0} {[info exists difffilestart($i)]} {incr i} { |
|
2918 | for {set i 0} {[info exists difffilestart($i)]} {incr i} { | |
1296 | if {[$ctext compare $difffilestart($i) > $here]} { |
|
2919 | if {[$ctext compare $difffilestart($i) > $here]} { | |
1297 | $ctext yview $difffilestart($i) |
|
2920 | if {![info exists pos] | |
1298 | break |
|
2921 | || [$ctext compare $difffilestart($i) < $pos]} { | |
|
2922 | set pos $difffilestart($i) | |||
|
2923 | } | |||
1299 | } |
|
2924 | } | |
1300 | } |
|
2925 | } | |
|
2926 | if {[info exists pos]} { | |||
|
2927 | $ctext yview $pos | |||
|
2928 | } | |||
1301 | } |
|
2929 | } | |
1302 |
|
2930 | |||
1303 | proc listboxsel {} { |
|
2931 | proc listboxsel {} { | |
1304 |
global ctext cflist currentid |
|
2932 | global ctext cflist currentid | |
1305 | if {![info exists currentid]} return |
|
2933 | if {![info exists currentid]} return | |
1306 | set sel [$cflist curselection] |
|
2934 | set sel [lsort [$cflist curselection]] | |
1307 | if {$sel == {} || [lsearch -exact $sel 0] >= 0} { |
|
2935 | if {$sel eq {}} return | |
1308 | # show everything |
|
2936 | set first [lindex $sel 0] | |
1309 | $ctext tag conf Comments -elide 0 |
|
2937 | catch {$ctext yview fmark.$first} | |
1310 | foreach f $treediffs($currentid) { |
|
|||
1311 | if [info exists seenfile(f:$f)] { |
|
|||
1312 | $ctext tag conf "f:$f" -elide 0 |
|
|||
1313 | } |
|
|||
1314 | } |
|
|||
1315 | } else { |
|
|||
1316 | # just show selected files |
|
|||
1317 | $ctext tag conf Comments -elide 1 |
|
|||
1318 | set i 1 |
|
|||
1319 | foreach f $treediffs($currentid) { |
|
|||
1320 | set elide [expr {[lsearch -exact $sel $i] < 0}] |
|
|||
1321 | if [info exists seenfile(f:$f)] { |
|
|||
1322 | $ctext tag conf "f:$f" -elide $elide |
|
|||
1323 | } |
|
|||
1324 | incr i |
|
|||
1325 | } |
|
|||
1326 | } |
|
|||
1327 | } |
|
2938 | } | |
1328 |
|
2939 | |||
1329 | proc setcoords {} { |
|
2940 | proc setcoords {} { | |
1330 | global linespc charspc canvx0 canvy0 mainfont |
|
2941 | global linespc charspc canvx0 canvy0 mainfont | |
|
2942 | global xspc1 xspc2 lthickness | |||
|
2943 | ||||
1331 | set linespc [font metrics $mainfont -linespace] |
|
2944 | set linespc [font metrics $mainfont -linespace] | |
1332 | set charspc [font measure $mainfont "m"] |
|
2945 | set charspc [font measure $mainfont "m"] | |
1333 | set canvy0 [expr 3 + 0.5 * $linespc] |
|
2946 | set canvy0 [expr 3 + 0.5 * $linespc] | |
1334 | set canvx0 [expr 3 + 0.5 * $linespc] |
|
2947 | set canvx0 [expr 3 + 0.5 * $linespc] | |
|
2948 | set lthickness [expr {int($linespc / 9) + 1}] | |||
|
2949 | set xspc1(0) $linespc | |||
|
2950 | set xspc2 $linespc | |||
1335 | } |
|
2951 | } | |
1336 |
|
2952 | |||
1337 | proc redisplay {} { |
|
2953 | proc redisplay {} { | |
1338 |
global s |
|
2954 | global stopped redisplaying phase | |
1339 | if {$stopped > 1} return |
|
2955 | if {$stopped > 1} return | |
1340 | if {$phase == "getcommits"} return |
|
2956 | if {$phase == "getcommits"} return | |
1341 | set redisplaying 1 |
|
2957 | set redisplaying 1 | |
1342 | if {$phase == "drawgraph"} { |
|
2958 | if {$phase == "drawgraph" || $phase == "incrdraw"} { | |
1343 | set stopped 1 |
|
2959 | set stopped 1 | |
1344 | } else { |
|
2960 | } else { | |
1345 | drawgraph |
|
2961 | drawgraph | |
@@ -1347,7 +2963,7 b' proc redisplay {} {' | |||||
1347 | } |
|
2963 | } | |
1348 |
|
2964 | |||
1349 | proc incrfont {inc} { |
|
2965 | proc incrfont {inc} { | |
1350 |
global mainfont namefont textfont |
|
2966 | global mainfont namefont textfont ctext canv phase | |
1351 | global stopped entries |
|
2967 | global stopped entries | |
1352 | unmarkmatches |
|
2968 | unmarkmatches | |
1353 | set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] |
|
2969 | set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]] | |
@@ -1365,6 +2981,13 b' proc incrfont {inc} {' | |||||
1365 | redisplay |
|
2981 | redisplay | |
1366 | } |
|
2982 | } | |
1367 |
|
2983 | |||
|
2984 | proc clearsha1 {} { | |||
|
2985 | global sha1entry sha1string | |||
|
2986 | if {[string length $sha1string] == 40} { | |||
|
2987 | $sha1entry delete 0 end | |||
|
2988 | } | |||
|
2989 | } | |||
|
2990 | ||||
1368 | proc sha1change {n1 n2 op} { |
|
2991 | proc sha1change {n1 n2 op} { | |
1369 | global sha1string currentid sha1but |
|
2992 | global sha1string currentid sha1but | |
1370 | if {$sha1string == {} |
|
2993 | if {$sha1string == {} | |
@@ -1383,18 +3006,35 b' proc sha1change {n1 n2 op} {' | |||||
1383 |
|
3006 | |||
1384 | proc gotocommit {} { |
|
3007 | proc gotocommit {} { | |
1385 | global sha1string currentid idline tagids |
|
3008 | global sha1string currentid idline tagids | |
|
3009 | global lineid numcommits | |||
|
3010 | ||||
1386 | if {$sha1string == {} |
|
3011 | if {$sha1string == {} | |
1387 | || ([info exists currentid] && $sha1string == $currentid)} return |
|
3012 | || ([info exists currentid] && $sha1string == $currentid)} return | |
1388 | if {[info exists tagids($sha1string)]} { |
|
3013 | if {[info exists tagids($sha1string)]} { | |
1389 | set id $tagids($sha1string) |
|
3014 | set id $tagids($sha1string) | |
1390 | } else { |
|
3015 | } else { | |
1391 | set id [string tolower $sha1string] |
|
3016 | set id [string tolower $sha1string] | |
|
3017 | if {[regexp {^[0-9a-f]{4,39}$} $id]} { | |||
|
3018 | set matches {} | |||
|
3019 | for {set l 0} {$l < $numcommits} {incr l} { | |||
|
3020 | if {[string match $id* $lineid($l)]} { | |||
|
3021 | lappend matches $lineid($l) | |||
|
3022 | } | |||
|
3023 | } | |||
|
3024 | if {$matches ne {}} { | |||
|
3025 | if {[llength $matches] > 1} { | |||
|
3026 | error_popup "Short SHA1 id $id is ambiguous" | |||
|
3027 | return | |||
|
3028 | } | |||
|
3029 | set id [lindex $matches 0] | |||
|
3030 | } | |||
|
3031 | } | |||
1392 | } |
|
3032 | } | |
1393 | if {[info exists idline($id)]} { |
|
3033 | if {[info exists idline($id)]} { | |
1394 | selectline $idline($id) |
|
3034 | selectline $idline($id) 1 | |
1395 | return |
|
3035 | return | |
1396 | } |
|
3036 | } | |
1397 |
if {[regexp {^[0-9a-fA-F]{4 |
|
3037 | if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { | |
1398 | set type "SHA1 id" |
|
3038 | set type "SHA1 id" | |
1399 | } else { |
|
3039 | } else { | |
1400 | set type "Tag" |
|
3040 | set type "Tag" | |
@@ -1402,6 +3042,562 b' proc gotocommit {} {' | |||||
1402 | error_popup "$type $sha1string is not known" |
|
3042 | error_popup "$type $sha1string is not known" | |
1403 | } |
|
3043 | } | |
1404 |
|
3044 | |||
|
3045 | proc lineenter {x y id} { | |||
|
3046 | global hoverx hovery hoverid hovertimer | |||
|
3047 | global commitinfo canv | |||
|
3048 | ||||
|
3049 | if {![info exists commitinfo($id)]} return | |||
|
3050 | set hoverx $x | |||
|
3051 | set hovery $y | |||
|
3052 | set hoverid $id | |||
|
3053 | if {[info exists hovertimer]} { | |||
|
3054 | after cancel $hovertimer | |||
|
3055 | } | |||
|
3056 | set hovertimer [after 500 linehover] | |||
|
3057 | $canv delete hover | |||
|
3058 | } | |||
|
3059 | ||||
|
3060 | proc linemotion {x y id} { | |||
|
3061 | global hoverx hovery hoverid hovertimer | |||
|
3062 | ||||
|
3063 | if {[info exists hoverid] && $id == $hoverid} { | |||
|
3064 | set hoverx $x | |||
|
3065 | set hovery $y | |||
|
3066 | if {[info exists hovertimer]} { | |||
|
3067 | after cancel $hovertimer | |||
|
3068 | } | |||
|
3069 | set hovertimer [after 500 linehover] | |||
|
3070 | } | |||
|
3071 | } | |||
|
3072 | ||||
|
3073 | proc lineleave {id} { | |||
|
3074 | global hoverid hovertimer canv | |||
|
3075 | ||||
|
3076 | if {[info exists hoverid] && $id == $hoverid} { | |||
|
3077 | $canv delete hover | |||
|
3078 | if {[info exists hovertimer]} { | |||
|
3079 | after cancel $hovertimer | |||
|
3080 | unset hovertimer | |||
|
3081 | } | |||
|
3082 | unset hoverid | |||
|
3083 | } | |||
|
3084 | } | |||
|
3085 | ||||
|
3086 | proc linehover {} { | |||
|
3087 | global hoverx hovery hoverid hovertimer | |||
|
3088 | global canv linespc lthickness | |||
|
3089 | global commitinfo mainfont | |||
|
3090 | ||||
|
3091 | set text [lindex $commitinfo($hoverid) 0] | |||
|
3092 | set ymax [lindex [$canv cget -scrollregion] 3] | |||
|
3093 | if {$ymax == {}} return | |||
|
3094 | set yfrac [lindex [$canv yview] 0] | |||
|
3095 | set x [expr {$hoverx + 2 * $linespc}] | |||
|
3096 | set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}] | |||
|
3097 | set x0 [expr {$x - 2 * $lthickness}] | |||
|
3098 | set y0 [expr {$y - 2 * $lthickness}] | |||
|
3099 | set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}] | |||
|
3100 | set y1 [expr {$y + $linespc + 2 * $lthickness}] | |||
|
3101 | set t [$canv create rectangle $x0 $y0 $x1 $y1 \ | |||
|
3102 | -fill \#ffff80 -outline black -width 1 -tags hover] | |||
|
3103 | $canv raise $t | |||
|
3104 | set t [$canv create text $x $y -anchor nw -text $text -tags hover] | |||
|
3105 | $canv raise $t | |||
|
3106 | } | |||
|
3107 | ||||
|
3108 | proc clickisonarrow {id y} { | |||
|
3109 | global mainline mainlinearrow sidelines lthickness | |||
|
3110 | ||||
|
3111 | set thresh [expr {2 * $lthickness + 6}] | |||
|
3112 | if {[info exists mainline($id)]} { | |||
|
3113 | if {$mainlinearrow($id) ne "none"} { | |||
|
3114 | if {abs([lindex $mainline($id) 1] - $y) < $thresh} { | |||
|
3115 | return "up" | |||
|
3116 | } | |||
|
3117 | } | |||
|
3118 | } | |||
|
3119 | if {[info exists sidelines($id)]} { | |||
|
3120 | foreach ls $sidelines($id) { | |||
|
3121 | set coords [lindex $ls 0] | |||
|
3122 | set arrow [lindex $ls 2] | |||
|
3123 | if {$arrow eq "first" || $arrow eq "both"} { | |||
|
3124 | if {abs([lindex $coords 1] - $y) < $thresh} { | |||
|
3125 | return "up" | |||
|
3126 | } | |||
|
3127 | } | |||
|
3128 | if {$arrow eq "last" || $arrow eq "both"} { | |||
|
3129 | if {abs([lindex $coords end] - $y) < $thresh} { | |||
|
3130 | return "down" | |||
|
3131 | } | |||
|
3132 | } | |||
|
3133 | } | |||
|
3134 | } | |||
|
3135 | return {} | |||
|
3136 | } | |||
|
3137 | ||||
|
3138 | proc arrowjump {id dirn y} { | |||
|
3139 | global mainline sidelines canv | |||
|
3140 | ||||
|
3141 | set yt {} | |||
|
3142 | if {$dirn eq "down"} { | |||
|
3143 | if {[info exists mainline($id)]} { | |||
|
3144 | set y1 [lindex $mainline($id) 1] | |||
|
3145 | if {$y1 > $y} { | |||
|
3146 | set yt $y1 | |||
|
3147 | } | |||
|
3148 | } | |||
|
3149 | if {[info exists sidelines($id)]} { | |||
|
3150 | foreach ls $sidelines($id) { | |||
|
3151 | set y1 [lindex $ls 0 1] | |||
|
3152 | if {$y1 > $y && ($yt eq {} || $y1 < $yt)} { | |||
|
3153 | set yt $y1 | |||
|
3154 | } | |||
|
3155 | } | |||
|
3156 | } | |||
|
3157 | } else { | |||
|
3158 | if {[info exists sidelines($id)]} { | |||
|
3159 | foreach ls $sidelines($id) { | |||
|
3160 | set y1 [lindex $ls 0 end] | |||
|
3161 | if {$y1 < $y && ($yt eq {} || $y1 > $yt)} { | |||
|
3162 | set yt $y1 | |||
|
3163 | } | |||
|
3164 | } | |||
|
3165 | } | |||
|
3166 | } | |||
|
3167 | if {$yt eq {}} return | |||
|
3168 | set ymax [lindex [$canv cget -scrollregion] 3] | |||
|
3169 | if {$ymax eq {} || $ymax <= 0} return | |||
|
3170 | set view [$canv yview] | |||
|
3171 | set yspan [expr {[lindex $view 1] - [lindex $view 0]}] | |||
|
3172 | set yfrac [expr {$yt / $ymax - $yspan / 2}] | |||
|
3173 | if {$yfrac < 0} { | |||
|
3174 | set yfrac 0 | |||
|
3175 | } | |||
|
3176 | $canv yview moveto $yfrac | |||
|
3177 | } | |||
|
3178 | ||||
|
3179 | proc lineclick {x y id isnew} { | |||
|
3180 | global ctext commitinfo children cflist canv thickerline | |||
|
3181 | ||||
|
3182 | unmarkmatches | |||
|
3183 | unselectline | |||
|
3184 | normalline | |||
|
3185 | $canv delete hover | |||
|
3186 | # draw this line thicker than normal | |||
|
3187 | drawlines $id 1 | |||
|
3188 | set thickerline $id | |||
|
3189 | if {$isnew} { | |||
|
3190 | set ymax [lindex [$canv cget -scrollregion] 3] | |||
|
3191 | if {$ymax eq {}} return | |||
|
3192 | set yfrac [lindex [$canv yview] 0] | |||
|
3193 | set y [expr {$y + $yfrac * $ymax}] | |||
|
3194 | } | |||
|
3195 | set dirn [clickisonarrow $id $y] | |||
|
3196 | if {$dirn ne {}} { | |||
|
3197 | arrowjump $id $dirn $y | |||
|
3198 | return | |||
|
3199 | } | |||
|
3200 | ||||
|
3201 | if {$isnew} { | |||
|
3202 | addtohistory [list lineclick $x $y $id 0] | |||
|
3203 | } | |||
|
3204 | # fill the details pane with info about this line | |||
|
3205 | $ctext conf -state normal | |||
|
3206 | $ctext delete 0.0 end | |||
|
3207 | $ctext tag conf link -foreground blue -underline 1 | |||
|
3208 | $ctext tag bind link <Enter> { %W configure -cursor hand2 } | |||
|
3209 | $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } | |||
|
3210 | $ctext insert end "Parent:\t" | |||
|
3211 | $ctext insert end $id [list link link0] | |||
|
3212 | $ctext tag bind link0 <1> [list selbyid $id] | |||
|
3213 | set info $commitinfo($id) | |||
|
3214 | $ctext insert end "\n\t[lindex $info 0]\n" | |||
|
3215 | $ctext insert end "\tAuthor:\t[lindex $info 1]\n" | |||
|
3216 | $ctext insert end "\tDate:\t[lindex $info 2]\n" | |||
|
3217 | if {[info exists children($id)]} { | |||
|
3218 | $ctext insert end "\nChildren:" | |||
|
3219 | set i 0 | |||
|
3220 | foreach child $children($id) { | |||
|
3221 | incr i | |||
|
3222 | set info $commitinfo($child) | |||
|
3223 | $ctext insert end "\n\t" | |||
|
3224 | $ctext insert end $child [list link link$i] | |||
|
3225 | $ctext tag bind link$i <1> [list selbyid $child] | |||
|
3226 | $ctext insert end "\n\t[lindex $info 0]" | |||
|
3227 | $ctext insert end "\n\tAuthor:\t[lindex $info 1]" | |||
|
3228 | $ctext insert end "\n\tDate:\t[lindex $info 2]\n" | |||
|
3229 | } | |||
|
3230 | } | |||
|
3231 | $ctext conf -state disabled | |||
|
3232 | ||||
|
3233 | $cflist delete 0 end | |||
|
3234 | } | |||
|
3235 | ||||
|
3236 | proc normalline {} { | |||
|
3237 | global thickerline | |||
|
3238 | if {[info exists thickerline]} { | |||
|
3239 | drawlines $thickerline 0 | |||
|
3240 | unset thickerline | |||
|
3241 | } | |||
|
3242 | } | |||
|
3243 | ||||
|
3244 | proc selbyid {id} { | |||
|
3245 | global idline | |||
|
3246 | if {[info exists idline($id)]} { | |||
|
3247 | selectline $idline($id) 1 | |||
|
3248 | } | |||
|
3249 | } | |||
|
3250 | ||||
|
3251 | proc mstime {} { | |||
|
3252 | global startmstime | |||
|
3253 | if {![info exists startmstime]} { | |||
|
3254 | set startmstime [clock clicks -milliseconds] | |||
|
3255 | } | |||
|
3256 | return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]] | |||
|
3257 | } | |||
|
3258 | ||||
|
3259 | proc rowmenu {x y id} { | |||
|
3260 | global rowctxmenu idline selectedline rowmenuid | |||
|
3261 | ||||
|
3262 | if {![info exists selectedline] || $idline($id) eq $selectedline} { | |||
|
3263 | set state disabled | |||
|
3264 | } else { | |||
|
3265 | set state normal | |||
|
3266 | } | |||
|
3267 | $rowctxmenu entryconfigure 0 -state $state | |||
|
3268 | $rowctxmenu entryconfigure 1 -state $state | |||
|
3269 | $rowctxmenu entryconfigure 2 -state $state | |||
|
3270 | set rowmenuid $id | |||
|
3271 | tk_popup $rowctxmenu $x $y | |||
|
3272 | } | |||
|
3273 | ||||
|
3274 | proc diffvssel {dirn} { | |||
|
3275 | global rowmenuid selectedline lineid | |||
|
3276 | ||||
|
3277 | if {![info exists selectedline]} return | |||
|
3278 | if {$dirn} { | |||
|
3279 | set oldid $lineid($selectedline) | |||
|
3280 | set newid $rowmenuid | |||
|
3281 | } else { | |||
|
3282 | set oldid $rowmenuid | |||
|
3283 | set newid $lineid($selectedline) | |||
|
3284 | } | |||
|
3285 | addtohistory [list doseldiff $oldid $newid] | |||
|
3286 | doseldiff $oldid $newid | |||
|
3287 | } | |||
|
3288 | ||||
|
3289 | proc doseldiff {oldid newid} { | |||
|
3290 | global ctext cflist | |||
|
3291 | global commitinfo | |||
|
3292 | ||||
|
3293 | $ctext conf -state normal | |||
|
3294 | $ctext delete 0.0 end | |||
|
3295 | $ctext mark set fmark.0 0.0 | |||
|
3296 | $ctext mark gravity fmark.0 left | |||
|
3297 | $cflist delete 0 end | |||
|
3298 | $cflist insert end "Top" | |||
|
3299 | $ctext insert end "From " | |||
|
3300 | $ctext tag conf link -foreground blue -underline 1 | |||
|
3301 | $ctext tag bind link <Enter> { %W configure -cursor hand2 } | |||
|
3302 | $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor } | |||
|
3303 | $ctext tag bind link0 <1> [list selbyid $oldid] | |||
|
3304 | $ctext insert end $oldid [list link link0] | |||
|
3305 | $ctext insert end "\n " | |||
|
3306 | $ctext insert end [lindex $commitinfo($oldid) 0] | |||
|
3307 | $ctext insert end "\n\nTo " | |||
|
3308 | $ctext tag bind link1 <1> [list selbyid $newid] | |||
|
3309 | $ctext insert end $newid [list link link1] | |||
|
3310 | $ctext insert end "\n " | |||
|
3311 | $ctext insert end [lindex $commitinfo($newid) 0] | |||
|
3312 | $ctext insert end "\n" | |||
|
3313 | $ctext conf -state disabled | |||
|
3314 | $ctext tag delete Comments | |||
|
3315 | $ctext tag remove found 1.0 end | |||
|
3316 | startdiff [list $newid $oldid] | |||
|
3317 | } | |||
|
3318 | ||||
|
3319 | proc mkpatch {} { | |||
|
3320 | global rowmenuid currentid commitinfo patchtop patchnum | |||
|
3321 | ||||
|
3322 | if {![info exists currentid]} return | |||
|
3323 | set oldid $currentid | |||
|
3324 | set oldhead [lindex $commitinfo($oldid) 0] | |||
|
3325 | set newid $rowmenuid | |||
|
3326 | set newhead [lindex $commitinfo($newid) 0] | |||
|
3327 | set top .patch | |||
|
3328 | set patchtop $top | |||
|
3329 | catch {destroy $top} | |||
|
3330 | toplevel $top | |||
|
3331 | label $top.title -text "Generate patch" | |||
|
3332 | grid $top.title - -pady 10 | |||
|
3333 | label $top.from -text "From:" | |||
|
3334 | entry $top.fromsha1 -width 40 -relief flat | |||
|
3335 | $top.fromsha1 insert 0 $oldid | |||
|
3336 | $top.fromsha1 conf -state readonly | |||
|
3337 | grid $top.from $top.fromsha1 -sticky w | |||
|
3338 | entry $top.fromhead -width 60 -relief flat | |||
|
3339 | $top.fromhead insert 0 $oldhead | |||
|
3340 | $top.fromhead conf -state readonly | |||
|
3341 | grid x $top.fromhead -sticky w | |||
|
3342 | label $top.to -text "To:" | |||
|
3343 | entry $top.tosha1 -width 40 -relief flat | |||
|
3344 | $top.tosha1 insert 0 $newid | |||
|
3345 | $top.tosha1 conf -state readonly | |||
|
3346 | grid $top.to $top.tosha1 -sticky w | |||
|
3347 | entry $top.tohead -width 60 -relief flat | |||
|
3348 | $top.tohead insert 0 $newhead | |||
|
3349 | $top.tohead conf -state readonly | |||
|
3350 | grid x $top.tohead -sticky w | |||
|
3351 | button $top.rev -text "Reverse" -command mkpatchrev -padx 5 | |||
|
3352 | grid $top.rev x -pady 10 | |||
|
3353 | label $top.flab -text "Output file:" | |||
|
3354 | entry $top.fname -width 60 | |||
|
3355 | $top.fname insert 0 [file normalize "patch$patchnum.patch"] | |||
|
3356 | incr patchnum | |||
|
3357 | grid $top.flab $top.fname -sticky w | |||
|
3358 | frame $top.buts | |||
|
3359 | button $top.buts.gen -text "Generate" -command mkpatchgo | |||
|
3360 | button $top.buts.can -text "Cancel" -command mkpatchcan | |||
|
3361 | grid $top.buts.gen $top.buts.can | |||
|
3362 | grid columnconfigure $top.buts 0 -weight 1 -uniform a | |||
|
3363 | grid columnconfigure $top.buts 1 -weight 1 -uniform a | |||
|
3364 | grid $top.buts - -pady 10 -sticky ew | |||
|
3365 | focus $top.fname | |||
|
3366 | } | |||
|
3367 | ||||
|
3368 | proc mkpatchrev {} { | |||
|
3369 | global patchtop | |||
|
3370 | ||||
|
3371 | set oldid [$patchtop.fromsha1 get] | |||
|
3372 | set oldhead [$patchtop.fromhead get] | |||
|
3373 | set newid [$patchtop.tosha1 get] | |||
|
3374 | set newhead [$patchtop.tohead get] | |||
|
3375 | foreach e [list fromsha1 fromhead tosha1 tohead] \ | |||
|
3376 | v [list $newid $newhead $oldid $oldhead] { | |||
|
3377 | $patchtop.$e conf -state normal | |||
|
3378 | $patchtop.$e delete 0 end | |||
|
3379 | $patchtop.$e insert 0 $v | |||
|
3380 | $patchtop.$e conf -state readonly | |||
|
3381 | } | |||
|
3382 | } | |||
|
3383 | ||||
|
3384 | proc mkpatchgo {} { | |||
|
3385 | global patchtop | |||
|
3386 | ||||
|
3387 | set oldid [$patchtop.fromsha1 get] | |||
|
3388 | set newid [$patchtop.tosha1 get] | |||
|
3389 | set fname [$patchtop.fname get] | |||
|
3390 | if {[catch {exec hg git-diff-tree -p $oldid $newid >$fname &} err]} { | |||
|
3391 | error_popup "Error creating patch: $err" | |||
|
3392 | } | |||
|
3393 | catch {destroy $patchtop} | |||
|
3394 | unset patchtop | |||
|
3395 | } | |||
|
3396 | ||||
|
3397 | proc mkpatchcan {} { | |||
|
3398 | global patchtop | |||
|
3399 | ||||
|
3400 | catch {destroy $patchtop} | |||
|
3401 | unset patchtop | |||
|
3402 | } | |||
|
3403 | ||||
|
3404 | proc mktag {} { | |||
|
3405 | global rowmenuid mktagtop commitinfo | |||
|
3406 | ||||
|
3407 | set top .maketag | |||
|
3408 | set mktagtop $top | |||
|
3409 | catch {destroy $top} | |||
|
3410 | toplevel $top | |||
|
3411 | label $top.title -text "Create tag" | |||
|
3412 | grid $top.title - -pady 10 | |||
|
3413 | label $top.id -text "ID:" | |||
|
3414 | entry $top.sha1 -width 40 -relief flat | |||
|
3415 | $top.sha1 insert 0 $rowmenuid | |||
|
3416 | $top.sha1 conf -state readonly | |||
|
3417 | grid $top.id $top.sha1 -sticky w | |||
|
3418 | entry $top.head -width 60 -relief flat | |||
|
3419 | $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] | |||
|
3420 | $top.head conf -state readonly | |||
|
3421 | grid x $top.head -sticky w | |||
|
3422 | label $top.tlab -text "Tag name:" | |||
|
3423 | entry $top.tag -width 60 | |||
|
3424 | grid $top.tlab $top.tag -sticky w | |||
|
3425 | frame $top.buts | |||
|
3426 | button $top.buts.gen -text "Create" -command mktaggo | |||
|
3427 | button $top.buts.can -text "Cancel" -command mktagcan | |||
|
3428 | grid $top.buts.gen $top.buts.can | |||
|
3429 | grid columnconfigure $top.buts 0 -weight 1 -uniform a | |||
|
3430 | grid columnconfigure $top.buts 1 -weight 1 -uniform a | |||
|
3431 | grid $top.buts - -pady 10 -sticky ew | |||
|
3432 | focus $top.tag | |||
|
3433 | } | |||
|
3434 | ||||
|
3435 | proc domktag {} { | |||
|
3436 | global mktagtop env tagids idtags | |||
|
3437 | ||||
|
3438 | set id [$mktagtop.sha1 get] | |||
|
3439 | set tag [$mktagtop.tag get] | |||
|
3440 | if {$tag == {}} { | |||
|
3441 | error_popup "No tag name specified" | |||
|
3442 | return | |||
|
3443 | } | |||
|
3444 | if {[info exists tagids($tag)]} { | |||
|
3445 | error_popup "Tag \"$tag\" already exists" | |||
|
3446 | return | |||
|
3447 | } | |||
|
3448 | if {[catch { | |||
|
3449 | set out [exec hg tag $tag $id] | |||
|
3450 | } err]} { | |||
|
3451 | error_popup "Error creating tag: $err" | |||
|
3452 | return | |||
|
3453 | } | |||
|
3454 | ||||
|
3455 | set tagids($tag) $id | |||
|
3456 | lappend idtags($id) $tag | |||
|
3457 | redrawtags $id | |||
|
3458 | } | |||
|
3459 | ||||
|
3460 | proc redrawtags {id} { | |||
|
3461 | global canv linehtag idline idpos selectedline | |||
|
3462 | ||||
|
3463 | if {![info exists idline($id)]} return | |||
|
3464 | $canv delete tag.$id | |||
|
3465 | set xt [eval drawtags $id $idpos($id)] | |||
|
3466 | $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2] | |||
|
3467 | if {[info exists selectedline] && $selectedline == $idline($id)} { | |||
|
3468 | selectline $selectedline 0 | |||
|
3469 | } | |||
|
3470 | } | |||
|
3471 | ||||
|
3472 | proc mktagcan {} { | |||
|
3473 | global mktagtop | |||
|
3474 | ||||
|
3475 | catch {destroy $mktagtop} | |||
|
3476 | unset mktagtop | |||
|
3477 | } | |||
|
3478 | ||||
|
3479 | proc mktaggo {} { | |||
|
3480 | domktag | |||
|
3481 | mktagcan | |||
|
3482 | } | |||
|
3483 | ||||
|
3484 | proc writecommit {} { | |||
|
3485 | global rowmenuid wrcomtop commitinfo wrcomcmd | |||
|
3486 | ||||
|
3487 | set top .writecommit | |||
|
3488 | set wrcomtop $top | |||
|
3489 | catch {destroy $top} | |||
|
3490 | toplevel $top | |||
|
3491 | label $top.title -text "Write commit to file" | |||
|
3492 | grid $top.title - -pady 10 | |||
|
3493 | label $top.id -text "ID:" | |||
|
3494 | entry $top.sha1 -width 40 -relief flat | |||
|
3495 | $top.sha1 insert 0 $rowmenuid | |||
|
3496 | $top.sha1 conf -state readonly | |||
|
3497 | grid $top.id $top.sha1 -sticky w | |||
|
3498 | entry $top.head -width 60 -relief flat | |||
|
3499 | $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] | |||
|
3500 | $top.head conf -state readonly | |||
|
3501 | grid x $top.head -sticky w | |||
|
3502 | label $top.clab -text "Command:" | |||
|
3503 | entry $top.cmd -width 60 -textvariable wrcomcmd | |||
|
3504 | grid $top.clab $top.cmd -sticky w -pady 10 | |||
|
3505 | label $top.flab -text "Output file:" | |||
|
3506 | entry $top.fname -width 60 | |||
|
3507 | $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"] | |||
|
3508 | grid $top.flab $top.fname -sticky w | |||
|
3509 | frame $top.buts | |||
|
3510 | button $top.buts.gen -text "Write" -command wrcomgo | |||
|
3511 | button $top.buts.can -text "Cancel" -command wrcomcan | |||
|
3512 | grid $top.buts.gen $top.buts.can | |||
|
3513 | grid columnconfigure $top.buts 0 -weight 1 -uniform a | |||
|
3514 | grid columnconfigure $top.buts 1 -weight 1 -uniform a | |||
|
3515 | grid $top.buts - -pady 10 -sticky ew | |||
|
3516 | focus $top.fname | |||
|
3517 | } | |||
|
3518 | ||||
|
3519 | proc wrcomgo {} { | |||
|
3520 | global wrcomtop | |||
|
3521 | ||||
|
3522 | set id [$wrcomtop.sha1 get] | |||
|
3523 | set cmd "echo $id | [$wrcomtop.cmd get]" | |||
|
3524 | set fname [$wrcomtop.fname get] | |||
|
3525 | if {[catch {exec sh -c $cmd >$fname &} err]} { | |||
|
3526 | error_popup "Error writing commit: $err" | |||
|
3527 | } | |||
|
3528 | catch {destroy $wrcomtop} | |||
|
3529 | unset wrcomtop | |||
|
3530 | } | |||
|
3531 | ||||
|
3532 | proc wrcomcan {} { | |||
|
3533 | global wrcomtop | |||
|
3534 | ||||
|
3535 | catch {destroy $wrcomtop} | |||
|
3536 | unset wrcomtop | |||
|
3537 | } | |||
|
3538 | ||||
|
3539 | proc listrefs {id} { | |||
|
3540 | global idtags idheads idotherrefs | |||
|
3541 | ||||
|
3542 | set x {} | |||
|
3543 | if {[info exists idtags($id)]} { | |||
|
3544 | set x $idtags($id) | |||
|
3545 | } | |||
|
3546 | set y {} | |||
|
3547 | if {[info exists idheads($id)]} { | |||
|
3548 | set y $idheads($id) | |||
|
3549 | } | |||
|
3550 | set z {} | |||
|
3551 | if {[info exists idotherrefs($id)]} { | |||
|
3552 | set z $idotherrefs($id) | |||
|
3553 | } | |||
|
3554 | return [list $x $y $z] | |||
|
3555 | } | |||
|
3556 | ||||
|
3557 | proc rereadrefs {} { | |||
|
3558 | global idtags idheads idotherrefs | |||
|
3559 | global tagids headids otherrefids | |||
|
3560 | ||||
|
3561 | set refids [concat [array names idtags] \ | |||
|
3562 | [array names idheads] [array names idotherrefs]] | |||
|
3563 | foreach id $refids { | |||
|
3564 | if {![info exists ref($id)]} { | |||
|
3565 | set ref($id) [listrefs $id] | |||
|
3566 | } | |||
|
3567 | } | |||
|
3568 | foreach v {tagids idtags headids idheads otherrefids idotherrefs} { | |||
|
3569 | catch {unset $v} | |||
|
3570 | } | |||
|
3571 | readrefs | |||
|
3572 | set refids [lsort -unique [concat $refids [array names idtags] \ | |||
|
3573 | [array names idheads] [array names idotherrefs]]] | |||
|
3574 | foreach id $refids { | |||
|
3575 | set v [listrefs $id] | |||
|
3576 | if {![info exists ref($id)] || $ref($id) != $v} { | |||
|
3577 | redrawtags $id | |||
|
3578 | } | |||
|
3579 | } | |||
|
3580 | } | |||
|
3581 | ||||
|
3582 | proc showtag {tag isnew} { | |||
|
3583 | global ctext cflist tagcontents tagids linknum | |||
|
3584 | ||||
|
3585 | if {$isnew} { | |||
|
3586 | addtohistory [list showtag $tag 0] | |||
|
3587 | } | |||
|
3588 | $ctext conf -state normal | |||
|
3589 | $ctext delete 0.0 end | |||
|
3590 | set linknum 0 | |||
|
3591 | if {[info exists tagcontents($tag)]} { | |||
|
3592 | set text $tagcontents($tag) | |||
|
3593 | } else { | |||
|
3594 | set text "Tag: $tag\nId: $tagids($tag)" | |||
|
3595 | } | |||
|
3596 | appendwithlinks $text | |||
|
3597 | $ctext conf -state disabled | |||
|
3598 | $cflist delete 0 end | |||
|
3599 | } | |||
|
3600 | ||||
1405 | proc doquit {} { |
|
3601 | proc doquit {} { | |
1406 | global stopped |
|
3602 | global stopped | |
1407 | set stopped 100 |
|
3603 | set stopped 100 | |
@@ -1412,12 +3608,16 b' proc doquit {} {' | |||||
1412 | set datemode 0 |
|
3608 | set datemode 0 | |
1413 | set boldnames 0 |
|
3609 | set boldnames 0 | |
1414 | set diffopts "-U 5 -p" |
|
3610 | set diffopts "-U 5 -p" | |
|
3611 | set wrcomcmd "hg git-diff-tree --stdin -p --pretty" | |||
1415 |
|
3612 | |||
1416 | set mainfont {Helvetica 9} |
|
3613 | set mainfont {Helvetica 9} | |
1417 | set textfont {Courier 9} |
|
3614 | set textfont {Courier 9} | |
|
3615 | set findmergefiles 0 | |||
|
3616 | set gaudydiff 0 | |||
|
3617 | set maxgraphpct 50 | |||
|
3618 | set maxwidth 16 | |||
1418 |
|
3619 | |||
1419 | set colors {green red blue magenta darkgrey brown orange} |
|
3620 | set colors {green red blue magenta darkgrey brown orange} | |
1420 | set colorbycommitter false |
|
|||
1421 |
|
3621 | |||
1422 | catch {source ~/.gitk} |
|
3622 | catch {source ~/.gitk} | |
1423 |
|
3623 | |||
@@ -1431,7 +3631,6 b' foreach arg $argv {' | |||||
1431 | switch -regexp -- $arg { |
|
3631 | switch -regexp -- $arg { | |
1432 | "^$" { } |
|
3632 | "^$" { } | |
1433 | "^-b" { set boldnames 1 } |
|
3633 | "^-b" { set boldnames 1 } | |
1434 | "^-c" { set colorbycommitter 1 } |
|
|||
1435 | "^-d" { set datemode 1 } |
|
3634 | "^-d" { set datemode 1 } | |
1436 | default { |
|
3635 | default { | |
1437 | lappend revtreeargs $arg |
|
3636 | lappend revtreeargs $arg | |
@@ -1439,10 +3638,14 b' foreach arg $argv {' | |||||
1439 | } |
|
3638 | } | |
1440 | } |
|
3639 | } | |
1441 |
|
3640 | |||
|
3641 | set history {} | |||
|
3642 | set historyindex 0 | |||
|
3643 | ||||
1442 | set stopped 0 |
|
3644 | set stopped 0 | |
1443 | set redisplaying 0 |
|
3645 | set redisplaying 0 | |
1444 | set stuffsaved 0 |
|
3646 | set stuffsaved 0 | |
|
3647 | set patchnum 0 | |||
1445 | setcoords |
|
3648 | setcoords | |
1446 | makewindow |
|
3649 | makewindow | |
1447 | readrefs |
|
3650 | readrefs | |
1448 |
|
|
3651 | getcommits $revtreeargs |
General Comments 0
You need to be logged in to leave comments.
Login now