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