]> git.ipfire.org Git - thirdparty/git.git/blame - gitk
Merge branch 'master' into dev
[thirdparty/git.git] / gitk
CommitLineData
1db95b00
PM
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
9e026d39 3exec wish "$0" -- "$@"
1db95b00 4
e1a7c81f 5# Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
1db95b00
PM
6# This program is free software; it may be used, copied, modified
7# and distributed under the terms of the GNU General Public Licence,
8# either version 2, or (at your option) any later version.
9
73b6a6cb
JH
10proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
5024baa4 15 return [exec git rev-parse --git-dir]
73b6a6cb
JH
16 }
17}
18
7eb3cb9c
PM
19# A simple scheduler for compute-intensive stuff.
20# The aim is to make sure that event handlers for GUI actions can
21# run at least every 50-100 ms. Unfortunately fileevent handlers are
22# run before X event handlers, so reading from a fast source can
23# make the GUI completely unresponsive.
24proc run args {
25 global isonrunq runq
26
27 set script $args
28 if {[info exists isonrunq($script)]} return
29 if {$runq eq {}} {
30 after idle dorunq
31 }
32 lappend runq [list {} $script]
33 set isonrunq($script) 1
34}
35
36proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
38}
39
40proc filereadable {fd script} {
41 global runq
42
43 fileevent $fd readable {}
44 if {$runq eq {}} {
45 after idle dorunq
46 }
47 lappend runq [list $fd $script]
48}
49
7fcc92bf
PM
50proc nukefile {fd} {
51 global runq
52
53 for {set i 0} {$i < [llength $runq]} {} {
54 if {[lindex $runq $i 0] eq $fd} {
55 set runq [lreplace $runq $i $i]
56 } else {
57 incr i
58 }
59 }
60}
61
7eb3cb9c
PM
62proc dorunq {} {
63 global isonrunq runq
64
65 set tstart [clock clicks -milliseconds]
66 set t0 $tstart
7fcc92bf 67 while {[llength $runq] > 0} {
7eb3cb9c
PM
68 set fd [lindex $runq 0 0]
69 set script [lindex $runq 0 1]
70 set repeat [eval $script]
71 set t1 [clock clicks -milliseconds]
72 set t [expr {$t1 - $t0}]
73 set runq [lrange $runq 1 end]
74 if {$repeat ne {} && $repeat} {
75 if {$fd eq {} || $repeat == 2} {
76 # script returns 1 if it wants to be readded
77 # file readers return 2 if they could do more straight away
78 lappend runq [list $fd $script]
79 } else {
80 fileevent $fd readable [list filereadable $fd $script]
81 }
82 } elseif {$fd eq {}} {
83 unset isonrunq($script)
84 }
85 set t0 $t1
86 if {$t1 - $tstart >= 80} break
87 }
88 if {$runq ne {}} {
89 after idle dorunq
90 }
91}
92
93# Start off a git rev-list process and arrange to read its output
da7c24dd 94proc start_rev_list {view} {
7eb3cb9c 95 global startmsecs
9f1afe05 96 global commfd leftover tclencoding datemode
f5f3c2e2 97 global viewargs viewfiles commitidx viewcomplete vnextroot
3e6b893f 98 global showlocalchanges commitinterest mainheadid
bb3edc8b 99 global progressdirn progresscoords proglastnc curview
7fcc92bf 100 global viewincl viewactive loginstance viewinstances
9ccbdfbf 101
9ccbdfbf 102 set startmsecs [clock clicks -milliseconds]
da7c24dd 103 set commitidx($view) 0
f5f3c2e2 104 set viewcomplete($view) 0
7fcc92bf 105 set viewactive($view) 1
6e8c8707 106 set vnextroot($view) 0
7fcc92bf
PM
107 varcinit $view
108
f78e7ab7 109 set commits [eval exec git rev-parse --default HEAD --revs-only \
7fcc92bf
PM
110 $viewargs($view)]
111 set viewincl($view) {}
112 foreach c $commits {
113 if {![string match "^*" $c]} {
114 lappend viewincl($view) $c
115 }
9f1afe05 116 }
418c4c7b 117 if {[catch {
7fcc92bf
PM
118 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
119 --boundary $commits "--" $viewfiles($view)] r]
418c4c7b 120 } err]} {
00abadb9 121 error_popup "[mc "Error executing git log:"] $err"
1d10f36d
PM
122 exit 1
123 }
7fcc92bf
PM
124 set i [incr loginstance]
125 set viewinstances($view) [list $i]
126 set commfd($i) $fd
127 set leftover($i) {}
3e6b893f
PM
128 if {$showlocalchanges} {
129 lappend commitinterest($mainheadid) {dodiffindex}
130 }
86da5b6c 131 fconfigure $fd -blocking 0 -translation lf -eofchar {}
fd8ccbec 132 if {$tclencoding != {}} {
da7c24dd 133 fconfigure $fd -encoding $tclencoding
fd8ccbec 134 }
7fcc92bf 135 filerun $fd [list getcommitlines $fd $i $view]
d990cedf 136 nowbusy $view [mc "Reading"]
bb3edc8b
PM
137 if {$view == $curview} {
138 set progressdirn 1
139 set progresscoords {0 0}
140 set proglastnc 0
141 }
38ad0910
PM
142}
143
7fcc92bf
PM
144proc stop_rev_list {view} {
145 global commfd viewinstances leftover
22626ef4 146
7fcc92bf
PM
147 foreach inst $viewinstances($view) {
148 set fd $commfd($inst)
149 catch {
150 set pid [pid $fd]
151 exec kill $pid
152 }
153 catch {close $fd}
154 nukefile $fd
155 unset commfd($inst)
156 unset leftover($inst)
22626ef4 157 }
7fcc92bf 158 set viewinstances($view) {}
22626ef4
PM
159}
160
a8aaf19c 161proc getcommits {} {
7fcc92bf 162 global canv curview
38ad0910 163
da7c24dd
PM
164 initlayout
165 start_rev_list $curview
d990cedf 166 show_status [mc "Reading commits..."]
1d10f36d
PM
167}
168
7fcc92bf
PM
169proc updatecommits {} {
170 global curview viewargs viewfiles viewincl viewinstances
24f7a667
PM
171 global viewactive viewcomplete loginstance tclencoding mainheadid
172 global varcid startmsecs commfd showneartags showlocalchanges leftover
eb5f8c9c 173 global mainheadid
7fcc92bf 174
eb5f8c9c 175 set oldmainid $mainheadid
fc2a256f 176 rereadrefs
eb5f8c9c
PM
177 if {$showlocalchanges} {
178 if {$mainheadid ne $oldmainid} {
179 dohidelocalchanges
180 }
181 if {[commitinview $mainheadid $curview]} {
182 dodiffindex
183 }
184 }
7fcc92bf
PM
185 set view $curview
186 set commits [exec git rev-parse --default HEAD --revs-only \
187 $viewargs($view)]
188 set pos {}
189 set neg {}
190 foreach c $commits {
191 if {[string match "^*" $c]} {
192 lappend neg $c
193 } else {
194 if {!([info exists varcid($view,$c)] ||
195 [lsearch -exact $viewincl($view) $c] >= 0)} {
196 lappend pos $c
197 }
198 }
199 }
200 if {$pos eq {}} {
201 return
202 }
203 foreach id $viewincl($view) {
204 lappend neg "^$id"
205 }
206 set viewincl($view) [concat $viewincl($view) $pos]
207 if {[catch {
208 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
209 --boundary $pos $neg "--" $viewfiles($view)] r]
210 } err]} {
211 error_popup "Error executing git log: $err"
212 exit 1
213 }
214 if {$viewactive($view) == 0} {
215 set startmsecs [clock clicks -milliseconds]
216 }
217 set i [incr loginstance]
218 lappend viewinstances($view) $i
219 set commfd($i) $fd
220 set leftover($i) {}
221 fconfigure $fd -blocking 0 -translation lf -eofchar {}
222 if {$tclencoding != {}} {
223 fconfigure $fd -encoding $tclencoding
224 }
225 filerun $fd [list getcommitlines $fd $i $view]
226 incr viewactive($view)
227 set viewcomplete($view) 0
228 nowbusy $view "Reading"
7fcc92bf
PM
229 if {$showneartags} {
230 getallcommits
231 }
232}
233
234proc reloadcommits {} {
235 global curview viewcomplete selectedline currentid thickerline
236 global showneartags treediffs commitinterest cached_commitrow
42a671fc 237 global progresscoords targetid
7fcc92bf
PM
238
239 if {!$viewcomplete($curview)} {
240 stop_rev_list $curview
241 set progresscoords {0 0}
242 adjustprogress
243 }
244 resetvarcs $curview
245 catch {unset selectedline}
246 catch {unset currentid}
247 catch {unset thickerline}
248 catch {unset treediffs}
249 readrefs
250 changedrefs
251 if {$showneartags} {
252 getallcommits
253 }
254 clear_display
255 catch {unset commitinterest}
256 catch {unset cached_commitrow}
42a671fc 257 catch {unset targetid}
7fcc92bf
PM
258 setcanvscroll
259 getcommits
260}
261
6e8c8707
PM
262# This makes a string representation of a positive integer which
263# sorts as a string in numerical order
264proc strrep {n} {
265 if {$n < 16} {
266 return [format "%x" $n]
267 } elseif {$n < 256} {
268 return [format "x%.2x" $n]
269 } elseif {$n < 65536} {
270 return [format "y%.4x" $n]
271 }
272 return [format "z%.8x" $n]
273}
274
7fcc92bf
PM
275# Procedures used in reordering commits from git log (without
276# --topo-order) into the order for display.
277
278proc varcinit {view} {
f3ea5ede
PM
279 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
280 global vtokmod varcmod vrowmod varcix vlastins
7fcc92bf 281
7fcc92bf
PM
282 set varcstart($view) {{}}
283 set vupptr($view) {0}
284 set vdownptr($view) {0}
285 set vleftptr($view) {0}
f3ea5ede 286 set vbackptr($view) {0}
7fcc92bf
PM
287 set varctok($view) {{}}
288 set varcrow($view) {{}}
289 set vtokmod($view) {}
290 set varcmod($view) 0
e5b37ac1 291 set vrowmod($view) 0
7fcc92bf 292 set varcix($view) {{}}
f3ea5ede 293 set vlastins($view) {0}
7fcc92bf
PM
294}
295
296proc resetvarcs {view} {
297 global varcid varccommits parents children vseedcount ordertok
298
299 foreach vid [array names varcid $view,*] {
300 unset varcid($vid)
301 unset children($vid)
302 unset parents($vid)
303 }
304 # some commits might have children but haven't been seen yet
305 foreach vid [array names children $view,*] {
306 unset children($vid)
307 }
308 foreach va [array names varccommits $view,*] {
309 unset varccommits($va)
310 }
311 foreach vd [array names vseedcount $view,*] {
312 unset vseedcount($vd)
313 }
9257d8f7 314 catch {unset ordertok}
7fcc92bf
PM
315}
316
317proc newvarc {view id} {
f3ea5ede
PM
318 global varcid varctok parents children datemode
319 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
320 global commitdata commitinfo vseedcount varccommits vlastins
7fcc92bf
PM
321
322 set a [llength $varctok($view)]
323 set vid $view,$id
f3ea5ede 324 if {[llength $children($vid)] == 0 || $datemode} {
7fcc92bf
PM
325 if {![info exists commitinfo($id)]} {
326 parsecommit $id $commitdata($id) 1
327 }
328 set cdate [lindex $commitinfo($id) 4]
329 if {![string is integer -strict $cdate]} {
330 set cdate 0
331 }
332 if {![info exists vseedcount($view,$cdate)]} {
333 set vseedcount($view,$cdate) -1
334 }
335 set c [incr vseedcount($view,$cdate)]
336 set cdate [expr {$cdate ^ 0xffffffff}]
337 set tok "s[strrep $cdate][strrep $c]"
7fcc92bf
PM
338 } else {
339 set tok {}
f3ea5ede
PM
340 }
341 set ka 0
342 if {[llength $children($vid)] > 0} {
343 set kid [lindex $children($vid) end]
344 set k $varcid($view,$kid)
345 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
346 set ki $kid
347 set ka $k
348 set tok [lindex $varctok($view) $k]
7fcc92bf 349 }
f3ea5ede
PM
350 }
351 if {$ka != 0} {
7fcc92bf
PM
352 set i [lsearch -exact $parents($view,$ki) $id]
353 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
7fcc92bf
PM
354 append tok [strrep $j]
355 }
f3ea5ede
PM
356 set c [lindex $vlastins($view) $ka]
357 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
358 set c $ka
359 set b [lindex $vdownptr($view) $ka]
360 } else {
361 set b [lindex $vleftptr($view) $c]
362 }
363 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
364 set c $b
365 set b [lindex $vleftptr($view) $c]
366 }
367 if {$c == $ka} {
368 lset vdownptr($view) $ka $a
369 lappend vbackptr($view) 0
370 } else {
371 lset vleftptr($view) $c $a
372 lappend vbackptr($view) $c
373 }
374 lset vlastins($view) $ka $a
375 lappend vupptr($view) $ka
376 lappend vleftptr($view) $b
377 if {$b != 0} {
378 lset vbackptr($view) $b $a
379 }
7fcc92bf
PM
380 lappend varctok($view) $tok
381 lappend varcstart($view) $id
382 lappend vdownptr($view) 0
383 lappend varcrow($view) {}
384 lappend varcix($view) {}
e5b37ac1 385 set varccommits($view,$a) {}
f3ea5ede 386 lappend vlastins($view) 0
7fcc92bf
PM
387 return $a
388}
389
390proc splitvarc {p v} {
391 global varcid varcstart varccommits varctok
f3ea5ede 392 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
7fcc92bf
PM
393
394 set oa $varcid($v,$p)
395 set ac $varccommits($v,$oa)
396 set i [lsearch -exact $varccommits($v,$oa) $p]
397 if {$i <= 0} return
398 set na [llength $varctok($v)]
399 # "%" sorts before "0"...
400 set tok "[lindex $varctok($v) $oa]%[strrep $i]"
401 lappend varctok($v) $tok
402 lappend varcrow($v) {}
403 lappend varcix($v) {}
404 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
405 set varccommits($v,$na) [lrange $ac $i end]
406 lappend varcstart($v) $p
407 foreach id $varccommits($v,$na) {
408 set varcid($v,$id) $na
409 }
410 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
411 lset vdownptr($v) $oa $na
412 lappend vupptr($v) $oa
413 lappend vleftptr($v) 0
f3ea5ede
PM
414 lappend vbackptr($v) 0
415 lappend vlastins($v) 0
7fcc92bf
PM
416 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
417 lset vupptr($v) $b $na
418 }
419}
420
421proc renumbervarc {a v} {
422 global parents children varctok varcstart varccommits
f3ea5ede 423 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod datemode
7fcc92bf
PM
424
425 set t1 [clock clicks -milliseconds]
426 set todo {}
427 set isrelated($a) 1
f3ea5ede 428 set kidchanged($a) 1
7fcc92bf
PM
429 set ntot 0
430 while {$a != 0} {
431 if {[info exists isrelated($a)]} {
432 lappend todo $a
433 set id [lindex $varccommits($v,$a) end]
434 foreach p $parents($v,$id) {
435 if {[info exists varcid($v,$p)]} {
436 set isrelated($varcid($v,$p)) 1
437 }
438 }
439 }
440 incr ntot
441 set b [lindex $vdownptr($v) $a]
442 if {$b == 0} {
443 while {$a != 0} {
444 set b [lindex $vleftptr($v) $a]
445 if {$b != 0} break
446 set a [lindex $vupptr($v) $a]
447 }
448 }
449 set a $b
450 }
451 foreach a $todo {
f3ea5ede 452 if {![info exists kidchanged($a)]} continue
7fcc92bf 453 set id [lindex $varcstart($v) $a]
f3ea5ede
PM
454 if {[llength $children($v,$id)] > 1} {
455 set children($v,$id) [lsort -command [list vtokcmp $v] \
456 $children($v,$id)]
457 }
458 set oldtok [lindex $varctok($v) $a]
459 if {!$datemode} {
460 set tok {}
461 } else {
462 set tok $oldtok
463 }
464 set ka 0
c8c9f3d9
PM
465 set kid [last_real_child $v,$id]
466 if {$kid ne {}} {
f3ea5ede
PM
467 set k $varcid($v,$kid)
468 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
469 set ki $kid
470 set ka $k
471 set tok [lindex $varctok($v) $k]
7fcc92bf
PM
472 }
473 }
f3ea5ede 474 if {$ka != 0} {
7fcc92bf
PM
475 set i [lsearch -exact $parents($v,$ki) $id]
476 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
477 append tok [strrep $j]
7fcc92bf 478 }
f3ea5ede
PM
479 if {$tok eq $oldtok} {
480 continue
481 }
482 set id [lindex $varccommits($v,$a) end]
483 foreach p $parents($v,$id) {
484 if {[info exists varcid($v,$p)]} {
485 set kidchanged($varcid($v,$p)) 1
486 } else {
487 set sortkids($p) 1
488 }
489 }
490 lset varctok($v) $a $tok
7fcc92bf
PM
491 set b [lindex $vupptr($v) $a]
492 if {$b != $ka} {
9257d8f7
PM
493 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
494 modify_arc $v $ka
38dfe939 495 }
9257d8f7
PM
496 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
497 modify_arc $v $b
38dfe939 498 }
f3ea5ede
PM
499 set c [lindex $vbackptr($v) $a]
500 set d [lindex $vleftptr($v) $a]
501 if {$c == 0} {
502 lset vdownptr($v) $b $d
7fcc92bf 503 } else {
f3ea5ede
PM
504 lset vleftptr($v) $c $d
505 }
506 if {$d != 0} {
507 lset vbackptr($v) $d $c
7fcc92bf
PM
508 }
509 lset vupptr($v) $a $ka
f3ea5ede
PM
510 set c [lindex $vlastins($v) $ka]
511 if {$c == 0 || \
512 [string compare $tok [lindex $varctok($v) $c]] < 0} {
513 set c $ka
514 set b [lindex $vdownptr($v) $ka]
515 } else {
516 set b [lindex $vleftptr($v) $c]
517 }
518 while {$b != 0 && \
519 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
520 set c $b
521 set b [lindex $vleftptr($v) $c]
7fcc92bf 522 }
f3ea5ede
PM
523 if {$c == $ka} {
524 lset vdownptr($v) $ka $a
525 lset vbackptr($v) $a 0
526 } else {
527 lset vleftptr($v) $c $a
528 lset vbackptr($v) $a $c
7fcc92bf 529 }
f3ea5ede
PM
530 lset vleftptr($v) $a $b
531 if {$b != 0} {
532 lset vbackptr($v) $b $a
533 }
534 lset vlastins($v) $ka $a
535 }
536 }
537 foreach id [array names sortkids] {
538 if {[llength $children($v,$id)] > 1} {
539 set children($v,$id) [lsort -command [list vtokcmp $v] \
540 $children($v,$id)]
7fcc92bf
PM
541 }
542 }
543 set t2 [clock clicks -milliseconds]
544 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
545}
546
547proc fix_reversal {p a v} {
24f7a667 548 global varcid varcstart varctok vupptr
7fcc92bf
PM
549
550 set pa $varcid($v,$p)
551 if {$p ne [lindex $varcstart($v) $pa]} {
552 splitvarc $p $v
553 set pa $varcid($v,$p)
554 }
24f7a667
PM
555 # seeds always need to be renumbered
556 if {[lindex $vupptr($v) $pa] == 0 ||
557 [string compare [lindex $varctok($v) $a] \
558 [lindex $varctok($v) $pa]] > 0} {
7fcc92bf
PM
559 renumbervarc $pa $v
560 }
561}
562
563proc insertrow {id p v} {
9257d8f7 564 global varcid varccommits parents children cmitlisted
42a671fc 565 global commitidx varctok vtokmod targetid targetrow
7fcc92bf
PM
566
567 set a $varcid($v,$p)
568 set i [lsearch -exact $varccommits($v,$a) $p]
569 if {$i < 0} {
570 puts "oops: insertrow can't find [shortids $p] on arc $a"
571 return
572 }
573 set children($v,$id) {}
574 set parents($v,$id) [list $p]
575 set varcid($v,$id) $a
9257d8f7 576 lappend children($v,$p) $id
7fcc92bf
PM
577 set cmitlisted($v,$id) 1
578 incr commitidx($v)
7fcc92bf
PM
579 # note we deliberately don't update varcstart($v) even if $i == 0
580 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
9257d8f7 581 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
e5b37ac1 582 modify_arc $v $a $i
7fcc92bf 583 }
42a671fc
PM
584 if {[info exists targetid]} {
585 if {![comes_before $targetid $p]} {
586 incr targetrow
587 }
588 }
9257d8f7 589 drawvisible
7fcc92bf
PM
590}
591
592proc removerow {id v} {
9257d8f7 593 global varcid varccommits parents children commitidx
fc2a256f 594 global varctok vtokmod cmitlisted currentid selectedline
42a671fc 595 global targetid
7fcc92bf
PM
596
597 if {[llength $parents($v,$id)] != 1} {
598 puts "oops: removerow [shortids $id] has [llength $parents($v,$id)] parents"
599 return
600 }
601 set p [lindex $parents($v,$id) 0]
602 set a $varcid($v,$id)
603 set i [lsearch -exact $varccommits($v,$a) $id]
604 if {$i < 0} {
605 puts "oops: removerow can't find [shortids $id] on arc $a"
606 return
607 }
608 unset varcid($v,$id)
609 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
610 unset parents($v,$id)
611 unset children($v,$id)
612 unset cmitlisted($v,$id)
7fcc92bf
PM
613 incr commitidx($v) -1
614 set j [lsearch -exact $children($v,$p) $id]
615 if {$j >= 0} {
616 set children($v,$p) [lreplace $children($v,$p) $j $j]
617 }
9257d8f7 618 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
e5b37ac1 619 modify_arc $v $a $i
7fcc92bf 620 }
fc2a256f
PM
621 if {[info exist currentid] && $id eq $currentid} {
622 unset currentid
623 unset selectedline
624 }
42a671fc
PM
625 if {[info exists targetid] && $targetid eq $id} {
626 set targetid $p
627 }
9257d8f7 628 drawvisible
7fcc92bf
PM
629}
630
c8c9f3d9
PM
631proc first_real_child {vp} {
632 global children nullid nullid2
633
634 foreach id $children($vp) {
635 if {$id ne $nullid && $id ne $nullid2} {
636 return $id
637 }
638 }
639 return {}
640}
641
642proc last_real_child {vp} {
643 global children nullid nullid2
644
645 set kids $children($vp)
646 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
647 set id [lindex $kids $i]
648 if {$id ne $nullid && $id ne $nullid2} {
649 return $id
650 }
651 }
652 return {}
653}
654
7fcc92bf
PM
655proc vtokcmp {v a b} {
656 global varctok varcid
657
658 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
659 [lindex $varctok($v) $varcid($v,$b)]]
660}
661
e5b37ac1
PM
662proc modify_arc {v a {lim {}}} {
663 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
24f7a667 664 global vhighlights nhighlights fhighlights rhighlights
9257d8f7
PM
665
666 set vtokmod($v) [lindex $varctok($v) $a]
667 set varcmod($v) $a
668 if {$v == $curview} {
669 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
670 set a [lindex $vupptr($v) $a]
e5b37ac1 671 set lim {}
9257d8f7 672 }
e5b37ac1
PM
673 set r 0
674 if {$a != 0} {
675 if {$lim eq {}} {
676 set lim [llength $varccommits($v,$a)]
677 }
678 set r [expr {[lindex $varcrow($v) $a] + $lim}]
679 }
680 set vrowmod($v) $r
0c27886e 681 undolayout $r
9257d8f7 682 }
24f7a667
PM
683 catch {unset nhighlights}
684 catch {unset fhighlights}
685 catch {unset vhighlights}
686 catch {unset rhighlights}
9257d8f7
PM
687}
688
7fcc92bf 689proc update_arcrows {v} {
e5b37ac1 690 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
24f7a667 691 global varcid vrownum varcorder varcix varccommits
7fcc92bf 692 global vupptr vdownptr vleftptr varctok
24f7a667 693 global displayorder parentlist curview cached_commitrow
7fcc92bf 694
7fcc92bf
PM
695 set narctot [expr {[llength $varctok($v)] - 1}]
696 set a $varcmod($v)
697 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
698 # go up the tree until we find something that has a row number,
699 # or we get to a seed
700 set a [lindex $vupptr($v) $a]
701 }
702 if {$a == 0} {
703 set a [lindex $vdownptr($v) 0]
704 if {$a == 0} return
705 set vrownum($v) {0}
706 set varcorder($v) [list $a]
707 lset varcix($v) $a 0
708 lset varcrow($v) $a 0
709 set arcn 0
710 set row 0
711 } else {
712 set arcn [lindex $varcix($v) $a]
713 # see if a is the last arc; if so, nothing to do
714 if {$arcn == $narctot - 1} {
715 return
716 }
717 if {[llength $vrownum($v)] > $arcn + 1} {
718 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
719 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
720 }
721 set row [lindex $varcrow($v) $a]
722 }
7fcc92bf 723 if {$v == $curview} {
e5b37ac1
PM
724 if {[llength $displayorder] > $vrowmod($v)} {
725 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
726 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
727 }
7fcc92bf
PM
728 catch {unset cached_commitrow}
729 }
7fcc92bf
PM
730 while {1} {
731 set p $a
732 incr row [llength $varccommits($v,$a)]
733 # go down if possible
734 set b [lindex $vdownptr($v) $a]
735 if {$b == 0} {
736 # if not, go left, or go up until we can go left
737 while {$a != 0} {
738 set b [lindex $vleftptr($v) $a]
739 if {$b != 0} break
740 set a [lindex $vupptr($v) $a]
741 }
742 if {$a == 0} break
743 }
744 set a $b
745 incr arcn
746 lappend vrownum($v) $row
747 lappend varcorder($v) $a
748 lset varcix($v) $a $arcn
749 lset varcrow($v) $a $row
750 }
e5b37ac1
PM
751 set vtokmod($v) [lindex $varctok($v) $p]
752 set varcmod($v) $p
753 set vrowmod($v) $row
7fcc92bf
PM
754 if {[info exists currentid]} {
755 set selectedline [rowofcommit $currentid]
756 }
7fcc92bf
PM
757}
758
759# Test whether view $v contains commit $id
760proc commitinview {id v} {
761 global varcid
762
763 return [info exists varcid($v,$id)]
764}
765
766# Return the row number for commit $id in the current view
767proc rowofcommit {id} {
768 global varcid varccommits varcrow curview cached_commitrow
9257d8f7 769 global varctok vtokmod
7fcc92bf 770
7fcc92bf
PM
771 set v $curview
772 if {![info exists varcid($v,$id)]} {
773 puts "oops rowofcommit no arc for [shortids $id]"
774 return {}
775 }
776 set a $varcid($v,$id)
fc2a256f 777 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
9257d8f7
PM
778 update_arcrows $v
779 }
31c0eaa8
PM
780 if {[info exists cached_commitrow($id)]} {
781 return $cached_commitrow($id)
782 }
7fcc92bf
PM
783 set i [lsearch -exact $varccommits($v,$a) $id]
784 if {$i < 0} {
785 puts "oops didn't find commit [shortids $id] in arc $a"
786 return {}
787 }
788 incr i [lindex $varcrow($v) $a]
789 set cached_commitrow($id) $i
790 return $i
791}
792
42a671fc
PM
793# Returns 1 if a is on an earlier row than b, otherwise 0
794proc comes_before {a b} {
795 global varcid varctok curview
796
797 set v $curview
798 if {$a eq $b || ![info exists varcid($v,$a)] || \
799 ![info exists varcid($v,$b)]} {
800 return 0
801 }
802 if {$varcid($v,$a) != $varcid($v,$b)} {
803 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
804 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
805 }
806 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
807}
808
7fcc92bf
PM
809proc bsearch {l elt} {
810 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
811 return 0
812 }
813 set lo 0
814 set hi [llength $l]
815 while {$hi - $lo > 1} {
816 set mid [expr {int(($lo + $hi) / 2)}]
817 set t [lindex $l $mid]
818 if {$elt < $t} {
819 set hi $mid
820 } elseif {$elt > $t} {
821 set lo $mid
822 } else {
823 return $mid
824 }
825 }
826 return $lo
827}
828
829# Make sure rows $start..$end-1 are valid in displayorder and parentlist
830proc make_disporder {start end} {
831 global vrownum curview commitidx displayorder parentlist
e5b37ac1 832 global varccommits varcorder parents vrowmod varcrow
7fcc92bf
PM
833 global d_valid_start d_valid_end
834
e5b37ac1 835 if {$end > $vrowmod($curview)} {
9257d8f7
PM
836 update_arcrows $curview
837 }
7fcc92bf
PM
838 set ai [bsearch $vrownum($curview) $start]
839 set start [lindex $vrownum($curview) $ai]
840 set narc [llength $vrownum($curview)]
841 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
842 set a [lindex $varcorder($curview) $ai]
843 set l [llength $displayorder]
844 set al [llength $varccommits($curview,$a)]
845 if {$l < $r + $al} {
846 if {$l < $r} {
847 set pad [ntimes [expr {$r - $l}] {}]
848 set displayorder [concat $displayorder $pad]
849 set parentlist [concat $parentlist $pad]
850 } elseif {$l > $r} {
851 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
852 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
853 }
854 foreach id $varccommits($curview,$a) {
855 lappend displayorder $id
856 lappend parentlist $parents($curview,$id)
857 }
858 } elseif {[lindex $displayorder $r] eq {}} {
859 set i $r
860 foreach id $varccommits($curview,$a) {
861 lset displayorder $i $id
862 lset parentlist $i $parents($curview,$id)
863 incr i
864 }
865 }
866 incr r $al
867 }
868}
869
870proc commitonrow {row} {
871 global displayorder
872
873 set id [lindex $displayorder $row]
874 if {$id eq {}} {
875 make_disporder $row [expr {$row + 1}]
876 set id [lindex $displayorder $row]
877 }
878 return $id
879}
880
881proc closevarcs {v} {
882 global varctok varccommits varcid parents children
9257d8f7 883 global cmitlisted commitidx commitinterest vtokmod
7fcc92bf
PM
884
885 set missing_parents 0
886 set scripts {}
887 set narcs [llength $varctok($v)]
888 for {set a 1} {$a < $narcs} {incr a} {
889 set id [lindex $varccommits($v,$a) end]
890 foreach p $parents($v,$id) {
891 if {[info exists varcid($v,$p)]} continue
892 # add p as a new commit
893 incr missing_parents
894 set cmitlisted($v,$p) 0
895 set parents($v,$p) {}
896 if {[llength $children($v,$p)] == 1 &&
897 [llength $parents($v,$id)] == 1} {
898 set b $a
899 } else {
900 set b [newvarc $v $p]
901 }
902 set varcid($v,$p) $b
9257d8f7
PM
903 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
904 modify_arc $v $b
7fcc92bf 905 }
e5b37ac1 906 lappend varccommits($v,$b) $p
7fcc92bf
PM
907 incr commitidx($v)
908 if {[info exists commitinterest($p)]} {
909 foreach script $commitinterest($p) {
910 lappend scripts [string map [list "%I" $p] $script]
911 }
912 unset commitinterest($id)
913 }
914 }
915 }
916 if {$missing_parents > 0} {
7fcc92bf
PM
917 foreach s $scripts {
918 eval $s
919 }
920 }
921}
922
923proc getcommitlines {fd inst view} {
24f7a667 924 global cmitlisted commitinterest leftover
f3ea5ede 925 global commitidx commitdata datemode
7fcc92bf 926 global parents children curview hlview
9257d8f7
PM
927 global vnextroot idpending ordertok
928 global varccommits varcid varctok vtokmod
9ccbdfbf 929
d1e46756 930 set stuff [read $fd 500000]
005a2f4e 931 # git log doesn't terminate the last commit with a null...
7fcc92bf 932 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
005a2f4e
PM
933 set stuff "\0"
934 }
b490a991 935 if {$stuff == {}} {
7eb3cb9c
PM
936 if {![eof $fd]} {
937 return 1
938 }
7fcc92bf
PM
939 global commfd viewcomplete viewactive viewname progresscoords
940 global viewinstances
941 unset commfd($inst)
942 set i [lsearch -exact $viewinstances($view) $inst]
943 if {$i >= 0} {
944 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
b0cdca99 945 }
f0654861 946 # set it blocking so we wait for the process to terminate
da7c24dd 947 fconfigure $fd -blocking 1
098dd8a3
PM
948 if {[catch {close $fd} err]} {
949 set fv {}
950 if {$view != $curview} {
951 set fv " for the \"$viewname($view)\" view"
da7c24dd 952 }
098dd8a3
PM
953 if {[string range $err 0 4] == "usage"} {
954 set err "Gitk: error reading commits$fv:\
8974c6f9 955 bad arguments to git rev-list."
098dd8a3
PM
956 if {$viewname($view) eq "Command line"} {
957 append err \
8974c6f9 958 " (Note: arguments to gitk are passed to git rev-list\
098dd8a3
PM
959 to allow selection of commits to be displayed.)"
960 }
961 } else {
962 set err "Error reading commits$fv: $err"
963 }
964 error_popup $err
1d10f36d 965 }
7fcc92bf
PM
966 if {[incr viewactive($view) -1] <= 0} {
967 set viewcomplete($view) 1
968 # Check if we have seen any ids listed as parents that haven't
969 # appeared in the list
970 closevarcs $view
971 notbusy $view
972 set progresscoords {0 0}
973 adjustprogress
974 }
098dd8a3 975 if {$view == $curview} {
7eb3cb9c 976 run chewcommits $view
9a40c50c 977 }
7eb3cb9c 978 return 0
9a40c50c 979 }
b490a991 980 set start 0
8f7d0cec 981 set gotsome 0
7fcc92bf 982 set scripts {}
b490a991
PM
983 while 1 {
984 set i [string first "\0" $stuff $start]
985 if {$i < 0} {
7fcc92bf 986 append leftover($inst) [string range $stuff $start end]
9f1afe05 987 break
9ccbdfbf 988 }
b490a991 989 if {$start == 0} {
7fcc92bf 990 set cmit $leftover($inst)
8f7d0cec 991 append cmit [string range $stuff 0 [expr {$i - 1}]]
7fcc92bf 992 set leftover($inst) {}
8f7d0cec
PM
993 } else {
994 set cmit [string range $stuff $start [expr {$i - 1}]]
b490a991
PM
995 }
996 set start [expr {$i + 1}]
e5ea701b
PM
997 set j [string first "\n" $cmit]
998 set ok 0
16c1ff96 999 set listed 1
c961b228
PM
1000 if {$j >= 0 && [string match "commit *" $cmit]} {
1001 set ids [string range $cmit 7 [expr {$j - 1}]]
1002 if {[string match {[-<>]*} $ids]} {
1003 switch -- [string index $ids 0] {
1004 "-" {set listed 0}
1005 "<" {set listed 2}
1006 ">" {set listed 3}
1007 }
16c1ff96
PM
1008 set ids [string range $ids 1 end]
1009 }
e5ea701b
PM
1010 set ok 1
1011 foreach id $ids {
8f7d0cec 1012 if {[string length $id] != 40} {
e5ea701b
PM
1013 set ok 0
1014 break
1015 }
1016 }
1017 }
1018 if {!$ok} {
7e952e79
PM
1019 set shortcmit $cmit
1020 if {[string length $shortcmit] > 80} {
1021 set shortcmit "[string range $shortcmit 0 80]..."
1022 }
d990cedf 1023 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
b490a991
PM
1024 exit 1
1025 }
e5ea701b 1026 set id [lindex $ids 0]
7fcc92bf
PM
1027 set vid $view,$id
1028 if {!$listed && [info exists parents($vid)]} continue
16c1ff96
PM
1029 if {$listed} {
1030 set olds [lrange $ids 1 end]
16c1ff96
PM
1031 } else {
1032 set olds {}
1033 }
f7a3e8d2 1034 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
7fcc92bf
PM
1035 set cmitlisted($vid) $listed
1036 set parents($vid) $olds
1037 set a 0
1038 if {![info exists children($vid)]} {
1039 set children($vid) {}
f3ea5ede
PM
1040 } elseif {[llength $children($vid)] == 1} {
1041 set k [lindex $children($vid) 0]
1042 if {[llength $parents($view,$k)] == 1 &&
1043 (!$datemode ||
1044 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1045 set a $varcid($view,$k)
7fcc92bf 1046 }
da7c24dd 1047 }
7fcc92bf
PM
1048 if {$a == 0} {
1049 # new arc
1050 set a [newvarc $view $id]
1051 }
1052 set varcid($vid) $a
e5b37ac1
PM
1053 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1054 modify_arc $view $a
1055 }
7fcc92bf 1056 lappend varccommits($view,$a) $id
e5b37ac1 1057
7fcc92bf
PM
1058 set i 0
1059 foreach p $olds {
1060 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1061 set vp $view,$p
1062 if {[llength [lappend children($vp) $id]] > 1 &&
1063 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1064 set children($vp) [lsort -command [list vtokcmp $view] \
1065 $children($vp)]
9257d8f7 1066 catch {unset ordertok}
7fcc92bf 1067 }
f3ea5ede
PM
1068 if {[info exists varcid($view,$p)]} {
1069 fix_reversal $p $a $view
1070 }
7fcc92bf
PM
1071 }
1072 incr i
1073 }
7fcc92bf
PM
1074
1075 incr commitidx($view)
3e6b893f
PM
1076 if {[info exists commitinterest($id)]} {
1077 foreach script $commitinterest($id) {
7fcc92bf 1078 lappend scripts [string map [list "%I" $id] $script]
3e6b893f
PM
1079 }
1080 unset commitinterest($id)
1081 }
8f7d0cec
PM
1082 set gotsome 1
1083 }
1084 if {$gotsome} {
7eb3cb9c 1085 run chewcommits $view
7fcc92bf
PM
1086 foreach s $scripts {
1087 eval $s
1088 }
bb3edc8b
PM
1089 if {$view == $curview} {
1090 # update progress bar
1091 global progressdirn progresscoords proglastnc
1092 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
1093 set proglastnc $commitidx($view)
1094 set l [lindex $progresscoords 0]
1095 set r [lindex $progresscoords 1]
1096 if {$progressdirn} {
1097 set r [expr {$r + $inc}]
1098 if {$r >= 1.0} {
1099 set r 1.0
1100 set progressdirn 0
1101 }
1102 if {$r > 0.2} {
1103 set l [expr {$r - 0.2}]
1104 }
1105 } else {
1106 set l [expr {$l - $inc}]
1107 if {$l <= 0.0} {
1108 set l 0.0
1109 set progressdirn 1
1110 }
1111 set r [expr {$l + 0.2}]
1112 }
1113 set progresscoords [list $l $r]
1114 adjustprogress
1115 }
9ccbdfbf 1116 }
7eb3cb9c 1117 return 2
9ccbdfbf
PM
1118}
1119
7eb3cb9c 1120proc chewcommits {view} {
f5f3c2e2 1121 global curview hlview viewcomplete
7fcc92bf 1122 global pending_select
7eb3cb9c 1123
7eb3cb9c 1124 if {$view == $curview} {
f5f3c2e2
PM
1125 layoutmore
1126 if {$viewcomplete($view)} {
f3ea5ede 1127 global commitidx varctok
7eb3cb9c 1128 global numcommits startmsecs
7fcc92bf 1129 global mainheadid commitinfo nullid
9ccbdfbf 1130
7eb3cb9c 1131 if {[info exists pending_select]} {
8f489363 1132 set row [first_real_row]
7eb3cb9c
PM
1133 selectline $row 1
1134 }
1135 if {$commitidx($curview) > 0} {
1136 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1137 #puts "overall $ms ms for $numcommits commits"
f3ea5ede 1138 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
7eb3cb9c 1139 } else {
d990cedf 1140 show_status [mc "No commits selected"]
7eb3cb9c
PM
1141 }
1142 notbusy layout
7eb3cb9c 1143 }
b664550c 1144 }
7eb3cb9c
PM
1145 if {[info exists hlview] && $view == $hlview} {
1146 vhighlightmore
b664550c 1147 }
f5f3c2e2 1148 return 0
1db95b00
PM
1149}
1150
1151proc readcommit {id} {
8974c6f9 1152 if {[catch {set contents [exec git cat-file commit $id]}]} return
8f7d0cec 1153 parsecommit $id $contents 0
b490a991
PM
1154}
1155
8f7d0cec 1156proc parsecommit {id contents listed} {
b5c2f306
SV
1157 global commitinfo cdate
1158
1159 set inhdr 1
1160 set comment {}
1161 set headline {}
1162 set auname {}
1163 set audate {}
1164 set comname {}
1165 set comdate {}
232475d3
PM
1166 set hdrend [string first "\n\n" $contents]
1167 if {$hdrend < 0} {
1168 # should never happen...
1169 set hdrend [string length $contents]
1170 }
1171 set header [string range $contents 0 [expr {$hdrend - 1}]]
1172 set comment [string range $contents [expr {$hdrend + 2}] end]
1173 foreach line [split $header "\n"] {
1174 set tag [lindex $line 0]
1175 if {$tag == "author"} {
1176 set audate [lindex $line end-1]
1177 set auname [lrange $line 1 end-2]
1178 } elseif {$tag == "committer"} {
1179 set comdate [lindex $line end-1]
1180 set comname [lrange $line 1 end-2]
1db95b00
PM
1181 }
1182 }
232475d3 1183 set headline {}
43c25074
PM
1184 # take the first non-blank line of the comment as the headline
1185 set headline [string trimleft $comment]
1186 set i [string first "\n" $headline]
232475d3 1187 if {$i >= 0} {
43c25074
PM
1188 set headline [string range $headline 0 $i]
1189 }
1190 set headline [string trimright $headline]
1191 set i [string first "\r" $headline]
1192 if {$i >= 0} {
1193 set headline [string trimright [string range $headline 0 $i]]
232475d3
PM
1194 }
1195 if {!$listed} {
8974c6f9
TH
1196 # git rev-list indents the comment by 4 spaces;
1197 # if we got this via git cat-file, add the indentation
232475d3
PM
1198 set newcomment {}
1199 foreach line [split $comment "\n"] {
1200 append newcomment " "
1201 append newcomment $line
f6e2869f 1202 append newcomment "\n"
232475d3
PM
1203 }
1204 set comment $newcomment
1db95b00
PM
1205 }
1206 if {$comdate != {}} {
cfb4563c 1207 set cdate($id) $comdate
1db95b00 1208 }
e5c2d856
PM
1209 set commitinfo($id) [list $headline $auname $audate \
1210 $comname $comdate $comment]
1db95b00
PM
1211}
1212
f7a3e8d2 1213proc getcommit {id} {
79b2c75e 1214 global commitdata commitinfo
8ed16484 1215
f7a3e8d2
PM
1216 if {[info exists commitdata($id)]} {
1217 parsecommit $id $commitdata($id) 1
8ed16484
PM
1218 } else {
1219 readcommit $id
1220 if {![info exists commitinfo($id)]} {
d990cedf 1221 set commitinfo($id) [list [mc "No commit information available"]]
8ed16484
PM
1222 }
1223 }
1224 return 1
1225}
1226
887fe3c4 1227proc readrefs {} {
62d3ea65 1228 global tagids idtags headids idheads tagobjid
219ea3a9 1229 global otherrefids idotherrefs mainhead mainheadid
106288cb 1230
b5c2f306
SV
1231 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1232 catch {unset $v}
1233 }
62d3ea65
PM
1234 set refd [open [list | git show-ref -d] r]
1235 while {[gets $refd line] >= 0} {
1236 if {[string index $line 40] ne " "} continue
1237 set id [string range $line 0 39]
1238 set ref [string range $line 41 end]
1239 if {![string match "refs/*" $ref]} continue
1240 set name [string range $ref 5 end]
1241 if {[string match "remotes/*" $name]} {
1242 if {![string match "*/HEAD" $name]} {
1243 set headids($name) $id
1244 lappend idheads($id) $name
f1d83ba3 1245 }
62d3ea65
PM
1246 } elseif {[string match "heads/*" $name]} {
1247 set name [string range $name 6 end]
36a7cad6
JH
1248 set headids($name) $id
1249 lappend idheads($id) $name
62d3ea65
PM
1250 } elseif {[string match "tags/*" $name]} {
1251 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1252 # which is what we want since the former is the commit ID
1253 set name [string range $name 5 end]
1254 if {[string match "*^{}" $name]} {
1255 set name [string range $name 0 end-3]
1256 } else {
1257 set tagobjid($name) $id
1258 }
1259 set tagids($name) $id
1260 lappend idtags($id) $name
36a7cad6
JH
1261 } else {
1262 set otherrefids($name) $id
1263 lappend idotherrefs($id) $name
f1d83ba3
PM
1264 }
1265 }
062d671f 1266 catch {close $refd}
8a48571c 1267 set mainhead {}
219ea3a9 1268 set mainheadid {}
8a48571c
PM
1269 catch {
1270 set thehead [exec git symbolic-ref HEAD]
1271 if {[string match "refs/heads/*" $thehead]} {
1272 set mainhead [string range $thehead 11 end]
219ea3a9
PM
1273 if {[info exists headids($mainhead)]} {
1274 set mainheadid $headids($mainhead)
1275 }
8a48571c
PM
1276 }
1277 }
887fe3c4
PM
1278}
1279
8f489363
PM
1280# skip over fake commits
1281proc first_real_row {} {
7fcc92bf 1282 global nullid nullid2 numcommits
8f489363
PM
1283
1284 for {set row 0} {$row < $numcommits} {incr row} {
7fcc92bf 1285 set id [commitonrow $row]
8f489363
PM
1286 if {$id ne $nullid && $id ne $nullid2} {
1287 break
1288 }
1289 }
1290 return $row
1291}
1292
e11f1233
PM
1293# update things for a head moved to a child of its previous location
1294proc movehead {id name} {
1295 global headids idheads
1296
1297 removehead $headids($name) $name
1298 set headids($name) $id
1299 lappend idheads($id) $name
1300}
1301
1302# update things when a head has been removed
1303proc removehead {id name} {
1304 global headids idheads
1305
1306 if {$idheads($id) eq $name} {
1307 unset idheads($id)
1308 } else {
1309 set i [lsearch -exact $idheads($id) $name]
1310 if {$i >= 0} {
1311 set idheads($id) [lreplace $idheads($id) $i $i]
1312 }
1313 }
1314 unset headids($name)
1315}
1316
e54be9e3 1317proc show_error {w top msg} {
df3d83b1
PM
1318 message $w.m -text $msg -justify center -aspect 400
1319 pack $w.m -side top -fill x -padx 20 -pady 20
d990cedf 1320 button $w.ok -text [mc OK] -command "destroy $top"
df3d83b1 1321 pack $w.ok -side bottom -fill x
e54be9e3
PM
1322 bind $top <Visibility> "grab $top; focus $top"
1323 bind $top <Key-Return> "destroy $top"
1324 tkwait window $top
df3d83b1
PM
1325}
1326
098dd8a3
PM
1327proc error_popup msg {
1328 set w .error
1329 toplevel $w
1330 wm transient $w .
e54be9e3 1331 show_error $w $w $msg
098dd8a3
PM
1332}
1333
10299152
PM
1334proc confirm_popup msg {
1335 global confirm_ok
1336 set confirm_ok 0
1337 set w .confirm
1338 toplevel $w
1339 wm transient $w .
1340 message $w.m -text $msg -justify center -aspect 400
1341 pack $w.m -side top -fill x -padx 20 -pady 20
d990cedf 1342 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
10299152 1343 pack $w.ok -side left -fill x
d990cedf 1344 button $w.cancel -text [mc Cancel] -command "destroy $w"
10299152
PM
1345 pack $w.cancel -side right -fill x
1346 bind $w <Visibility> "grab $w; focus $w"
1347 tkwait window $w
1348 return $confirm_ok
1349}
1350
b039f0a6
PM
1351proc setoptions {} {
1352 option add *Panedwindow.showHandle 1 startupFile
1353 option add *Panedwindow.sashRelief raised startupFile
1354 option add *Button.font uifont startupFile
1355 option add *Checkbutton.font uifont startupFile
1356 option add *Radiobutton.font uifont startupFile
1357 option add *Menu.font uifont startupFile
1358 option add *Menubutton.font uifont startupFile
1359 option add *Label.font uifont startupFile
1360 option add *Message.font uifont startupFile
1361 option add *Entry.font uifont startupFile
1362}
1363
d94f8cd6 1364proc makewindow {} {
31c0eaa8 1365 global canv canv2 canv3 linespc charspc ctext cflist cscroll
9c311b32 1366 global tabstop
b74fd579 1367 global findtype findtypemenu findloc findstring fstring geometry
887fe3c4 1368 global entries sha1entry sha1string sha1but
890fae70 1369 global diffcontextstring diffcontext
94a2eede 1370 global maincursor textcursor curtextcursor
219ea3a9 1371 global rowctxmenu fakerowmenu mergemax wrapcomment
60f7a7dc 1372 global highlight_files gdttype
3ea06f9f 1373 global searchstring sstring
60378c0c 1374 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
bb3edc8b
PM
1375 global headctxmenu progresscanv progressitem progresscoords statusw
1376 global fprogitem fprogcoord lastprogupdate progupdatepending
a137a90f 1377 global rprogitem rprogcoord
32f1b3e4 1378 global have_tk85
9a40c50c
PM
1379
1380 menu .bar
d990cedf 1381 .bar add cascade -label [mc "File"] -menu .bar.file
9a40c50c 1382 menu .bar.file
d990cedf 1383 .bar.file add command -label [mc "Update"] -command updatecommits
00abadb9 1384 .bar.file add command -label [mc "Reload"] -command reloadcommits
d990cedf
CS
1385 .bar.file add command -label [mc "Reread references"] -command rereadrefs
1386 .bar.file add command -label [mc "List references"] -command showrefs
1387 .bar.file add command -label [mc "Quit"] -command doquit
712fcc08 1388 menu .bar.edit
d990cedf
CS
1389 .bar add cascade -label [mc "Edit"] -menu .bar.edit
1390 .bar.edit add command -label [mc "Preferences"] -command doprefs
da7c24dd 1391
b039f0a6 1392 menu .bar.view
d990cedf
CS
1393 .bar add cascade -label [mc "View"] -menu .bar.view
1394 .bar.view add command -label [mc "New view..."] -command {newview 0}
1395 .bar.view add command -label [mc "Edit view..."] -command editview \
da7c24dd 1396 -state disabled
d990cedf 1397 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
50b44ece 1398 .bar.view add separator
d990cedf 1399 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
a90a6d24 1400 -variable selectedview -value 0
40b87ff8 1401
9a40c50c 1402 menu .bar.help
d990cedf
CS
1403 .bar add cascade -label [mc "Help"] -menu .bar.help
1404 .bar.help add command -label [mc "About gitk"] -command about
1405 .bar.help add command -label [mc "Key bindings"] -command keys
b039f0a6 1406 .bar.help configure
9a40c50c
PM
1407 . configure -menu .bar
1408
e9937d2a 1409 # the gui has upper and lower half, parts of a paned window.
0327d27a 1410 panedwindow .ctop -orient vertical
e9937d2a
JH
1411
1412 # possibly use assumed geometry
9ca72f4f 1413 if {![info exists geometry(pwsash0)]} {
e9937d2a
JH
1414 set geometry(topheight) [expr {15 * $linespc}]
1415 set geometry(topwidth) [expr {80 * $charspc}]
1416 set geometry(botheight) [expr {15 * $linespc}]
1417 set geometry(botwidth) [expr {50 * $charspc}]
9ca72f4f
ML
1418 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1419 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
e9937d2a
JH
1420 }
1421
1422 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1423 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1424 frame .tf.histframe
1425 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1426
1427 # create three canvases
1428 set cscroll .tf.histframe.csb
1429 set canv .tf.histframe.pwclist.canv
9ca72f4f 1430 canvas $canv \
60378c0c 1431 -selectbackground $selectbgcolor \
f8a2c0d1 1432 -background $bgcolor -bd 0 \
9f1afe05 1433 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
e9937d2a
JH
1434 .tf.histframe.pwclist add $canv
1435 set canv2 .tf.histframe.pwclist.canv2
9ca72f4f 1436 canvas $canv2 \
60378c0c 1437 -selectbackground $selectbgcolor \
f8a2c0d1 1438 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a
JH
1439 .tf.histframe.pwclist add $canv2
1440 set canv3 .tf.histframe.pwclist.canv3
9ca72f4f 1441 canvas $canv3 \
60378c0c 1442 -selectbackground $selectbgcolor \
f8a2c0d1 1443 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a 1444 .tf.histframe.pwclist add $canv3
9ca72f4f
ML
1445 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1446 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
e9937d2a
JH
1447
1448 # a scroll bar to rule them
1449 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1450 pack $cscroll -side right -fill y
1451 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
f8a2c0d1 1452 lappend bglist $canv $canv2 $canv3
e9937d2a 1453 pack .tf.histframe.pwclist -fill both -expand 1 -side left
98f350e5 1454
e9937d2a
JH
1455 # we have two button bars at bottom of top frame. Bar 1
1456 frame .tf.bar
1457 frame .tf.lbar -height 15
1458
1459 set sha1entry .tf.bar.sha1
887fe3c4 1460 set entries $sha1entry
e9937d2a 1461 set sha1but .tf.bar.sha1label
d990cedf 1462 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
b039f0a6 1463 -command gotocommit -width 8
887fe3c4 1464 $sha1but conf -disabledforeground [$sha1but cget -foreground]
e9937d2a 1465 pack .tf.bar.sha1label -side left
9c311b32 1466 entry $sha1entry -width 40 -font textfont -textvariable sha1string
887fe3c4 1467 trace add variable sha1string write sha1change
98f350e5 1468 pack $sha1entry -side left -pady 2
d698206c
PM
1469
1470 image create bitmap bm-left -data {
1471 #define left_width 16
1472 #define left_height 16
1473 static unsigned char left_bits[] = {
1474 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1475 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1476 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1477 }
1478 image create bitmap bm-right -data {
1479 #define right_width 16
1480 #define right_height 16
1481 static unsigned char right_bits[] = {
1482 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1483 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1484 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1485 }
e9937d2a 1486 button .tf.bar.leftbut -image bm-left -command goback \
d698206c 1487 -state disabled -width 26
e9937d2a
JH
1488 pack .tf.bar.leftbut -side left -fill y
1489 button .tf.bar.rightbut -image bm-right -command goforw \
d698206c 1490 -state disabled -width 26
e9937d2a 1491 pack .tf.bar.rightbut -side left -fill y
d698206c 1492
bb3edc8b
PM
1493 # Status label and progress bar
1494 set statusw .tf.bar.status
b039f0a6 1495 label $statusw -width 15 -relief sunken
bb3edc8b 1496 pack $statusw -side left -padx 5
9c311b32 1497 set h [expr {[font metrics uifont -linespace] + 2}]
bb3edc8b
PM
1498 set progresscanv .tf.bar.progress
1499 canvas $progresscanv -relief sunken -height $h -borderwidth 2
1500 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1501 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
a137a90f 1502 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
bb3edc8b
PM
1503 pack $progresscanv -side right -expand 1 -fill x
1504 set progresscoords {0 0}
1505 set fprogcoord 0
a137a90f 1506 set rprogcoord 0
bb3edc8b
PM
1507 bind $progresscanv <Configure> adjustprogress
1508 set lastprogupdate [clock clicks -milliseconds]
1509 set progupdatepending 0
1510
687c8765 1511 # build up the bottom bar of upper window
b039f0a6
PM
1512 label .tf.lbar.flabel -text "[mc "Find"] "
1513 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
1514 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
1515 label .tf.lbar.flab2 -text " [mc "commit"] "
687c8765
PM
1516 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1517 -side left -fill y
b007ee20 1518 set gdttype [mc "containing:"]
687c8765 1519 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
b007ee20
CS
1520 [mc "containing:"] \
1521 [mc "touching paths:"] \
1522 [mc "adding/removing string:"]]
687c8765 1523 trace add variable gdttype write gdttype_change
687c8765
PM
1524 pack .tf.lbar.gdttype -side left -fill y
1525
98f350e5 1526 set findstring {}
687c8765 1527 set fstring .tf.lbar.findstring
887fe3c4 1528 lappend entries $fstring
9c311b32 1529 entry $fstring -width 30 -font textfont -textvariable findstring
60f7a7dc 1530 trace add variable findstring write find_change
b007ee20 1531 set findtype [mc "Exact"]
687c8765 1532 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
b007ee20 1533 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
687c8765 1534 trace add variable findtype write findcom_change
b007ee20
CS
1535 set findloc [mc "All fields"]
1536 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
1537 [mc "Comments"] [mc "Author"] [mc "Committer"]
60f7a7dc 1538 trace add variable findloc write find_change
687c8765
PM
1539 pack .tf.lbar.findloc -side right
1540 pack .tf.lbar.findtype -side right
1541 pack $fstring -side left -expand 1 -fill x
e9937d2a
JH
1542
1543 # Finish putting the upper half of the viewer together
1544 pack .tf.lbar -in .tf -side bottom -fill x
1545 pack .tf.bar -in .tf -side bottom -fill x
1546 pack .tf.histframe -fill both -side top -expand 1
1547 .ctop add .tf
9ca72f4f
ML
1548 .ctop paneconfigure .tf -height $geometry(topheight)
1549 .ctop paneconfigure .tf -width $geometry(topwidth)
e9937d2a
JH
1550
1551 # now build up the bottom
1552 panedwindow .pwbottom -orient horizontal
1553
1554 # lower left, a text box over search bar, scroll bar to the right
1555 # if we know window height, then that will set the lower text height, otherwise
1556 # we set lower text height which will drive window height
1557 if {[info exists geometry(main)]} {
1558 frame .bleft -width $geometry(botwidth)
1559 } else {
1560 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
1561 }
1562 frame .bleft.top
a8d610a2 1563 frame .bleft.mid
e9937d2a 1564
b039f0a6 1565 button .bleft.top.search -text [mc "Search"] -command dosearch
e9937d2a
JH
1566 pack .bleft.top.search -side left -padx 5
1567 set sstring .bleft.top.sstring
9c311b32 1568 entry $sstring -width 20 -font textfont -textvariable searchstring
3ea06f9f
PM
1569 lappend entries $sstring
1570 trace add variable searchstring write incrsearch
1571 pack $sstring -side left -expand 1 -fill x
b039f0a6 1572 radiobutton .bleft.mid.diff -text [mc "Diff"] \
a8d610a2 1573 -command changediffdisp -variable diffelide -value {0 0}
b039f0a6 1574 radiobutton .bleft.mid.old -text [mc "Old version"] \
a8d610a2 1575 -command changediffdisp -variable diffelide -value {0 1}
b039f0a6 1576 radiobutton .bleft.mid.new -text [mc "New version"] \
a8d610a2 1577 -command changediffdisp -variable diffelide -value {1 0}
b039f0a6 1578 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
a8d610a2 1579 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
9c311b32 1580 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
890fae70
SP
1581 -from 1 -increment 1 -to 10000000 \
1582 -validate all -validatecommand "diffcontextvalidate %P" \
1583 -textvariable diffcontextstring
1584 .bleft.mid.diffcontext set $diffcontext
1585 trace add variable diffcontextstring write diffcontextchange
1586 lappend entries .bleft.mid.diffcontext
1587 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
e9937d2a 1588 set ctext .bleft.ctext
f8a2c0d1 1589 text $ctext -background $bgcolor -foreground $fgcolor \
9c311b32 1590 -state disabled -font textfont \
3ea06f9f 1591 -yscrollcommand scrolltext -wrap none
32f1b3e4
PM
1592 if {$have_tk85} {
1593 $ctext conf -tabstyle wordprocessor
1594 }
e9937d2a
JH
1595 scrollbar .bleft.sb -command "$ctext yview"
1596 pack .bleft.top -side top -fill x
a8d610a2 1597 pack .bleft.mid -side top -fill x
e9937d2a 1598 pack .bleft.sb -side right -fill y
d2610d11 1599 pack $ctext -side left -fill both -expand 1
f8a2c0d1
PM
1600 lappend bglist $ctext
1601 lappend fglist $ctext
d2610d11 1602
f1b86294 1603 $ctext tag conf comment -wrap $wrapcomment
9c311b32 1604 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
f8a2c0d1
PM
1605 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
1606 $ctext tag conf d0 -fore [lindex $diffcolors 0]
1607 $ctext tag conf d1 -fore [lindex $diffcolors 1]
712fcc08
PM
1608 $ctext tag conf m0 -fore red
1609 $ctext tag conf m1 -fore blue
1610 $ctext tag conf m2 -fore green
1611 $ctext tag conf m3 -fore purple
1612 $ctext tag conf m4 -fore brown
b77b0278
PM
1613 $ctext tag conf m5 -fore "#009090"
1614 $ctext tag conf m6 -fore magenta
1615 $ctext tag conf m7 -fore "#808000"
1616 $ctext tag conf m8 -fore "#009000"
1617 $ctext tag conf m9 -fore "#ff0080"
1618 $ctext tag conf m10 -fore cyan
1619 $ctext tag conf m11 -fore "#b07070"
1620 $ctext tag conf m12 -fore "#70b0f0"
1621 $ctext tag conf m13 -fore "#70f0b0"
1622 $ctext tag conf m14 -fore "#f0b070"
1623 $ctext tag conf m15 -fore "#ff70b0"
712fcc08 1624 $ctext tag conf mmax -fore darkgrey
b77b0278 1625 set mergemax 16
9c311b32
PM
1626 $ctext tag conf mresult -font textfontbold
1627 $ctext tag conf msep -font textfontbold
712fcc08 1628 $ctext tag conf found -back yellow
e5c2d856 1629
e9937d2a 1630 .pwbottom add .bleft
9ca72f4f 1631 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
e9937d2a
JH
1632
1633 # lower right
1634 frame .bright
1635 frame .bright.mode
d990cedf 1636 radiobutton .bright.mode.patch -text [mc "Patch"] \
f8b28a40 1637 -command reselectline -variable cmitmode -value "patch"
d990cedf 1638 radiobutton .bright.mode.tree -text [mc "Tree"] \
f8b28a40 1639 -command reselectline -variable cmitmode -value "tree"
e9937d2a
JH
1640 grid .bright.mode.patch .bright.mode.tree -sticky ew
1641 pack .bright.mode -side top -fill x
1642 set cflist .bright.cfiles
9c311b32 1643 set indent [font measure mainfont "nn"]
e9937d2a 1644 text $cflist \
60378c0c 1645 -selectbackground $selectbgcolor \
f8a2c0d1 1646 -background $bgcolor -foreground $fgcolor \
9c311b32 1647 -font mainfont \
7fcceed7 1648 -tabs [list $indent [expr {2 * $indent}]] \
e9937d2a 1649 -yscrollcommand ".bright.sb set" \
7fcceed7
PM
1650 -cursor [. cget -cursor] \
1651 -spacing1 1 -spacing3 1
f8a2c0d1
PM
1652 lappend bglist $cflist
1653 lappend fglist $cflist
e9937d2a
JH
1654 scrollbar .bright.sb -command "$cflist yview"
1655 pack .bright.sb -side right -fill y
d2610d11 1656 pack $cflist -side left -fill both -expand 1
89b11d3b
PM
1657 $cflist tag configure highlight \
1658 -background [$cflist cget -selectbackground]
9c311b32 1659 $cflist tag configure bold -font mainfontbold
d2610d11 1660
e9937d2a
JH
1661 .pwbottom add .bright
1662 .ctop add .pwbottom
1db95b00 1663
e9937d2a
JH
1664 # restore window position if known
1665 if {[info exists geometry(main)]} {
1666 wm geometry . "$geometry(main)"
1667 }
1668
d23d98d3
SP
1669 if {[tk windowingsystem] eq {aqua}} {
1670 set M1B M1
1671 } else {
1672 set M1B Control
1673 }
1674
e9937d2a
JH
1675 bind .pwbottom <Configure> {resizecdetpanes %W %w}
1676 pack .ctop -fill both -expand 1
c8dfbcf9
PM
1677 bindall <1> {selcanvline %W %x %y}
1678 #bindall <B1-Motion> {selcanvline %W %x %y}
314c3093
ML
1679 if {[tk windowingsystem] == "win32"} {
1680 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
1681 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
1682 } else {
1683 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
1684 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
5dd57d51
JS
1685 if {[tk windowingsystem] eq "aqua"} {
1686 bindall <MouseWheel> {
1687 set delta [expr {- (%D)}]
1688 allcanvs yview scroll $delta units
1689 }
1690 }
314c3093 1691 }
be0cd098
PM
1692 bindall <2> "canvscan mark %W %x %y"
1693 bindall <B2-Motion> "canvscan dragto %W %x %y"
6e5f7203
RN
1694 bindkey <Home> selfirstline
1695 bindkey <End> sellastline
17386066
PM
1696 bind . <Key-Up> "selnextline -1"
1697 bind . <Key-Down> "selnextline 1"
cca5d946
PM
1698 bind . <Shift-Key-Up> "dofind -1 0"
1699 bind . <Shift-Key-Down> "dofind 1 0"
6e5f7203
RN
1700 bindkey <Key-Right> "goforw"
1701 bindkey <Key-Left> "goback"
1702 bind . <Key-Prior> "selnextpage -1"
1703 bind . <Key-Next> "selnextpage 1"
d23d98d3
SP
1704 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1705 bind . <$M1B-End> "allcanvs yview moveto 1.0"
1706 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1707 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1708 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1709 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
cfb4563c
PM
1710 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1711 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1712 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
1713 bindkey p "selnextline -1"
1714 bindkey n "selnextline 1"
6e2dda35
RS
1715 bindkey z "goback"
1716 bindkey x "goforw"
1717 bindkey i "selnextline -1"
1718 bindkey k "selnextline 1"
1719 bindkey j "goback"
1720 bindkey l "goforw"
cfb4563c
PM
1721 bindkey b "$ctext yview scroll -1 pages"
1722 bindkey d "$ctext yview scroll 18 units"
1723 bindkey u "$ctext yview scroll -18 units"
cca5d946
PM
1724 bindkey / {dofind 1 1}
1725 bindkey <Key-Return> {dofind 1 1}
1726 bindkey ? {dofind -1 1}
39ad8570 1727 bindkey f nextfile
e7a09191 1728 bindkey <F5> updatecommits
d23d98d3 1729 bind . <$M1B-q> doquit
cca5d946
PM
1730 bind . <$M1B-f> {dofind 1 1}
1731 bind . <$M1B-g> {dofind 1 0}
d23d98d3
SP
1732 bind . <$M1B-r> dosearchback
1733 bind . <$M1B-s> dosearch
1734 bind . <$M1B-equal> {incrfont 1}
1735 bind . <$M1B-KP_Add> {incrfont 1}
1736 bind . <$M1B-minus> {incrfont -1}
1737 bind . <$M1B-KP_Subtract> {incrfont -1}
b6047c5a 1738 wm protocol . WM_DELETE_WINDOW doquit
df3d83b1 1739 bind . <Button-1> "click %W"
cca5d946 1740 bind $fstring <Key-Return> {dofind 1 1}
887fe3c4 1741 bind $sha1entry <Key-Return> gotocommit
ee3dc72e 1742 bind $sha1entry <<PasteSelection>> clearsha1
7fcceed7
PM
1743 bind $cflist <1> {sel_flist %W %x %y; break}
1744 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
f8b28a40 1745 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
3244729a 1746 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
ea13cba1
PM
1747
1748 set maincursor [. cget -cursor]
1749 set textcursor [$ctext cget -cursor]
94a2eede 1750 set curtextcursor $textcursor
84ba7345 1751
c8dfbcf9
PM
1752 set rowctxmenu .rowctxmenu
1753 menu $rowctxmenu -tearoff 0
d990cedf 1754 $rowctxmenu add command -label [mc "Diff this -> selected"] \
c8dfbcf9 1755 -command {diffvssel 0}
d990cedf 1756 $rowctxmenu add command -label [mc "Diff selected -> this"] \
c8dfbcf9 1757 -command {diffvssel 1}
d990cedf
CS
1758 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1759 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1760 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1761 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1762 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
ca6d8f58 1763 -command cherrypick
d990cedf 1764 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
6fb735ae 1765 -command resethead
10299152 1766
219ea3a9
PM
1767 set fakerowmenu .fakerowmenu
1768 menu $fakerowmenu -tearoff 0
d990cedf 1769 $fakerowmenu add command -label [mc "Diff this -> selected"] \
219ea3a9 1770 -command {diffvssel 0}
d990cedf 1771 $fakerowmenu add command -label [mc "Diff selected -> this"] \
219ea3a9 1772 -command {diffvssel 1}
d990cedf
CS
1773 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1774# $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1775# $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1776# $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
219ea3a9 1777
10299152
PM
1778 set headctxmenu .headctxmenu
1779 menu $headctxmenu -tearoff 0
d990cedf 1780 $headctxmenu add command -label [mc "Check out this branch"] \
10299152 1781 -command cobranch
d990cedf 1782 $headctxmenu add command -label [mc "Remove this branch"] \
10299152 1783 -command rmbranch
3244729a
PM
1784
1785 global flist_menu
1786 set flist_menu .flistctxmenu
1787 menu $flist_menu -tearoff 0
d990cedf 1788 $flist_menu add command -label [mc "Highlight this too"] \
3244729a 1789 -command {flist_hl 0}
d990cedf 1790 $flist_menu add command -label [mc "Highlight this only"] \
3244729a 1791 -command {flist_hl 1}
df3d83b1
PM
1792}
1793
314c3093
ML
1794# Windows sends all mouse wheel events to the current focused window, not
1795# the one where the mouse hovers, so bind those events here and redirect
1796# to the correct window
1797proc windows_mousewheel_redirector {W X Y D} {
1798 global canv canv2 canv3
1799 set w [winfo containing -displayof $W $X $Y]
1800 if {$w ne ""} {
1801 set u [expr {$D < 0 ? 5 : -5}]
1802 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1803 allcanvs yview scroll $u units
1804 } else {
1805 catch {
1806 $w yview scroll $u units
1807 }
1808 }
1809 }
1810}
1811
be0cd098
PM
1812# mouse-2 makes all windows scan vertically, but only the one
1813# the cursor is in scans horizontally
1814proc canvscan {op w x y} {
1815 global canv canv2 canv3
1816 foreach c [list $canv $canv2 $canv3] {
1817 if {$c == $w} {
1818 $c scan $op $x $y
1819 } else {
1820 $c scan $op 0 $y
1821 }
1822 }
1823}
1824
9f1afe05
PM
1825proc scrollcanv {cscroll f0 f1} {
1826 $cscroll set $f0 $f1
31c0eaa8 1827 drawvisible
908c3585 1828 flushhighlights
9f1afe05
PM
1829}
1830
df3d83b1
PM
1831# when we make a key binding for the toplevel, make sure
1832# it doesn't get triggered when that key is pressed in the
1833# find string entry widget.
1834proc bindkey {ev script} {
887fe3c4 1835 global entries
df3d83b1
PM
1836 bind . $ev $script
1837 set escript [bind Entry $ev]
1838 if {$escript == {}} {
1839 set escript [bind Entry <Key>]
1840 }
887fe3c4
PM
1841 foreach e $entries {
1842 bind $e $ev "$escript; break"
1843 }
df3d83b1
PM
1844}
1845
1846# set the focus back to the toplevel for any click outside
887fe3c4 1847# the entry widgets
df3d83b1 1848proc click {w} {
bd441de4
ML
1849 global ctext entries
1850 foreach e [concat $entries $ctext] {
887fe3c4 1851 if {$w == $e} return
df3d83b1 1852 }
887fe3c4 1853 focus .
0fba86b3
PM
1854}
1855
bb3edc8b
PM
1856# Adjust the progress bar for a change in requested extent or canvas size
1857proc adjustprogress {} {
1858 global progresscanv progressitem progresscoords
1859 global fprogitem fprogcoord lastprogupdate progupdatepending
a137a90f 1860 global rprogitem rprogcoord
bb3edc8b
PM
1861
1862 set w [expr {[winfo width $progresscanv] - 4}]
1863 set x0 [expr {$w * [lindex $progresscoords 0]}]
1864 set x1 [expr {$w * [lindex $progresscoords 1]}]
1865 set h [winfo height $progresscanv]
1866 $progresscanv coords $progressitem $x0 0 $x1 $h
1867 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
a137a90f 1868 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
bb3edc8b
PM
1869 set now [clock clicks -milliseconds]
1870 if {$now >= $lastprogupdate + 100} {
1871 set progupdatepending 0
1872 update
1873 } elseif {!$progupdatepending} {
1874 set progupdatepending 1
1875 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1876 }
1877}
1878
1879proc doprogupdate {} {
1880 global lastprogupdate progupdatepending
1881
1882 if {$progupdatepending} {
1883 set progupdatepending 0
1884 set lastprogupdate [clock clicks -milliseconds]
1885 update
1886 }
1887}
1888
0fba86b3 1889proc savestuff {w} {
32f1b3e4 1890 global canv canv2 canv3 mainfont textfont uifont tabstop
712fcc08 1891 global stuffsaved findmergefiles maxgraphpct
219ea3a9 1892 global maxwidth showneartags showlocalchanges
098dd8a3 1893 global viewname viewfiles viewargs viewperm nextviewnum
7a39a17a 1894 global cmitmode wrapcomment datetimeformat limitdiffs
890fae70 1895 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
4ef17537 1896
0fba86b3 1897 if {$stuffsaved} return
df3d83b1 1898 if {![winfo viewable .]} return
0fba86b3
PM
1899 catch {
1900 set f [open "~/.gitk-new" w]
f0654861
PM
1901 puts $f [list set mainfont $mainfont]
1902 puts $f [list set textfont $textfont]
4840be66 1903 puts $f [list set uifont $uifont]
7e12f1a6 1904 puts $f [list set tabstop $tabstop]
f0654861 1905 puts $f [list set findmergefiles $findmergefiles]
8d858d1a 1906 puts $f [list set maxgraphpct $maxgraphpct]
04c13d38 1907 puts $f [list set maxwidth $maxwidth]
f8b28a40 1908 puts $f [list set cmitmode $cmitmode]
f1b86294 1909 puts $f [list set wrapcomment $wrapcomment]
b8ab2e17 1910 puts $f [list set showneartags $showneartags]
219ea3a9 1911 puts $f [list set showlocalchanges $showlocalchanges]
e8b5f4be 1912 puts $f [list set datetimeformat $datetimeformat]
7a39a17a 1913 puts $f [list set limitdiffs $limitdiffs]
f8a2c0d1
PM
1914 puts $f [list set bgcolor $bgcolor]
1915 puts $f [list set fgcolor $fgcolor]
1916 puts $f [list set colors $colors]
1917 puts $f [list set diffcolors $diffcolors]
890fae70 1918 puts $f [list set diffcontext $diffcontext]
60378c0c 1919 puts $f [list set selectbgcolor $selectbgcolor]
e9937d2a 1920
b6047c5a 1921 puts $f "set geometry(main) [wm geometry .]"
e9937d2a
JH
1922 puts $f "set geometry(topwidth) [winfo width .tf]"
1923 puts $f "set geometry(topheight) [winfo height .tf]"
9ca72f4f
ML
1924 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1925 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
e9937d2a
JH
1926 puts $f "set geometry(botwidth) [winfo width .bleft]"
1927 puts $f "set geometry(botheight) [winfo height .bleft]"
1928
a90a6d24
PM
1929 puts -nonewline $f "set permviews {"
1930 for {set v 0} {$v < $nextviewnum} {incr v} {
1931 if {$viewperm($v)} {
098dd8a3 1932 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
a90a6d24
PM
1933 }
1934 }
1935 puts $f "}"
0fba86b3
PM
1936 close $f
1937 file rename -force "~/.gitk-new" "~/.gitk"
1938 }
1939 set stuffsaved 1
1db95b00
PM
1940}
1941
43bddeb4
PM
1942proc resizeclistpanes {win w} {
1943 global oldwidth
418c4c7b 1944 if {[info exists oldwidth($win)]} {
43bddeb4
PM
1945 set s0 [$win sash coord 0]
1946 set s1 [$win sash coord 1]
1947 if {$w < 60} {
1948 set sash0 [expr {int($w/2 - 2)}]
1949 set sash1 [expr {int($w*5/6 - 2)}]
1950 } else {
1951 set factor [expr {1.0 * $w / $oldwidth($win)}]
1952 set sash0 [expr {int($factor * [lindex $s0 0])}]
1953 set sash1 [expr {int($factor * [lindex $s1 0])}]
1954 if {$sash0 < 30} {
1955 set sash0 30
1956 }
1957 if {$sash1 < $sash0 + 20} {
2ed49d54 1958 set sash1 [expr {$sash0 + 20}]
43bddeb4
PM
1959 }
1960 if {$sash1 > $w - 10} {
2ed49d54 1961 set sash1 [expr {$w - 10}]
43bddeb4 1962 if {$sash0 > $sash1 - 20} {
2ed49d54 1963 set sash0 [expr {$sash1 - 20}]
43bddeb4
PM
1964 }
1965 }
1966 }
1967 $win sash place 0 $sash0 [lindex $s0 1]
1968 $win sash place 1 $sash1 [lindex $s1 1]
1969 }
1970 set oldwidth($win) $w
1971}
1972
1973proc resizecdetpanes {win w} {
1974 global oldwidth
418c4c7b 1975 if {[info exists oldwidth($win)]} {
43bddeb4
PM
1976 set s0 [$win sash coord 0]
1977 if {$w < 60} {
1978 set sash0 [expr {int($w*3/4 - 2)}]
1979 } else {
1980 set factor [expr {1.0 * $w / $oldwidth($win)}]
1981 set sash0 [expr {int($factor * [lindex $s0 0])}]
1982 if {$sash0 < 45} {
1983 set sash0 45
1984 }
1985 if {$sash0 > $w - 15} {
2ed49d54 1986 set sash0 [expr {$w - 15}]
43bddeb4
PM
1987 }
1988 }
1989 $win sash place 0 $sash0 [lindex $s0 1]
1990 }
1991 set oldwidth($win) $w
1992}
1993
b5721c72
PM
1994proc allcanvs args {
1995 global canv canv2 canv3
1996 eval $canv $args
1997 eval $canv2 $args
1998 eval $canv3 $args
1999}
2000
2001proc bindall {event action} {
2002 global canv canv2 canv3
2003 bind $canv $event $action
2004 bind $canv2 $event $action
2005 bind $canv3 $event $action
2006}
2007
9a40c50c 2008proc about {} {
d59c4b6f 2009 global uifont
9a40c50c
PM
2010 set w .about
2011 if {[winfo exists $w]} {
2012 raise $w
2013 return
2014 }
2015 toplevel $w
d990cedf
CS
2016 wm title $w [mc "About gitk"]
2017 message $w.m -text [mc "
9f1afe05 2018Gitk - a commit viewer for git
9a40c50c 2019
eadcac92 2020Copyright © 2005-2006 Paul Mackerras
9a40c50c 2021
d990cedf 2022Use and redistribute under the terms of the GNU General Public License"] \
3a950e9a
ER
2023 -justify center -aspect 400 -border 2 -bg white -relief groove
2024 pack $w.m -side top -fill x -padx 2 -pady 2
d990cedf 2025 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
9a40c50c 2026 pack $w.ok -side bottom
3a950e9a
ER
2027 bind $w <Visibility> "focus $w.ok"
2028 bind $w <Key-Escape> "destroy $w"
2029 bind $w <Key-Return> "destroy $w"
9a40c50c
PM
2030}
2031
4e95e1f7
PM
2032proc keys {} {
2033 set w .keys
2034 if {[winfo exists $w]} {
2035 raise $w
2036 return
2037 }
d23d98d3
SP
2038 if {[tk windowingsystem] eq {aqua}} {
2039 set M1T Cmd
2040 } else {
2041 set M1T Ctrl
2042 }
4e95e1f7 2043 toplevel $w
d990cedf
CS
2044 wm title $w [mc "Gitk key bindings"]
2045 message $w.m -text [mc "
4e95e1f7
PM
2046Gitk key bindings:
2047
d23d98d3 2048<$M1T-Q> Quit
6e5f7203
RN
2049<Home> Move to first commit
2050<End> Move to last commit
4e95e1f7
PM
2051<Up>, p, i Move up one commit
2052<Down>, n, k Move down one commit
2053<Left>, z, j Go back in history list
2054<Right>, x, l Go forward in history list
6e5f7203
RN
2055<PageUp> Move up one page in commit list
2056<PageDown> Move down one page in commit list
d23d98d3
SP
2057<$M1T-Home> Scroll to top of commit list
2058<$M1T-End> Scroll to bottom of commit list
2059<$M1T-Up> Scroll commit list up one line
2060<$M1T-Down> Scroll commit list down one line
2061<$M1T-PageUp> Scroll commit list up one page
2062<$M1T-PageDown> Scroll commit list down one page
cca5d946
PM
2063<Shift-Up> Find backwards (upwards, later commits)
2064<Shift-Down> Find forwards (downwards, earlier commits)
4e95e1f7
PM
2065<Delete>, b Scroll diff view up one page
2066<Backspace> Scroll diff view up one page
2067<Space> Scroll diff view down one page
2068u Scroll diff view up 18 lines
2069d Scroll diff view down 18 lines
d23d98d3
SP
2070<$M1T-F> Find
2071<$M1T-G> Move to next find hit
4e95e1f7
PM
2072<Return> Move to next find hit
2073/ Move to next find hit, or redo find
2074? Move to previous find hit
2075f Scroll diff view to next file
d23d98d3
SP
2076<$M1T-S> Search for next hit in diff view
2077<$M1T-R> Search for previous hit in diff view
2078<$M1T-KP+> Increase font size
2079<$M1T-plus> Increase font size
2080<$M1T-KP-> Decrease font size
2081<$M1T-minus> Decrease font size
e7a09191 2082<F5> Update
d990cedf 2083"] \
3a950e9a
ER
2084 -justify left -bg white -border 2 -relief groove
2085 pack $w.m -side top -fill both -padx 2 -pady 2
d990cedf 2086 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
4e95e1f7 2087 pack $w.ok -side bottom
3a950e9a
ER
2088 bind $w <Visibility> "focus $w.ok"
2089 bind $w <Key-Escape> "destroy $w"
2090 bind $w <Key-Return> "destroy $w"
4e95e1f7
PM
2091}
2092
7fcceed7
PM
2093# Procedures for manipulating the file list window at the
2094# bottom right of the overall window.
f8b28a40
PM
2095
2096proc treeview {w l openlevs} {
2097 global treecontents treediropen treeheight treeparent treeindex
2098
2099 set ix 0
2100 set treeindex() 0
2101 set lev 0
2102 set prefix {}
2103 set prefixend -1
2104 set prefendstack {}
2105 set htstack {}
2106 set ht 0
2107 set treecontents() {}
2108 $w conf -state normal
2109 foreach f $l {
2110 while {[string range $f 0 $prefixend] ne $prefix} {
2111 if {$lev <= $openlevs} {
2112 $w mark set e:$treeindex($prefix) "end -1c"
2113 $w mark gravity e:$treeindex($prefix) left
2114 }
2115 set treeheight($prefix) $ht
2116 incr ht [lindex $htstack end]
2117 set htstack [lreplace $htstack end end]
2118 set prefixend [lindex $prefendstack end]
2119 set prefendstack [lreplace $prefendstack end end]
2120 set prefix [string range $prefix 0 $prefixend]
2121 incr lev -1
2122 }
2123 set tail [string range $f [expr {$prefixend+1}] end]
2124 while {[set slash [string first "/" $tail]] >= 0} {
2125 lappend htstack $ht
2126 set ht 0
2127 lappend prefendstack $prefixend
2128 incr prefixend [expr {$slash + 1}]
2129 set d [string range $tail 0 $slash]
2130 lappend treecontents($prefix) $d
2131 set oldprefix $prefix
2132 append prefix $d
2133 set treecontents($prefix) {}
2134 set treeindex($prefix) [incr ix]
2135 set treeparent($prefix) $oldprefix
2136 set tail [string range $tail [expr {$slash+1}] end]
2137 if {$lev <= $openlevs} {
2138 set ht 1
2139 set treediropen($prefix) [expr {$lev < $openlevs}]
2140 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2141 $w mark set d:$ix "end -1c"
2142 $w mark gravity d:$ix left
2143 set str "\n"
2144 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2145 $w insert end $str
2146 $w image create end -align center -image $bm -padx 1 \
2147 -name a:$ix
45a9d505 2148 $w insert end $d [highlight_tag $prefix]
f8b28a40
PM
2149 $w mark set s:$ix "end -1c"
2150 $w mark gravity s:$ix left
2151 }
2152 incr lev
2153 }
2154 if {$tail ne {}} {
2155 if {$lev <= $openlevs} {
2156 incr ht
2157 set str "\n"
2158 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2159 $w insert end $str
45a9d505 2160 $w insert end $tail [highlight_tag $f]
f8b28a40
PM
2161 }
2162 lappend treecontents($prefix) $tail
2163 }
2164 }
2165 while {$htstack ne {}} {
2166 set treeheight($prefix) $ht
2167 incr ht [lindex $htstack end]
2168 set htstack [lreplace $htstack end end]
096e96b4
BD
2169 set prefixend [lindex $prefendstack end]
2170 set prefendstack [lreplace $prefendstack end end]
2171 set prefix [string range $prefix 0 $prefixend]
f8b28a40
PM
2172 }
2173 $w conf -state disabled
2174}
2175
2176proc linetoelt {l} {
2177 global treeheight treecontents
2178
2179 set y 2
2180 set prefix {}
2181 while {1} {
2182 foreach e $treecontents($prefix) {
2183 if {$y == $l} {
2184 return "$prefix$e"
2185 }
2186 set n 1
2187 if {[string index $e end] eq "/"} {
2188 set n $treeheight($prefix$e)
2189 if {$y + $n > $l} {
2190 append prefix $e
2191 incr y
2192 break
2193 }
2194 }
2195 incr y $n
2196 }
2197 }
2198}
2199
45a9d505
PM
2200proc highlight_tree {y prefix} {
2201 global treeheight treecontents cflist
2202
2203 foreach e $treecontents($prefix) {
2204 set path $prefix$e
2205 if {[highlight_tag $path] ne {}} {
2206 $cflist tag add bold $y.0 "$y.0 lineend"
2207 }
2208 incr y
2209 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2210 set y [highlight_tree $y $path]
2211 }
2212 }
2213 return $y
2214}
2215
f8b28a40
PM
2216proc treeclosedir {w dir} {
2217 global treediropen treeheight treeparent treeindex
2218
2219 set ix $treeindex($dir)
2220 $w conf -state normal
2221 $w delete s:$ix e:$ix
2222 set treediropen($dir) 0
2223 $w image configure a:$ix -image tri-rt
2224 $w conf -state disabled
2225 set n [expr {1 - $treeheight($dir)}]
2226 while {$dir ne {}} {
2227 incr treeheight($dir) $n
2228 set dir $treeparent($dir)
2229 }
2230}
2231
2232proc treeopendir {w dir} {
2233 global treediropen treeheight treeparent treecontents treeindex
2234
2235 set ix $treeindex($dir)
2236 $w conf -state normal
2237 $w image configure a:$ix -image tri-dn
2238 $w mark set e:$ix s:$ix
2239 $w mark gravity e:$ix right
2240 set lev 0
2241 set str "\n"
2242 set n [llength $treecontents($dir)]
2243 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2244 incr lev
2245 append str "\t"
2246 incr treeheight($x) $n
2247 }
2248 foreach e $treecontents($dir) {
45a9d505 2249 set de $dir$e
f8b28a40 2250 if {[string index $e end] eq "/"} {
f8b28a40
PM
2251 set iy $treeindex($de)
2252 $w mark set d:$iy e:$ix
2253 $w mark gravity d:$iy left
2254 $w insert e:$ix $str
2255 set treediropen($de) 0
2256 $w image create e:$ix -align center -image tri-rt -padx 1 \
2257 -name a:$iy
45a9d505 2258 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
2259 $w mark set s:$iy e:$ix
2260 $w mark gravity s:$iy left
2261 set treeheight($de) 1
2262 } else {
2263 $w insert e:$ix $str
45a9d505 2264 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
2265 }
2266 }
2267 $w mark gravity e:$ix left
2268 $w conf -state disabled
2269 set treediropen($dir) 1
2270 set top [lindex [split [$w index @0,0] .] 0]
2271 set ht [$w cget -height]
2272 set l [lindex [split [$w index s:$ix] .] 0]
2273 if {$l < $top} {
2274 $w yview $l.0
2275 } elseif {$l + $n + 1 > $top + $ht} {
2276 set top [expr {$l + $n + 2 - $ht}]
2277 if {$l < $top} {
2278 set top $l
2279 }
2280 $w yview $top.0
2281 }
2282}
2283
2284proc treeclick {w x y} {
2285 global treediropen cmitmode ctext cflist cflist_top
2286
2287 if {$cmitmode ne "tree"} return
2288 if {![info exists cflist_top]} return
2289 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2290 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2291 $cflist tag add highlight $l.0 "$l.0 lineend"
2292 set cflist_top $l
2293 if {$l == 1} {
2294 $ctext yview 1.0
2295 return
2296 }
2297 set e [linetoelt $l]
2298 if {[string index $e end] ne "/"} {
2299 showfile $e
2300 } elseif {$treediropen($e)} {
2301 treeclosedir $w $e
2302 } else {
2303 treeopendir $w $e
2304 }
2305}
2306
2307proc setfilelist {id} {
2308 global treefilelist cflist
2309
2310 treeview $cflist $treefilelist($id) 0
2311}
2312
2313image create bitmap tri-rt -background black -foreground blue -data {
2314 #define tri-rt_width 13
2315 #define tri-rt_height 13
2316 static unsigned char tri-rt_bits[] = {
2317 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2318 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2319 0x00, 0x00};
2320} -maskdata {
2321 #define tri-rt-mask_width 13
2322 #define tri-rt-mask_height 13
2323 static unsigned char tri-rt-mask_bits[] = {
2324 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2325 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2326 0x08, 0x00};
2327}
2328image create bitmap tri-dn -background black -foreground blue -data {
2329 #define tri-dn_width 13
2330 #define tri-dn_height 13
2331 static unsigned char tri-dn_bits[] = {
2332 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2333 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2334 0x00, 0x00};
2335} -maskdata {
2336 #define tri-dn-mask_width 13
2337 #define tri-dn-mask_height 13
2338 static unsigned char tri-dn-mask_bits[] = {
2339 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2340 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2341 0x00, 0x00};
2342}
2343
887c996e
PM
2344image create bitmap reficon-T -background black -foreground yellow -data {
2345 #define tagicon_width 13
2346 #define tagicon_height 9
2347 static unsigned char tagicon_bits[] = {
2348 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2349 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2350} -maskdata {
2351 #define tagicon-mask_width 13
2352 #define tagicon-mask_height 9
2353 static unsigned char tagicon-mask_bits[] = {
2354 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2355 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2356}
2357set rectdata {
2358 #define headicon_width 13
2359 #define headicon_height 9
2360 static unsigned char headicon_bits[] = {
2361 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2362 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2363}
2364set rectmask {
2365 #define headicon-mask_width 13
2366 #define headicon-mask_height 9
2367 static unsigned char headicon-mask_bits[] = {
2368 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2369 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2370}
2371image create bitmap reficon-H -background black -foreground green \
2372 -data $rectdata -maskdata $rectmask
2373image create bitmap reficon-o -background black -foreground "#ddddff" \
2374 -data $rectdata -maskdata $rectmask
2375
7fcceed7 2376proc init_flist {first} {
7fcc92bf 2377 global cflist cflist_top difffilestart
7fcceed7
PM
2378
2379 $cflist conf -state normal
2380 $cflist delete 0.0 end
2381 if {$first ne {}} {
2382 $cflist insert end $first
2383 set cflist_top 1
7fcceed7
PM
2384 $cflist tag add highlight 1.0 "1.0 lineend"
2385 } else {
2386 catch {unset cflist_top}
2387 }
2388 $cflist conf -state disabled
2389 set difffilestart {}
2390}
2391
63b79191
PM
2392proc highlight_tag {f} {
2393 global highlight_paths
2394
2395 foreach p $highlight_paths {
2396 if {[string match $p $f]} {
2397 return "bold"
2398 }
2399 }
2400 return {}
2401}
2402
2403proc highlight_filelist {} {
45a9d505 2404 global cmitmode cflist
63b79191 2405
45a9d505
PM
2406 $cflist conf -state normal
2407 if {$cmitmode ne "tree"} {
63b79191
PM
2408 set end [lindex [split [$cflist index end] .] 0]
2409 for {set l 2} {$l < $end} {incr l} {
2410 set line [$cflist get $l.0 "$l.0 lineend"]
2411 if {[highlight_tag $line] ne {}} {
2412 $cflist tag add bold $l.0 "$l.0 lineend"
2413 }
2414 }
45a9d505
PM
2415 } else {
2416 highlight_tree 2 {}
63b79191 2417 }
45a9d505 2418 $cflist conf -state disabled
63b79191
PM
2419}
2420
2421proc unhighlight_filelist {} {
45a9d505 2422 global cflist
63b79191 2423
45a9d505
PM
2424 $cflist conf -state normal
2425 $cflist tag remove bold 1.0 end
2426 $cflist conf -state disabled
63b79191
PM
2427}
2428
f8b28a40 2429proc add_flist {fl} {
45a9d505 2430 global cflist
7fcceed7 2431
45a9d505
PM
2432 $cflist conf -state normal
2433 foreach f $fl {
2434 $cflist insert end "\n"
2435 $cflist insert end $f [highlight_tag $f]
7fcceed7 2436 }
45a9d505 2437 $cflist conf -state disabled
7fcceed7
PM
2438}
2439
2440proc sel_flist {w x y} {
45a9d505 2441 global ctext difffilestart cflist cflist_top cmitmode
7fcceed7 2442
f8b28a40 2443 if {$cmitmode eq "tree"} return
7fcceed7
PM
2444 if {![info exists cflist_top]} return
2445 set l [lindex [split [$w index "@$x,$y"] "."] 0]
89b11d3b
PM
2446 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2447 $cflist tag add highlight $l.0 "$l.0 lineend"
2448 set cflist_top $l
f8b28a40
PM
2449 if {$l == 1} {
2450 $ctext yview 1.0
2451 } else {
2452 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
7fcceed7 2453 }
7fcceed7
PM
2454}
2455
3244729a
PM
2456proc pop_flist_menu {w X Y x y} {
2457 global ctext cflist cmitmode flist_menu flist_menu_file
2458 global treediffs diffids
2459
bb3edc8b 2460 stopfinding
3244729a
PM
2461 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2462 if {$l <= 1} return
2463 if {$cmitmode eq "tree"} {
2464 set e [linetoelt $l]
2465 if {[string index $e end] eq "/"} return
2466 } else {
2467 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2468 }
2469 set flist_menu_file $e
2470 tk_popup $flist_menu $X $Y
2471}
2472
2473proc flist_hl {only} {
bb3edc8b 2474 global flist_menu_file findstring gdttype
3244729a
PM
2475
2476 set x [shellquote $flist_menu_file]
b007ee20 2477 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
bb3edc8b 2478 set findstring $x
3244729a 2479 } else {
bb3edc8b 2480 append findstring " " $x
3244729a 2481 }
b007ee20 2482 set gdttype [mc "touching paths:"]
3244729a
PM
2483}
2484
098dd8a3
PM
2485# Functions for adding and removing shell-type quoting
2486
2487proc shellquote {str} {
2488 if {![string match "*\['\"\\ \t]*" $str]} {
2489 return $str
2490 }
2491 if {![string match "*\['\"\\]*" $str]} {
2492 return "\"$str\""
2493 }
2494 if {![string match "*'*" $str]} {
2495 return "'$str'"
2496 }
2497 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2498}
2499
2500proc shellarglist {l} {
2501 set str {}
2502 foreach a $l {
2503 if {$str ne {}} {
2504 append str " "
2505 }
2506 append str [shellquote $a]
2507 }
2508 return $str
2509}
2510
2511proc shelldequote {str} {
2512 set ret {}
2513 set used -1
2514 while {1} {
2515 incr used
2516 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2517 append ret [string range $str $used end]
2518 set used [string length $str]
2519 break
2520 }
2521 set first [lindex $first 0]
2522 set ch [string index $str $first]
2523 if {$first > $used} {
2524 append ret [string range $str $used [expr {$first - 1}]]
2525 set used $first
2526 }
2527 if {$ch eq " " || $ch eq "\t"} break
2528 incr used
2529 if {$ch eq "'"} {
2530 set first [string first "'" $str $used]
2531 if {$first < 0} {
2532 error "unmatched single-quote"
2533 }
2534 append ret [string range $str $used [expr {$first - 1}]]
2535 set used $first
2536 continue
2537 }
2538 if {$ch eq "\\"} {
2539 if {$used >= [string length $str]} {
2540 error "trailing backslash"
2541 }
2542 append ret [string index $str $used]
2543 continue
2544 }
2545 # here ch == "\""
2546 while {1} {
2547 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2548 error "unmatched double-quote"
2549 }
2550 set first [lindex $first 0]
2551 set ch [string index $str $first]
2552 if {$first > $used} {
2553 append ret [string range $str $used [expr {$first - 1}]]
2554 set used $first
2555 }
2556 if {$ch eq "\""} break
2557 incr used
2558 append ret [string index $str $used]
2559 incr used
2560 }
2561 }
2562 return [list $used $ret]
2563}
2564
2565proc shellsplit {str} {
2566 set l {}
2567 while {1} {
2568 set str [string trimleft $str]
2569 if {$str eq {}} break
2570 set dq [shelldequote $str]
2571 set n [lindex $dq 0]
2572 set word [lindex $dq 1]
2573 set str [string range $str $n end]
2574 lappend l $word
2575 }
2576 return $l
2577}
2578
7fcceed7
PM
2579# Code to implement multiple views
2580
da7c24dd 2581proc newview {ishighlight} {
b039f0a6 2582 global nextviewnum newviewname newviewperm newishighlight
098dd8a3 2583 global newviewargs revtreeargs
50b44ece 2584
da7c24dd 2585 set newishighlight $ishighlight
50b44ece
PM
2586 set top .gitkview
2587 if {[winfo exists $top]} {
2588 raise $top
2589 return
2590 }
d16c0812
PM
2591 set newviewname($nextviewnum) "View $nextviewnum"
2592 set newviewperm($nextviewnum) 0
098dd8a3 2593 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
d990cedf 2594 vieweditor $top $nextviewnum [mc "Gitk view definition"]
d16c0812
PM
2595}
2596
2597proc editview {} {
2598 global curview
2599 global viewname viewperm newviewname newviewperm
098dd8a3 2600 global viewargs newviewargs
d16c0812
PM
2601
2602 set top .gitkvedit-$curview
2603 if {[winfo exists $top]} {
2604 raise $top
2605 return
2606 }
2607 set newviewname($curview) $viewname($curview)
2608 set newviewperm($curview) $viewperm($curview)
098dd8a3 2609 set newviewargs($curview) [shellarglist $viewargs($curview)]
d16c0812
PM
2610 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2611}
2612
2613proc vieweditor {top n title} {
2614 global newviewname newviewperm viewfiles
d16c0812 2615
50b44ece 2616 toplevel $top
d16c0812 2617 wm title $top $title
b039f0a6
PM
2618 label $top.nl -text [mc "Name"]
2619 entry $top.name -width 20 -textvariable newviewname($n)
a90a6d24 2620 grid $top.nl $top.name -sticky w -pady 5
b039f0a6
PM
2621 checkbutton $top.perm -text [mc "Remember this view"] \
2622 -variable newviewperm($n)
a90a6d24 2623 grid $top.perm - -pady 5 -sticky w
b039f0a6 2624 message $top.al -aspect 1000 \
d990cedf 2625 -text [mc "Commits to include (arguments to git rev-list):"]
098dd8a3
PM
2626 grid $top.al - -sticky w -pady 5
2627 entry $top.args -width 50 -textvariable newviewargs($n) \
b039f0a6 2628 -background white
098dd8a3 2629 grid $top.args - -sticky ew -padx 5
b039f0a6 2630 message $top.l -aspect 1000 \
d990cedf 2631 -text [mc "Enter files and directories to include, one per line:"]
a90a6d24 2632 grid $top.l - -sticky w
9c311b32 2633 text $top.t -width 40 -height 10 -background white -font uifont
d16c0812
PM
2634 if {[info exists viewfiles($n)]} {
2635 foreach f $viewfiles($n) {
2636 $top.t insert end $f
2637 $top.t insert end "\n"
2638 }
2639 $top.t delete {end - 1c} end
2640 $top.t mark set insert 0.0
2641 }
098dd8a3 2642 grid $top.t - -sticky ew -padx 5
50b44ece 2643 frame $top.buts
b039f0a6
PM
2644 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2645 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
50b44ece
PM
2646 grid $top.buts.ok $top.buts.can
2647 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2648 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2649 grid $top.buts - -pady 10 -sticky ew
2650 focus $top.t
2651}
2652
908c3585 2653proc doviewmenu {m first cmd op argv} {
da7c24dd
PM
2654 set nmenu [$m index end]
2655 for {set i $first} {$i <= $nmenu} {incr i} {
2656 if {[$m entrycget $i -command] eq $cmd} {
908c3585 2657 eval $m $op $i $argv
da7c24dd 2658 break
d16c0812
PM
2659 }
2660 }
da7c24dd
PM
2661}
2662
2663proc allviewmenus {n op args} {
687c8765 2664 # global viewhlmenu
908c3585 2665
3cd204e5 2666 doviewmenu .bar.view 5 [list showview $n] $op $args
687c8765 2667 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
d16c0812
PM
2668}
2669
2670proc newviewok {top n} {
da7c24dd 2671 global nextviewnum newviewperm newviewname newishighlight
d16c0812 2672 global viewname viewfiles viewperm selectedview curview
908c3585 2673 global viewargs newviewargs viewhlmenu
50b44ece 2674
098dd8a3
PM
2675 if {[catch {
2676 set newargs [shellsplit $newviewargs($n)]
2677 } err]} {
d990cedf 2678 error_popup "[mc "Error in commit selection arguments:"] $err"
098dd8a3
PM
2679 wm raise $top
2680 focus $top
2681 return
2682 }
50b44ece 2683 set files {}
d16c0812 2684 foreach f [split [$top.t get 0.0 end] "\n"] {
50b44ece
PM
2685 set ft [string trim $f]
2686 if {$ft ne {}} {
2687 lappend files $ft
2688 }
2689 }
d16c0812
PM
2690 if {![info exists viewfiles($n)]} {
2691 # creating a new view
2692 incr nextviewnum
2693 set viewname($n) $newviewname($n)
2694 set viewperm($n) $newviewperm($n)
2695 set viewfiles($n) $files
098dd8a3 2696 set viewargs($n) $newargs
da7c24dd
PM
2697 addviewmenu $n
2698 if {!$newishighlight} {
7eb3cb9c 2699 run showview $n
da7c24dd 2700 } else {
7eb3cb9c 2701 run addvhighlight $n
da7c24dd 2702 }
d16c0812
PM
2703 } else {
2704 # editing an existing view
2705 set viewperm($n) $newviewperm($n)
2706 if {$newviewname($n) ne $viewname($n)} {
2707 set viewname($n) $newviewname($n)
3cd204e5 2708 doviewmenu .bar.view 5 [list showview $n] \
908c3585 2709 entryconf [list -label $viewname($n)]
687c8765
PM
2710 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2711 # entryconf [list -label $viewname($n) -value $viewname($n)]
d16c0812 2712 }
098dd8a3 2713 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
d16c0812 2714 set viewfiles($n) $files
098dd8a3 2715 set viewargs($n) $newargs
d16c0812 2716 if {$curview == $n} {
7fcc92bf 2717 run reloadcommits
d16c0812
PM
2718 }
2719 }
2720 }
2721 catch {destroy $top}
50b44ece
PM
2722}
2723
2724proc delview {} {
7fcc92bf 2725 global curview viewperm hlview selectedhlview
50b44ece
PM
2726
2727 if {$curview == 0} return
908c3585 2728 if {[info exists hlview] && $hlview == $curview} {
b007ee20 2729 set selectedhlview [mc "None"]
908c3585
PM
2730 unset hlview
2731 }
da7c24dd 2732 allviewmenus $curview delete
a90a6d24 2733 set viewperm($curview) 0
50b44ece
PM
2734 showview 0
2735}
2736
da7c24dd 2737proc addviewmenu {n} {
908c3585 2738 global viewname viewhlmenu
da7c24dd
PM
2739
2740 .bar.view add radiobutton -label $viewname($n) \
2741 -command [list showview $n] -variable selectedview -value $n
687c8765
PM
2742 #$viewhlmenu add radiobutton -label $viewname($n) \
2743 # -command [list addvhighlight $n] -variable selectedhlview
da7c24dd
PM
2744}
2745
50b44ece 2746proc showview {n} {
9257d8f7 2747 global curview viewfiles cached_commitrow ordertok
f5f3c2e2 2748 global displayorder parentlist rowidlist rowisopt rowfinal
7fcc92bf
PM
2749 global colormap rowtextx nextcolor canvxmax
2750 global numcommits viewcomplete
50b44ece 2751 global selectedline currentid canv canvy0
4fb0fa19 2752 global treediffs
7fcc92bf 2753 global pending_select
0380081c 2754 global commitidx
e507fd48 2755 global selectedview selectfirst
97645683 2756 global hlview selectedhlview commitinterest
50b44ece
PM
2757
2758 if {$n == $curview} return
2759 set selid {}
7fcc92bf
PM
2760 set ymax [lindex [$canv cget -scrollregion] 3]
2761 set span [$canv yview]
2762 set ytop [expr {[lindex $span 0] * $ymax}]
2763 set ybot [expr {[lindex $span 1] * $ymax}]
2764 set yscreen [expr {($ybot - $ytop) / 2}]
50b44ece
PM
2765 if {[info exists selectedline]} {
2766 set selid $currentid
2767 set y [yc $selectedline]
50b44ece
PM
2768 if {$ytop < $y && $y < $ybot} {
2769 set yscreen [expr {$y - $ytop}]
50b44ece 2770 }
e507fd48
PM
2771 } elseif {[info exists pending_select]} {
2772 set selid $pending_select
2773 unset pending_select
50b44ece
PM
2774 }
2775 unselectline
fdedbcfb 2776 normalline
50b44ece
PM
2777 catch {unset treediffs}
2778 clear_display
908c3585
PM
2779 if {[info exists hlview] && $hlview == $n} {
2780 unset hlview
b007ee20 2781 set selectedhlview [mc "None"]
908c3585 2782 }
97645683 2783 catch {unset commitinterest}
7fcc92bf 2784 catch {unset cached_commitrow}
9257d8f7 2785 catch {unset ordertok}
50b44ece
PM
2786
2787 set curview $n
a90a6d24 2788 set selectedview $n
d990cedf
CS
2789 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2790 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
50b44ece 2791
df904497 2792 run refill_reflist
7fcc92bf 2793 if {![info exists viewcomplete($n)]} {
e507fd48
PM
2794 if {$selid ne {}} {
2795 set pending_select $selid
2796 }
a8aaf19c 2797 getcommits
50b44ece
PM
2798 return
2799 }
2800
7fcc92bf
PM
2801 set displayorder {}
2802 set parentlist {}
2803 set rowidlist {}
2804 set rowisopt {}
2805 set rowfinal {}
f5f3c2e2 2806 set numcommits $commitidx($n)
22626ef4 2807
50b44ece
PM
2808 catch {unset colormap}
2809 catch {unset rowtextx}
da7c24dd
PM
2810 set nextcolor 0
2811 set canvxmax [$canv cget -width]
50b44ece
PM
2812 set curview $n
2813 set row 0
50b44ece
PM
2814 setcanvscroll
2815 set yf 0
e507fd48
PM
2816 set row {}
2817 set selectfirst 0
7fcc92bf
PM
2818 if {$selid ne {} && [commitinview $selid $n]} {
2819 set row [rowofcommit $selid]
50b44ece
PM
2820 # try to get the selected row in the same position on the screen
2821 set ymax [lindex [$canv cget -scrollregion] 3]
2822 set ytop [expr {[yc $row] - $yscreen}]
2823 if {$ytop < 0} {
2824 set ytop 0
2825 }
2826 set yf [expr {$ytop * 1.0 / $ymax}]
2827 }
2828 allcanvs yview moveto $yf
2829 drawvisible
e507fd48
PM
2830 if {$row ne {}} {
2831 selectline $row 0
2832 } elseif {$selid ne {}} {
2833 set pending_select $selid
2834 } else {
8f489363 2835 set row [first_real_row]
219ea3a9
PM
2836 if {$row < $numcommits} {
2837 selectline $row 0
e507fd48
PM
2838 } else {
2839 set selectfirst 1
2840 }
2841 }
7fcc92bf
PM
2842 if {!$viewcomplete($n)} {
2843 if {$numcommits == 0} {
d990cedf 2844 show_status [mc "Reading commits..."]
d16c0812 2845 }
098dd8a3 2846 } elseif {$numcommits == 0} {
d990cedf 2847 show_status [mc "No commits selected"]
2516dae2 2848 }
50b44ece
PM
2849}
2850
908c3585
PM
2851# Stuff relating to the highlighting facility
2852
2853proc ishighlighted {row} {
164ff275 2854 global vhighlights fhighlights nhighlights rhighlights
908c3585
PM
2855
2856 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2857 return $nhighlights($row)
2858 }
2859 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2860 return $vhighlights($row)
2861 }
2862 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2863 return $fhighlights($row)
2864 }
164ff275
PM
2865 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2866 return $rhighlights($row)
2867 }
908c3585
PM
2868 return 0
2869}
2870
2871proc bolden {row font} {
4e7d6779 2872 global canv linehtag selectedline boldrows
908c3585 2873
4e7d6779 2874 lappend boldrows $row
908c3585 2875 $canv itemconf $linehtag($row) -font $font
5864c08f 2876 if {[info exists selectedline] && $row == $selectedline} {
908c3585
PM
2877 $canv delete secsel
2878 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2879 -outline {{}} -tags secsel \
2880 -fill [$canv cget -selectbackground]]
2881 $canv lower $t
2882 }
2883}
2884
2885proc bolden_name {row font} {
4e7d6779 2886 global canv2 linentag selectedline boldnamerows
908c3585 2887
4e7d6779 2888 lappend boldnamerows $row
908c3585 2889 $canv2 itemconf $linentag($row) -font $font
5864c08f 2890 if {[info exists selectedline] && $row == $selectedline} {
908c3585
PM
2891 $canv2 delete secsel
2892 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2893 -outline {{}} -tags secsel \
2894 -fill [$canv2 cget -selectbackground]]
2895 $canv2 lower $t
2896 }
2897}
2898
4e7d6779 2899proc unbolden {} {
9c311b32 2900 global boldrows
908c3585 2901
4e7d6779
PM
2902 set stillbold {}
2903 foreach row $boldrows {
908c3585 2904 if {![ishighlighted $row]} {
9c311b32 2905 bolden $row mainfont
4e7d6779
PM
2906 } else {
2907 lappend stillbold $row
908c3585
PM
2908 }
2909 }
4e7d6779 2910 set boldrows $stillbold
908c3585
PM
2911}
2912
2913proc addvhighlight {n} {
7fcc92bf 2914 global hlview viewcomplete curview vhl_done vhighlights commitidx
da7c24dd
PM
2915
2916 if {[info exists hlview]} {
908c3585 2917 delvhighlight
da7c24dd
PM
2918 }
2919 set hlview $n
7fcc92bf 2920 if {$n != $curview && ![info exists viewcomplete($n)]} {
da7c24dd 2921 start_rev_list $n
908c3585
PM
2922 }
2923 set vhl_done $commitidx($hlview)
2924 if {$vhl_done > 0} {
2925 drawvisible
da7c24dd
PM
2926 }
2927}
2928
908c3585
PM
2929proc delvhighlight {} {
2930 global hlview vhighlights
da7c24dd
PM
2931
2932 if {![info exists hlview]} return
2933 unset hlview
4e7d6779
PM
2934 catch {unset vhighlights}
2935 unbolden
da7c24dd
PM
2936}
2937
908c3585 2938proc vhighlightmore {} {
7fcc92bf 2939 global hlview vhl_done commitidx vhighlights curview
da7c24dd 2940
da7c24dd 2941 set max $commitidx($hlview)
908c3585
PM
2942 set vr [visiblerows]
2943 set r0 [lindex $vr 0]
2944 set r1 [lindex $vr 1]
2945 for {set i $vhl_done} {$i < $max} {incr i} {
7fcc92bf
PM
2946 set id [commitonrow $i $hlview]
2947 if {[commitinview $id $curview]} {
2948 set row [rowofcommit $id]
908c3585
PM
2949 if {$r0 <= $row && $row <= $r1} {
2950 if {![highlighted $row]} {
9c311b32 2951 bolden $row mainfontbold
da7c24dd 2952 }
908c3585 2953 set vhighlights($row) 1
da7c24dd
PM
2954 }
2955 }
2956 }
908c3585
PM
2957 set vhl_done $max
2958}
2959
2960proc askvhighlight {row id} {
7fcc92bf 2961 global hlview vhighlights iddrawn
908c3585 2962
7fcc92bf 2963 if {[commitinview $id $hlview]} {
908c3585 2964 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
9c311b32 2965 bolden $row mainfontbold
908c3585
PM
2966 }
2967 set vhighlights($row) 1
2968 } else {
2969 set vhighlights($row) 0
2970 }
2971}
2972
687c8765 2973proc hfiles_change {} {
908c3585 2974 global highlight_files filehighlight fhighlights fh_serial
9c311b32 2975 global highlight_paths gdttype
908c3585
PM
2976
2977 if {[info exists filehighlight]} {
2978 # delete previous highlights
2979 catch {close $filehighlight}
2980 unset filehighlight
4e7d6779
PM
2981 catch {unset fhighlights}
2982 unbolden
63b79191 2983 unhighlight_filelist
908c3585 2984 }
63b79191 2985 set highlight_paths {}
908c3585
PM
2986 after cancel do_file_hl $fh_serial
2987 incr fh_serial
2988 if {$highlight_files ne {}} {
2989 after 300 do_file_hl $fh_serial
2990 }
2991}
2992
687c8765
PM
2993proc gdttype_change {name ix op} {
2994 global gdttype highlight_files findstring findpattern
2995
bb3edc8b 2996 stopfinding
687c8765 2997 if {$findstring ne {}} {
b007ee20 2998 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
2999 if {$highlight_files ne {}} {
3000 set highlight_files {}
3001 hfiles_change
3002 }
3003 findcom_change
3004 } else {
3005 if {$findpattern ne {}} {
3006 set findpattern {}
3007 findcom_change
3008 }
3009 set highlight_files $findstring
3010 hfiles_change
3011 }
3012 drawvisible
3013 }
3014 # enable/disable findtype/findloc menus too
3015}
3016
3017proc find_change {name ix op} {
3018 global gdttype findstring highlight_files
3019
bb3edc8b 3020 stopfinding
b007ee20 3021 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
3022 findcom_change
3023 } else {
3024 if {$highlight_files ne $findstring} {
3025 set highlight_files $findstring
3026 hfiles_change
3027 }
3028 }
3029 drawvisible
3030}
3031
64b5f146 3032proc findcom_change args {
9c311b32 3033 global nhighlights boldnamerows
687c8765
PM
3034 global findpattern findtype findstring gdttype
3035
bb3edc8b 3036 stopfinding
687c8765
PM
3037 # delete previous highlights, if any
3038 foreach row $boldnamerows {
9c311b32 3039 bolden_name $row mainfont
687c8765
PM
3040 }
3041 set boldnamerows {}
3042 catch {unset nhighlights}
3043 unbolden
3044 unmarkmatches
b007ee20 3045 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
687c8765 3046 set findpattern {}
b007ee20 3047 } elseif {$findtype eq [mc "Regexp"]} {
687c8765
PM
3048 set findpattern $findstring
3049 } else {
3050 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3051 $findstring]
3052 set findpattern "*$e*"
3053 }
3054}
3055
63b79191
PM
3056proc makepatterns {l} {
3057 set ret {}
3058 foreach e $l {
3059 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3060 if {[string index $ee end] eq "/"} {
3061 lappend ret "$ee*"
3062 } else {
3063 lappend ret $ee
3064 lappend ret "$ee/*"
3065 }
3066 }
3067 return $ret
3068}
3069
908c3585 3070proc do_file_hl {serial} {
4e7d6779 3071 global highlight_files filehighlight highlight_paths gdttype fhl_list
908c3585 3072
b007ee20 3073 if {$gdttype eq [mc "touching paths:"]} {
60f7a7dc
PM
3074 if {[catch {set paths [shellsplit $highlight_files]}]} return
3075 set highlight_paths [makepatterns $paths]
3076 highlight_filelist
3077 set gdtargs [concat -- $paths]
b007ee20 3078 } elseif {$gdttype eq [mc "adding/removing string:"]} {
60f7a7dc 3079 set gdtargs [list "-S$highlight_files"]
687c8765
PM
3080 } else {
3081 # must be "containing:", i.e. we're searching commit info
3082 return
60f7a7dc 3083 }
1ce09dd6 3084 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
908c3585
PM
3085 set filehighlight [open $cmd r+]
3086 fconfigure $filehighlight -blocking 0
7eb3cb9c 3087 filerun $filehighlight readfhighlight
4e7d6779 3088 set fhl_list {}
908c3585
PM
3089 drawvisible
3090 flushhighlights
3091}
3092
3093proc flushhighlights {} {
4e7d6779 3094 global filehighlight fhl_list
908c3585
PM
3095
3096 if {[info exists filehighlight]} {
4e7d6779 3097 lappend fhl_list {}
908c3585
PM
3098 puts $filehighlight ""
3099 flush $filehighlight
3100 }
3101}
3102
3103proc askfilehighlight {row id} {
4e7d6779 3104 global filehighlight fhighlights fhl_list
908c3585 3105
4e7d6779
PM
3106 lappend fhl_list $id
3107 set fhighlights($row) -1
908c3585
PM
3108 puts $filehighlight $id
3109}
3110
3111proc readfhighlight {} {
7fcc92bf 3112 global filehighlight fhighlights curview iddrawn
687c8765 3113 global fhl_list find_dirn
4e7d6779 3114
7eb3cb9c
PM
3115 if {![info exists filehighlight]} {
3116 return 0
3117 }
3118 set nr 0
3119 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4e7d6779
PM
3120 set line [string trim $line]
3121 set i [lsearch -exact $fhl_list $line]
3122 if {$i < 0} continue
3123 for {set j 0} {$j < $i} {incr j} {
3124 set id [lindex $fhl_list $j]
7fcc92bf
PM
3125 if {[commitinview $id $curview]} {
3126 set fhighlights([rowofcommit $id]) 0
4e7d6779 3127 }
908c3585 3128 }
4e7d6779
PM
3129 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3130 if {$line eq {}} continue
7fcc92bf
PM
3131 if {![commitinview $line $curview]} continue
3132 set row [rowofcommit $line]
4e7d6779 3133 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
9c311b32 3134 bolden $row mainfontbold
4e7d6779
PM
3135 }
3136 set fhighlights($row) 1
908c3585 3137 }
4e7d6779
PM
3138 if {[eof $filehighlight]} {
3139 # strange...
1ce09dd6 3140 puts "oops, git diff-tree died"
4e7d6779
PM
3141 catch {close $filehighlight}
3142 unset filehighlight
7eb3cb9c 3143 return 0
908c3585 3144 }
687c8765 3145 if {[info exists find_dirn]} {
cca5d946 3146 run findmore
908c3585 3147 }
687c8765 3148 return 1
908c3585
PM
3149}
3150
4fb0fa19 3151proc doesmatch {f} {
687c8765 3152 global findtype findpattern
4fb0fa19 3153
b007ee20 3154 if {$findtype eq [mc "Regexp"]} {
687c8765 3155 return [regexp $findpattern $f]
b007ee20 3156 } elseif {$findtype eq [mc "IgnCase"]} {
4fb0fa19
PM
3157 return [string match -nocase $findpattern $f]
3158 } else {
3159 return [string match $findpattern $f]
3160 }
3161}
3162
60f7a7dc 3163proc askfindhighlight {row id} {
9c311b32 3164 global nhighlights commitinfo iddrawn
4fb0fa19
PM
3165 global findloc
3166 global markingmatches
908c3585
PM
3167
3168 if {![info exists commitinfo($id)]} {
3169 getcommit $id
3170 }
60f7a7dc 3171 set info $commitinfo($id)
908c3585 3172 set isbold 0
b007ee20 3173 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
60f7a7dc 3174 foreach f $info ty $fldtypes {
b007ee20 3175 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4fb0fa19 3176 [doesmatch $f]} {
b007ee20 3177 if {$ty eq [mc "Author"]} {
60f7a7dc 3178 set isbold 2
4fb0fa19 3179 break
60f7a7dc 3180 }
4fb0fa19 3181 set isbold 1
908c3585
PM
3182 }
3183 }
4fb0fa19 3184 if {$isbold && [info exists iddrawn($id)]} {
4fb0fa19 3185 if {![ishighlighted $row]} {
9c311b32 3186 bolden $row mainfontbold
4fb0fa19 3187 if {$isbold > 1} {
9c311b32 3188 bolden_name $row mainfontbold
4fb0fa19 3189 }
908c3585 3190 }
4fb0fa19 3191 if {$markingmatches} {
005a2f4e 3192 markrowmatches $row $id
908c3585
PM
3193 }
3194 }
3195 set nhighlights($row) $isbold
da7c24dd
PM
3196}
3197
005a2f4e
PM
3198proc markrowmatches {row id} {
3199 global canv canv2 linehtag linentag commitinfo findloc
4fb0fa19 3200
005a2f4e
PM
3201 set headline [lindex $commitinfo($id) 0]
3202 set author [lindex $commitinfo($id) 1]
4fb0fa19
PM
3203 $canv delete match$row
3204 $canv2 delete match$row
b007ee20 3205 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
005a2f4e
PM
3206 set m [findmatches $headline]
3207 if {$m ne {}} {
3208 markmatches $canv $row $headline $linehtag($row) $m \
3209 [$canv itemcget $linehtag($row) -font] $row
3210 }
4fb0fa19 3211 }
b007ee20 3212 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
005a2f4e
PM
3213 set m [findmatches $author]
3214 if {$m ne {}} {
3215 markmatches $canv2 $row $author $linentag($row) $m \
3216 [$canv2 itemcget $linentag($row) -font] $row
3217 }
4fb0fa19
PM
3218 }
3219}
3220
164ff275
PM
3221proc vrel_change {name ix op} {
3222 global highlight_related
3223
3224 rhighlight_none
b007ee20 3225 if {$highlight_related ne [mc "None"]} {
7eb3cb9c 3226 run drawvisible
164ff275
PM
3227 }
3228}
3229
3230# prepare for testing whether commits are descendents or ancestors of a
3231proc rhighlight_sel {a} {
3232 global descendent desc_todo ancestor anc_todo
3233 global highlight_related rhighlights
3234
3235 catch {unset descendent}
3236 set desc_todo [list $a]
3237 catch {unset ancestor}
3238 set anc_todo [list $a]
b007ee20 3239 if {$highlight_related ne [mc "None"]} {
164ff275 3240 rhighlight_none
7eb3cb9c 3241 run drawvisible
164ff275
PM
3242 }
3243}
3244
3245proc rhighlight_none {} {
3246 global rhighlights
3247
4e7d6779
PM
3248 catch {unset rhighlights}
3249 unbolden
164ff275
PM
3250}
3251
3252proc is_descendent {a} {
7fcc92bf 3253 global curview children descendent desc_todo
164ff275
PM
3254
3255 set v $curview
7fcc92bf 3256 set la [rowofcommit $a]
164ff275
PM
3257 set todo $desc_todo
3258 set leftover {}
3259 set done 0
3260 for {set i 0} {$i < [llength $todo]} {incr i} {
3261 set do [lindex $todo $i]
7fcc92bf 3262 if {[rowofcommit $do] < $la} {
164ff275
PM
3263 lappend leftover $do
3264 continue
3265 }
3266 foreach nk $children($v,$do) {
3267 if {![info exists descendent($nk)]} {
3268 set descendent($nk) 1
3269 lappend todo $nk
3270 if {$nk eq $a} {
3271 set done 1
3272 }
3273 }
3274 }
3275 if {$done} {
3276 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3277 return
3278 }
3279 }
3280 set descendent($a) 0
3281 set desc_todo $leftover
3282}
3283
3284proc is_ancestor {a} {
7fcc92bf 3285 global curview parents ancestor anc_todo
164ff275
PM
3286
3287 set v $curview
7fcc92bf 3288 set la [rowofcommit $a]
164ff275
PM
3289 set todo $anc_todo
3290 set leftover {}
3291 set done 0
3292 for {set i 0} {$i < [llength $todo]} {incr i} {
3293 set do [lindex $todo $i]
7fcc92bf 3294 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
164ff275
PM
3295 lappend leftover $do
3296 continue
3297 }
7fcc92bf 3298 foreach np $parents($v,$do) {
164ff275
PM
3299 if {![info exists ancestor($np)]} {
3300 set ancestor($np) 1
3301 lappend todo $np
3302 if {$np eq $a} {
3303 set done 1
3304 }
3305 }
3306 }
3307 if {$done} {
3308 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3309 return
3310 }
3311 }
3312 set ancestor($a) 0
3313 set anc_todo $leftover
3314}
3315
3316proc askrelhighlight {row id} {
9c311b32 3317 global descendent highlight_related iddrawn rhighlights
164ff275
PM
3318 global selectedline ancestor
3319
3320 if {![info exists selectedline]} return
3321 set isbold 0
b007ee20
CS
3322 if {$highlight_related eq [mc "Descendent"] ||
3323 $highlight_related eq [mc "Not descendent"]} {
164ff275
PM
3324 if {![info exists descendent($id)]} {
3325 is_descendent $id
3326 }
b007ee20 3327 if {$descendent($id) == ($highlight_related eq [mc "Descendent"])} {
164ff275
PM
3328 set isbold 1
3329 }
b007ee20
CS
3330 } elseif {$highlight_related eq [mc "Ancestor"] ||
3331 $highlight_related eq [mc "Not ancestor"]} {
164ff275
PM
3332 if {![info exists ancestor($id)]} {
3333 is_ancestor $id
3334 }
b007ee20 3335 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
164ff275
PM
3336 set isbold 1
3337 }
3338 }
3339 if {[info exists iddrawn($id)]} {
3340 if {$isbold && ![ishighlighted $row]} {
9c311b32 3341 bolden $row mainfontbold
164ff275
PM
3342 }
3343 }
3344 set rhighlights($row) $isbold
3345}
3346
da7c24dd
PM
3347# Graph layout functions
3348
9f1afe05
PM
3349proc shortids {ids} {
3350 set res {}
3351 foreach id $ids {
3352 if {[llength $id] > 1} {
3353 lappend res [shortids $id]
3354 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3355 lappend res [string range $id 0 7]
3356 } else {
3357 lappend res $id
3358 }
3359 }
3360 return $res
3361}
3362
9f1afe05
PM
3363proc ntimes {n o} {
3364 set ret {}
0380081c
PM
3365 set o [list $o]
3366 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3367 if {($n & $mask) != 0} {
3368 set ret [concat $ret $o]
9f1afe05 3369 }
0380081c 3370 set o [concat $o $o]
9f1afe05 3371 }
0380081c 3372 return $ret
9f1afe05
PM
3373}
3374
9257d8f7
PM
3375proc ordertoken {id} {
3376 global ordertok curview varcid varcstart varctok curview parents children
3377 global nullid nullid2
3378
3379 if {[info exists ordertok($id)]} {
3380 return $ordertok($id)
3381 }
3382 set origid $id
3383 set todo {}
3384 while {1} {
3385 if {[info exists varcid($curview,$id)]} {
3386 set a $varcid($curview,$id)
3387 set p [lindex $varcstart($curview) $a]
3388 } else {
3389 set p [lindex $children($curview,$id) 0]
3390 }
3391 if {[info exists ordertok($p)]} {
3392 set tok $ordertok($p)
3393 break
3394 }
c8c9f3d9
PM
3395 set id [first_real_child $curview,$p]
3396 if {$id eq {}} {
9257d8f7
PM
3397 # it's a root
3398 set tok [lindex $varctok($curview) $a]
3399 break
3400 }
9257d8f7
PM
3401 if {[llength $parents($curview,$id)] == 1} {
3402 lappend todo [list $p {}]
3403 } else {
3404 set j [lsearch -exact $parents($curview,$id) $p]
3405 if {$j < 0} {
3406 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3407 }
3408 lappend todo [list $p [strrep $j]]
3409 }
3410 }
3411 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3412 set p [lindex $todo $i 0]
3413 append tok [lindex $todo $i 1]
3414 set ordertok($p) $tok
3415 }
3416 set ordertok($origid) $tok
3417 return $tok
3418}
3419
6e8c8707
PM
3420# Work out where id should go in idlist so that order-token
3421# values increase from left to right
3422proc idcol {idlist id {i 0}} {
9257d8f7 3423 set t [ordertoken $id]
e5b37ac1
PM
3424 if {$i < 0} {
3425 set i 0
3426 }
9257d8f7 3427 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
6e8c8707
PM
3428 if {$i > [llength $idlist]} {
3429 set i [llength $idlist]
9f1afe05 3430 }
9257d8f7 3431 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
6e8c8707
PM
3432 incr i
3433 } else {
9257d8f7 3434 if {$t > [ordertoken [lindex $idlist $i]]} {
6e8c8707 3435 while {[incr i] < [llength $idlist] &&
9257d8f7 3436 $t >= [ordertoken [lindex $idlist $i]]} {}
9f1afe05 3437 }
9f1afe05 3438 }
6e8c8707 3439 return $i
9f1afe05
PM
3440}
3441
3442proc initlayout {} {
7fcc92bf 3443 global rowidlist rowisopt rowfinal displayorder parentlist
da7c24dd 3444 global numcommits canvxmax canv
8f7d0cec 3445 global nextcolor
da7c24dd 3446 global colormap rowtextx
322a8cc9 3447 global selectfirst
9f1afe05 3448
8f7d0cec
PM
3449 set numcommits 0
3450 set displayorder {}
79b2c75e 3451 set parentlist {}
8f7d0cec 3452 set nextcolor 0
0380081c
PM
3453 set rowidlist {}
3454 set rowisopt {}
f5f3c2e2 3455 set rowfinal {}
be0cd098 3456 set canvxmax [$canv cget -width]
50b44ece
PM
3457 catch {unset colormap}
3458 catch {unset rowtextx}
e507fd48 3459 set selectfirst 1
be0cd098
PM
3460}
3461
3462proc setcanvscroll {} {
3463 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3464
3465 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3466 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3467 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3468 $canv3 conf -scrollregion [list 0 0 0 $ymax]
9f1afe05
PM
3469}
3470
3471proc visiblerows {} {
3472 global canv numcommits linespc
3473
3474 set ymax [lindex [$canv cget -scrollregion] 3]
3475 if {$ymax eq {} || $ymax == 0} return
3476 set f [$canv yview]
3477 set y0 [expr {int([lindex $f 0] * $ymax)}]
3478 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3479 if {$r0 < 0} {
3480 set r0 0
3481 }
3482 set y1 [expr {int([lindex $f 1] * $ymax)}]
3483 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3484 if {$r1 >= $numcommits} {
3485 set r1 [expr {$numcommits - 1}]
3486 }
3487 return [list $r0 $r1]
3488}
3489
f5f3c2e2 3490proc layoutmore {} {
38dfe939 3491 global commitidx viewcomplete curview
7fcc92bf 3492 global numcommits pending_select selectedline curview
38dfe939 3493 global selectfirst lastscrollset commitinterest
9f1afe05 3494
38dfe939
PM
3495 set canshow $commitidx($curview)
3496 if {$canshow <= $numcommits && !$viewcomplete($curview)} return
8f7d0cec 3497 if {$numcommits == 0} {
8f7d0cec
PM
3498 allcanvs delete all
3499 }
322a8cc9 3500 set r0 $numcommits
a2c22362 3501 set prev $numcommits
9f1afe05 3502 set numcommits $canshow
a2c22362 3503 set t [clock clicks -milliseconds]
38dfe939 3504 if {$prev < 100 || $viewcomplete($curview) || $t - $lastscrollset > 500} {
a2c22362
PM
3505 set lastscrollset $t
3506 setcanvscroll
3507 }
9f1afe05 3508 set rows [visiblerows]
9f1afe05 3509 set r1 [lindex $rows 1]
322a8cc9
PM
3510 if {$r1 >= $canshow} {
3511 set r1 [expr {$canshow - 1}]
9f1afe05 3512 }
322a8cc9
PM
3513 if {$r0 <= $r1} {
3514 drawcommits $r0 $r1
9f1afe05 3515 }
d94f8cd6 3516 if {[info exists pending_select] &&
7fcc92bf
PM
3517 [commitinview $pending_select $curview]} {
3518 selectline [rowofcommit $pending_select] 1
d94f8cd6 3519 }
e507fd48
PM
3520 if {$selectfirst} {
3521 if {[info exists selectedline] || [info exists pending_select]} {
3522 set selectfirst 0
3523 } else {
8f489363 3524 set l [first_real_row]
219ea3a9 3525 selectline $l 1
e507fd48
PM
3526 set selectfirst 0
3527 }
fdedbcfb 3528 }
219ea3a9
PM
3529}
3530
3531proc doshowlocalchanges {} {
38dfe939 3532 global curview mainheadid
219ea3a9 3533
7fcc92bf 3534 if {[commitinview $mainheadid $curview]} {
219ea3a9 3535 dodiffindex
38dfe939
PM
3536 } else {
3537 lappend commitinterest($mainheadid) {dodiffindex}
219ea3a9
PM
3538 }
3539}
3540
3541proc dohidelocalchanges {} {
7fcc92bf 3542 global nullid nullid2 lserial curview
219ea3a9 3543
7fcc92bf
PM
3544 if {[commitinview $nullid $curview]} {
3545 removerow $nullid $curview
8f489363 3546 }
7fcc92bf
PM
3547 if {[commitinview $nullid2 $curview]} {
3548 removerow $nullid2 $curview
219ea3a9
PM
3549 }
3550 incr lserial
3551}
3552
8f489363 3553# spawn off a process to do git diff-index --cached HEAD
219ea3a9 3554proc dodiffindex {} {
7fcc92bf 3555 global lserial showlocalchanges
219ea3a9 3556
3e6b893f 3557 if {!$showlocalchanges} return
219ea3a9 3558 incr lserial
8f489363 3559 set fd [open "|git diff-index --cached HEAD" r]
219ea3a9
PM
3560 fconfigure $fd -blocking 0
3561 filerun $fd [list readdiffindex $fd $lserial]
3562}
3563
3564proc readdiffindex {fd serial} {
fc2a256f 3565 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
219ea3a9 3566
8f489363 3567 set isdiff 1
219ea3a9 3568 if {[gets $fd line] < 0} {
8f489363
PM
3569 if {![eof $fd]} {
3570 return 1
219ea3a9 3571 }
8f489363 3572 set isdiff 0
219ea3a9
PM
3573 }
3574 # we only need to see one line and we don't really care what it says...
3575 close $fd
3576
24f7a667
PM
3577 if {$serial != $lserial} {
3578 return 0
8f489363
PM
3579 }
3580
24f7a667
PM
3581 # now see if there are any local changes not checked in to the index
3582 set fd [open "|git diff-files" r]
3583 fconfigure $fd -blocking 0
3584 filerun $fd [list readdifffiles $fd $serial]
3585
3586 if {$isdiff && ![commitinview $nullid2 $curview]} {
8f489363 3587 # add the line for the changes in the index to the graph
d990cedf 3588 set hl [mc "Local changes checked in to index but not committed"]
8f489363
PM
3589 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3590 set commitdata($nullid2) "\n $hl\n"
fc2a256f
PM
3591 if {[commitinview $nullid $curview]} {
3592 removerow $nullid $curview
3593 }
7fcc92bf 3594 insertrow $nullid2 $mainheadid $curview
24f7a667
PM
3595 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3596 removerow $nullid2 $curview
8f489363
PM
3597 }
3598 return 0
3599}
3600
3601proc readdifffiles {fd serial} {
7fcc92bf 3602 global mainheadid nullid nullid2 curview
8f489363
PM
3603 global commitinfo commitdata lserial
3604
3605 set isdiff 1
3606 if {[gets $fd line] < 0} {
3607 if {![eof $fd]} {
3608 return 1
3609 }
3610 set isdiff 0
3611 }
3612 # we only need to see one line and we don't really care what it says...
3613 close $fd
3614
24f7a667
PM
3615 if {$serial != $lserial} {
3616 return 0
3617 }
3618
3619 if {$isdiff && ![commitinview $nullid $curview]} {
219ea3a9 3620 # add the line for the local diff to the graph
d990cedf 3621 set hl [mc "Local uncommitted changes, not checked in to index"]
219ea3a9
PM
3622 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3623 set commitdata($nullid) "\n $hl\n"
7fcc92bf
PM
3624 if {[commitinview $nullid2 $curview]} {
3625 set p $nullid2
3626 } else {
3627 set p $mainheadid
3628 }
3629 insertrow $nullid $p $curview
24f7a667
PM
3630 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3631 removerow $nullid $curview
219ea3a9
PM
3632 }
3633 return 0
9f1afe05
PM
3634}
3635
8f0bc7e9 3636proc nextuse {id row} {
7fcc92bf 3637 global curview children
9f1afe05 3638
8f0bc7e9
PM
3639 if {[info exists children($curview,$id)]} {
3640 foreach kid $children($curview,$id) {
7fcc92bf 3641 if {![commitinview $kid $curview]} {
0380081c
PM
3642 return -1
3643 }
7fcc92bf
PM
3644 if {[rowofcommit $kid] > $row} {
3645 return [rowofcommit $kid]
9f1afe05 3646 }
9f1afe05 3647 }
8f0bc7e9 3648 }
7fcc92bf
PM
3649 if {[commitinview $id $curview]} {
3650 return [rowofcommit $id]
8f0bc7e9
PM
3651 }
3652 return -1
3653}
3654
f5f3c2e2 3655proc prevuse {id row} {
7fcc92bf 3656 global curview children
f5f3c2e2
PM
3657
3658 set ret -1
3659 if {[info exists children($curview,$id)]} {
3660 foreach kid $children($curview,$id) {
7fcc92bf
PM
3661 if {![commitinview $kid $curview]} break
3662 if {[rowofcommit $kid] < $row} {
3663 set ret [rowofcommit $kid]
7b459a1c 3664 }
7b459a1c 3665 }
f5f3c2e2
PM
3666 }
3667 return $ret
3668}
3669
0380081c
PM
3670proc make_idlist {row} {
3671 global displayorder parentlist uparrowlen downarrowlen mingaplen
9257d8f7 3672 global commitidx curview children
9f1afe05 3673
0380081c
PM
3674 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3675 if {$r < 0} {
3676 set r 0
8f0bc7e9 3677 }
0380081c
PM
3678 set ra [expr {$row - $downarrowlen}]
3679 if {$ra < 0} {
3680 set ra 0
3681 }
3682 set rb [expr {$row + $uparrowlen}]
3683 if {$rb > $commitidx($curview)} {
3684 set rb $commitidx($curview)
3685 }
7fcc92bf 3686 make_disporder $r [expr {$rb + 1}]
0380081c
PM
3687 set ids {}
3688 for {} {$r < $ra} {incr r} {
3689 set nextid [lindex $displayorder [expr {$r + 1}]]
3690 foreach p [lindex $parentlist $r] {
3691 if {$p eq $nextid} continue
3692 set rn [nextuse $p $r]
3693 if {$rn >= $row &&
3694 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
9257d8f7 3695 lappend ids [list [ordertoken $p] $p]
9f1afe05 3696 }
9f1afe05 3697 }
0380081c
PM
3698 }
3699 for {} {$r < $row} {incr r} {
3700 set nextid [lindex $displayorder [expr {$r + 1}]]
3701 foreach p [lindex $parentlist $r] {
3702 if {$p eq $nextid} continue
3703 set rn [nextuse $p $r]
3704 if {$rn < 0 || $rn >= $row} {
9257d8f7 3705 lappend ids [list [ordertoken $p] $p]
9f1afe05 3706 }
9f1afe05 3707 }
0380081c
PM
3708 }
3709 set id [lindex $displayorder $row]
9257d8f7 3710 lappend ids [list [ordertoken $id] $id]
0380081c
PM
3711 while {$r < $rb} {
3712 foreach p [lindex $parentlist $r] {
3713 set firstkid [lindex $children($curview,$p) 0]
7fcc92bf 3714 if {[rowofcommit $firstkid] < $row} {
9257d8f7 3715 lappend ids [list [ordertoken $p] $p]
9f1afe05 3716 }
9f1afe05 3717 }
0380081c
PM
3718 incr r
3719 set id [lindex $displayorder $r]
3720 if {$id ne {}} {
3721 set firstkid [lindex $children($curview,$id) 0]
7fcc92bf 3722 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
9257d8f7 3723 lappend ids [list [ordertoken $id] $id]
0380081c 3724 }
9f1afe05 3725 }
9f1afe05 3726 }
0380081c
PM
3727 set idlist {}
3728 foreach idx [lsort -unique $ids] {
3729 lappend idlist [lindex $idx 1]
3730 }
3731 return $idlist
9f1afe05
PM
3732}
3733
f5f3c2e2
PM
3734proc rowsequal {a b} {
3735 while {[set i [lsearch -exact $a {}]] >= 0} {
3736 set a [lreplace $a $i $i]
3737 }
3738 while {[set i [lsearch -exact $b {}]] >= 0} {
3739 set b [lreplace $b $i $i]
3740 }
3741 return [expr {$a eq $b}]
9f1afe05
PM
3742}
3743
f5f3c2e2
PM
3744proc makeupline {id row rend col} {
3745 global rowidlist uparrowlen downarrowlen mingaplen
9f1afe05 3746
f5f3c2e2
PM
3747 for {set r $rend} {1} {set r $rstart} {
3748 set rstart [prevuse $id $r]
3749 if {$rstart < 0} return
3750 if {$rstart < $row} break
3751 }
3752 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3753 set rstart [expr {$rend - $uparrowlen - 1}]
79b2c75e 3754 }
f5f3c2e2
PM
3755 for {set r $rstart} {[incr r] <= $row} {} {
3756 set idlist [lindex $rowidlist $r]
3757 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3758 set col [idcol $idlist $id $col]
3759 lset rowidlist $r [linsert $idlist $col $id]
3760 changedrow $r
3761 }
9f1afe05
PM
3762 }
3763}
3764
0380081c 3765proc layoutrows {row endrow} {
f5f3c2e2 3766 global rowidlist rowisopt rowfinal displayorder
0380081c
PM
3767 global uparrowlen downarrowlen maxwidth mingaplen
3768 global children parentlist
7fcc92bf 3769 global commitidx viewcomplete curview
9f1afe05 3770
7fcc92bf 3771 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
0380081c
PM
3772 set idlist {}
3773 if {$row > 0} {
f56782ae
PM
3774 set rm1 [expr {$row - 1}]
3775 foreach id [lindex $rowidlist $rm1] {
0380081c
PM
3776 if {$id ne {}} {
3777 lappend idlist $id
3778 }
3779 }
f56782ae 3780 set final [lindex $rowfinal $rm1]
79b2c75e 3781 }
0380081c
PM
3782 for {} {$row < $endrow} {incr row} {
3783 set rm1 [expr {$row - 1}]
f56782ae 3784 if {$rm1 < 0 || $idlist eq {}} {
0380081c 3785 set idlist [make_idlist $row]
f5f3c2e2 3786 set final 1
0380081c
PM
3787 } else {
3788 set id [lindex $displayorder $rm1]
3789 set col [lsearch -exact $idlist $id]
3790 set idlist [lreplace $idlist $col $col]
3791 foreach p [lindex $parentlist $rm1] {
3792 if {[lsearch -exact $idlist $p] < 0} {
3793 set col [idcol $idlist $p $col]
3794 set idlist [linsert $idlist $col $p]
f5f3c2e2
PM
3795 # if not the first child, we have to insert a line going up
3796 if {$id ne [lindex $children($curview,$p) 0]} {
3797 makeupline $p $rm1 $row $col
3798 }
0380081c
PM
3799 }
3800 }
3801 set id [lindex $displayorder $row]
3802 if {$row > $downarrowlen} {
3803 set termrow [expr {$row - $downarrowlen - 1}]
3804 foreach p [lindex $parentlist $termrow] {
3805 set i [lsearch -exact $idlist $p]
3806 if {$i < 0} continue
3807 set nr [nextuse $p $termrow]
3808 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3809 set idlist [lreplace $idlist $i $i]
3810 }
3811 }
3812 }
3813 set col [lsearch -exact $idlist $id]
3814 if {$col < 0} {
3815 set col [idcol $idlist $id]
3816 set idlist [linsert $idlist $col $id]
f5f3c2e2
PM
3817 if {$children($curview,$id) ne {}} {
3818 makeupline $id $rm1 $row $col
3819 }
0380081c
PM
3820 }
3821 set r [expr {$row + $uparrowlen - 1}]
3822 if {$r < $commitidx($curview)} {
3823 set x $col
3824 foreach p [lindex $parentlist $r] {
3825 if {[lsearch -exact $idlist $p] >= 0} continue
3826 set fk [lindex $children($curview,$p) 0]
7fcc92bf 3827 if {[rowofcommit $fk] < $row} {
0380081c
PM
3828 set x [idcol $idlist $p $x]
3829 set idlist [linsert $idlist $x $p]
3830 }
3831 }
3832 if {[incr r] < $commitidx($curview)} {
3833 set p [lindex $displayorder $r]
3834 if {[lsearch -exact $idlist $p] < 0} {
3835 set fk [lindex $children($curview,$p) 0]
7fcc92bf 3836 if {$fk ne {} && [rowofcommit $fk] < $row} {
0380081c
PM
3837 set x [idcol $idlist $p $x]
3838 set idlist [linsert $idlist $x $p]
3839 }
3840 }
3841 }
3842 }
3843 }
f5f3c2e2
PM
3844 if {$final && !$viewcomplete($curview) &&
3845 $row + $uparrowlen + $mingaplen + $downarrowlen
3846 >= $commitidx($curview)} {
3847 set final 0
3848 }
0380081c
PM
3849 set l [llength $rowidlist]
3850 if {$row == $l} {
3851 lappend rowidlist $idlist
3852 lappend rowisopt 0
f5f3c2e2 3853 lappend rowfinal $final
0380081c 3854 } elseif {$row < $l} {
f5f3c2e2 3855 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
0380081c
PM
3856 lset rowidlist $row $idlist
3857 changedrow $row
3858 }
f56782ae 3859 lset rowfinal $row $final
0380081c 3860 } else {
f5f3c2e2
PM
3861 set pad [ntimes [expr {$row - $l}] {}]
3862 set rowidlist [concat $rowidlist $pad]
0380081c 3863 lappend rowidlist $idlist
f5f3c2e2
PM
3864 set rowfinal [concat $rowfinal $pad]
3865 lappend rowfinal $final
0380081c
PM
3866 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3867 }
9f1afe05 3868 }
0380081c 3869 return $row
9f1afe05
PM
3870}
3871
0380081c
PM
3872proc changedrow {row} {
3873 global displayorder iddrawn rowisopt need_redisplay
9f1afe05 3874
0380081c
PM
3875 set l [llength $rowisopt]
3876 if {$row < $l} {
3877 lset rowisopt $row 0
3878 if {$row + 1 < $l} {
3879 lset rowisopt [expr {$row + 1}] 0
3880 if {$row + 2 < $l} {
3881 lset rowisopt [expr {$row + 2}] 0
3882 }
3883 }
3884 }
3885 set id [lindex $displayorder $row]
3886 if {[info exists iddrawn($id)]} {
3887 set need_redisplay 1
9f1afe05
PM
3888 }
3889}
3890
3891proc insert_pad {row col npad} {
6e8c8707 3892 global rowidlist
9f1afe05
PM
3893
3894 set pad [ntimes $npad {}]
e341c06d
PM
3895 set idlist [lindex $rowidlist $row]
3896 set bef [lrange $idlist 0 [expr {$col - 1}]]
3897 set aft [lrange $idlist $col end]
3898 set i [lsearch -exact $aft {}]
3899 if {$i > 0} {
3900 set aft [lreplace $aft $i $i]
3901 }
3902 lset rowidlist $row [concat $bef $pad $aft]
0380081c 3903 changedrow $row
9f1afe05
PM
3904}
3905
3906proc optimize_rows {row col endrow} {
0380081c 3907 global rowidlist rowisopt displayorder curview children
9f1afe05 3908
6e8c8707
PM
3909 if {$row < 1} {
3910 set row 1
3911 }
0380081c
PM
3912 for {} {$row < $endrow} {incr row; set col 0} {
3913 if {[lindex $rowisopt $row]} continue
9f1afe05 3914 set haspad 0
6e8c8707
PM
3915 set y0 [expr {$row - 1}]
3916 set ym [expr {$row - 2}]
0380081c
PM
3917 set idlist [lindex $rowidlist $row]
3918 set previdlist [lindex $rowidlist $y0]
3919 if {$idlist eq {} || $previdlist eq {}} continue
3920 if {$ym >= 0} {
3921 set pprevidlist [lindex $rowidlist $ym]
3922 if {$pprevidlist eq {}} continue
3923 } else {
3924 set pprevidlist {}
3925 }
6e8c8707
PM
3926 set x0 -1
3927 set xm -1
3928 for {} {$col < [llength $idlist]} {incr col} {
3929 set id [lindex $idlist $col]
3930 if {[lindex $previdlist $col] eq $id} continue
3931 if {$id eq {}} {
9f1afe05
PM
3932 set haspad 1
3933 continue
3934 }
6e8c8707
PM
3935 set x0 [lsearch -exact $previdlist $id]
3936 if {$x0 < 0} continue
3937 set z [expr {$x0 - $col}]
9f1afe05 3938 set isarrow 0
6e8c8707
PM
3939 set z0 {}
3940 if {$ym >= 0} {
3941 set xm [lsearch -exact $pprevidlist $id]
3942 if {$xm >= 0} {
3943 set z0 [expr {$xm - $x0}]
3944 }
3945 }
9f1afe05 3946 if {$z0 eq {}} {
92ed666f
PM
3947 # if row y0 is the first child of $id then it's not an arrow
3948 if {[lindex $children($curview,$id) 0] ne
3949 [lindex $displayorder $y0]} {
9f1afe05
PM
3950 set isarrow 1
3951 }
3952 }
e341c06d
PM
3953 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3954 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3955 set isarrow 1
3956 }
3fc4279a
PM
3957 # Looking at lines from this row to the previous row,
3958 # make them go straight up if they end in an arrow on
3959 # the previous row; otherwise make them go straight up
3960 # or at 45 degrees.
9f1afe05 3961 if {$z < -1 || ($z < 0 && $isarrow)} {
3fc4279a
PM
3962 # Line currently goes left too much;
3963 # insert pads in the previous row, then optimize it
9f1afe05 3964 set npad [expr {-1 - $z + $isarrow}]
9f1afe05
PM
3965 insert_pad $y0 $x0 $npad
3966 if {$y0 > 0} {
3967 optimize_rows $y0 $x0 $row
3968 }
6e8c8707
PM
3969 set previdlist [lindex $rowidlist $y0]
3970 set x0 [lsearch -exact $previdlist $id]
3971 set z [expr {$x0 - $col}]
3972 if {$z0 ne {}} {
3973 set pprevidlist [lindex $rowidlist $ym]
3974 set xm [lsearch -exact $pprevidlist $id]
3975 set z0 [expr {$xm - $x0}]
3976 }
9f1afe05 3977 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3fc4279a 3978 # Line currently goes right too much;
6e8c8707 3979 # insert pads in this line
9f1afe05 3980 set npad [expr {$z - 1 + $isarrow}]
e341c06d
PM
3981 insert_pad $row $col $npad
3982 set idlist [lindex $rowidlist $row]
9f1afe05 3983 incr col $npad
6e8c8707 3984 set z [expr {$x0 - $col}]
9f1afe05
PM
3985 set haspad 1
3986 }
6e8c8707 3987 if {$z0 eq {} && !$isarrow && $ym >= 0} {
eb447a12 3988 # this line links to its first child on row $row-2
6e8c8707
PM
3989 set id [lindex $displayorder $ym]
3990 set xc [lsearch -exact $pprevidlist $id]
eb447a12
PM
3991 if {$xc >= 0} {
3992 set z0 [expr {$xc - $x0}]
3993 }
3994 }
3fc4279a 3995 # avoid lines jigging left then immediately right
9f1afe05
PM
3996 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3997 insert_pad $y0 $x0 1
6e8c8707
PM
3998 incr x0
3999 optimize_rows $y0 $x0 $row
4000 set previdlist [lindex $rowidlist $y0]
9f1afe05
PM
4001 }
4002 }
4003 if {!$haspad} {
3fc4279a 4004 # Find the first column that doesn't have a line going right
9f1afe05 4005 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
6e8c8707
PM
4006 set id [lindex $idlist $col]
4007 if {$id eq {}} break
4008 set x0 [lsearch -exact $previdlist $id]
4009 if {$x0 < 0} {
eb447a12 4010 # check if this is the link to the first child
92ed666f
PM
4011 set kid [lindex $displayorder $y0]
4012 if {[lindex $children($curview,$id) 0] eq $kid} {
eb447a12 4013 # it is, work out offset to child
92ed666f 4014 set x0 [lsearch -exact $previdlist $kid]
eb447a12
PM
4015 }
4016 }
6e8c8707 4017 if {$x0 <= $col} break
9f1afe05 4018 }
3fc4279a 4019 # Insert a pad at that column as long as it has a line and
6e8c8707
PM
4020 # isn't the last column
4021 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
9f1afe05 4022 set idlist [linsert $idlist $col {}]
0380081c
PM
4023 lset rowidlist $row $idlist
4024 changedrow $row
9f1afe05
PM
4025 }
4026 }
9f1afe05
PM
4027 }
4028}
4029
4030proc xc {row col} {
4031 global canvx0 linespc
4032 return [expr {$canvx0 + $col * $linespc}]
4033}
4034
4035proc yc {row} {
4036 global canvy0 linespc
4037 return [expr {$canvy0 + $row * $linespc}]
4038}
4039
c934a8a3
PM
4040proc linewidth {id} {
4041 global thickerline lthickness
4042
4043 set wid $lthickness
4044 if {[info exists thickerline] && $id eq $thickerline} {
4045 set wid [expr {2 * $lthickness}]
4046 }
4047 return $wid
4048}
4049
50b44ece 4050proc rowranges {id} {
7fcc92bf 4051 global curview children uparrowlen downarrowlen
92ed666f 4052 global rowidlist
50b44ece 4053
92ed666f
PM
4054 set kids $children($curview,$id)
4055 if {$kids eq {}} {
4056 return {}
66e46f37 4057 }
92ed666f
PM
4058 set ret {}
4059 lappend kids $id
4060 foreach child $kids {
7fcc92bf
PM
4061 if {![commitinview $child $curview]} break
4062 set row [rowofcommit $child]
92ed666f
PM
4063 if {![info exists prev]} {
4064 lappend ret [expr {$row + 1}]
322a8cc9 4065 } else {
92ed666f 4066 if {$row <= $prevrow} {
7fcc92bf 4067 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
92ed666f
PM
4068 }
4069 # see if the line extends the whole way from prevrow to row
4070 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4071 [lsearch -exact [lindex $rowidlist \
4072 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4073 # it doesn't, see where it ends
4074 set r [expr {$prevrow + $downarrowlen}]
4075 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4076 while {[incr r -1] > $prevrow &&
4077 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4078 } else {
4079 while {[incr r] <= $row &&
4080 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4081 incr r -1
4082 }
4083 lappend ret $r
4084 # see where it starts up again
4085 set r [expr {$row - $uparrowlen}]
4086 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4087 while {[incr r] < $row &&
4088 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4089 } else {
4090 while {[incr r -1] >= $prevrow &&
4091 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4092 incr r
4093 }
4094 lappend ret $r
4095 }
4096 }
4097 if {$child eq $id} {
4098 lappend ret $row
322a8cc9 4099 }
7fcc92bf 4100 set prev $child
92ed666f 4101 set prevrow $row
9f1afe05 4102 }
92ed666f 4103 return $ret
322a8cc9
PM
4104}
4105
4106proc drawlineseg {id row endrow arrowlow} {
4107 global rowidlist displayorder iddrawn linesegs
e341c06d 4108 global canv colormap linespc curview maxlinelen parentlist
322a8cc9
PM
4109
4110 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4111 set le [expr {$row + 1}]
4112 set arrowhigh 1
9f1afe05 4113 while {1} {
322a8cc9
PM
4114 set c [lsearch -exact [lindex $rowidlist $le] $id]
4115 if {$c < 0} {
4116 incr le -1
4117 break
4118 }
4119 lappend cols $c
4120 set x [lindex $displayorder $le]
4121 if {$x eq $id} {
4122 set arrowhigh 0
4123 break
9f1afe05 4124 }
322a8cc9
PM
4125 if {[info exists iddrawn($x)] || $le == $endrow} {
4126 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4127 if {$c >= 0} {
4128 lappend cols $c
4129 set arrowhigh 0
4130 }
4131 break
4132 }
4133 incr le
9f1afe05 4134 }
322a8cc9
PM
4135 if {$le <= $row} {
4136 return $row
4137 }
4138
4139 set lines {}
4140 set i 0
4141 set joinhigh 0
4142 if {[info exists linesegs($id)]} {
4143 set lines $linesegs($id)
4144 foreach li $lines {
4145 set r0 [lindex $li 0]
4146 if {$r0 > $row} {
4147 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4148 set joinhigh 1
4149 }
4150 break
4151 }
4152 incr i
4153 }
4154 }
4155 set joinlow 0
4156 if {$i > 0} {
4157 set li [lindex $lines [expr {$i-1}]]
4158 set r1 [lindex $li 1]
4159 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4160 set joinlow 1
4161 }
4162 }
4163
4164 set x [lindex $cols [expr {$le - $row}]]
4165 set xp [lindex $cols [expr {$le - 1 - $row}]]
4166 set dir [expr {$xp - $x}]
4167 if {$joinhigh} {
4168 set ith [lindex $lines $i 2]
4169 set coords [$canv coords $ith]
4170 set ah [$canv itemcget $ith -arrow]
4171 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4172 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4173 if {$x2 ne {} && $x - $x2 == $dir} {
4174 set coords [lrange $coords 0 end-2]
4175 }
4176 } else {
4177 set coords [list [xc $le $x] [yc $le]]
4178 }
4179 if {$joinlow} {
4180 set itl [lindex $lines [expr {$i-1}] 2]
4181 set al [$canv itemcget $itl -arrow]
4182 set arrowlow [expr {$al eq "last" || $al eq "both"}]
e341c06d
PM
4183 } elseif {$arrowlow} {
4184 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4185 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4186 set arrowlow 0
4187 }
322a8cc9
PM
4188 }
4189 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4190 for {set y $le} {[incr y -1] > $row} {} {
4191 set x $xp
4192 set xp [lindex $cols [expr {$y - 1 - $row}]]
4193 set ndir [expr {$xp - $x}]
4194 if {$dir != $ndir || $xp < 0} {
4195 lappend coords [xc $y $x] [yc $y]
4196 }
4197 set dir $ndir
4198 }
4199 if {!$joinlow} {
4200 if {$xp < 0} {
4201 # join parent line to first child
4202 set ch [lindex $displayorder $row]
4203 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4204 if {$xc < 0} {
4205 puts "oops: drawlineseg: child $ch not on row $row"
e341c06d
PM
4206 } elseif {$xc != $x} {
4207 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4208 set d [expr {int(0.5 * $linespc)}]
4209 set x1 [xc $row $x]
4210 if {$xc < $x} {
4211 set x2 [expr {$x1 - $d}]
4212 } else {
4213 set x2 [expr {$x1 + $d}]
4214 }
4215 set y2 [yc $row]
4216 set y1 [expr {$y2 + $d}]
4217 lappend coords $x1 $y1 $x2 $y2
4218 } elseif {$xc < $x - 1} {
322a8cc9
PM
4219 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4220 } elseif {$xc > $x + 1} {
4221 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4222 }
4223 set x $xc
eb447a12 4224 }
322a8cc9
PM
4225 lappend coords [xc $row $x] [yc $row]
4226 } else {
4227 set xn [xc $row $xp]
4228 set yn [yc $row]
e341c06d 4229 lappend coords $xn $yn
322a8cc9
PM
4230 }
4231 if {!$joinhigh} {
322a8cc9
PM
4232 assigncolor $id
4233 set t [$canv create line $coords -width [linewidth $id] \
4234 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4235 $canv lower $t
4236 bindline $t $id
4237 set lines [linsert $lines $i [list $row $le $t]]
4238 } else {
4239 $canv coords $ith $coords
4240 if {$arrow ne $ah} {
4241 $canv itemconf $ith -arrow $arrow
4242 }
4243 lset lines $i 0 $row
4244 }
4245 } else {
4246 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4247 set ndir [expr {$xo - $xp}]
4248 set clow [$canv coords $itl]
4249 if {$dir == $ndir} {
4250 set clow [lrange $clow 2 end]
4251 }
4252 set coords [concat $coords $clow]
4253 if {!$joinhigh} {
4254 lset lines [expr {$i-1}] 1 $le
322a8cc9
PM
4255 } else {
4256 # coalesce two pieces
4257 $canv delete $ith
4258 set b [lindex $lines [expr {$i-1}] 0]
4259 set e [lindex $lines $i 1]
4260 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4261 }
4262 $canv coords $itl $coords
4263 if {$arrow ne $al} {
4264 $canv itemconf $itl -arrow $arrow
879e8b1a
PM
4265 }
4266 }
322a8cc9
PM
4267
4268 set linesegs($id) $lines
4269 return $le
9f1afe05
PM
4270}
4271
322a8cc9
PM
4272proc drawparentlinks {id row} {
4273 global rowidlist canv colormap curview parentlist
513a54dc 4274 global idpos linespc
9f1afe05 4275
322a8cc9
PM
4276 set rowids [lindex $rowidlist $row]
4277 set col [lsearch -exact $rowids $id]
4278 if {$col < 0} return
4279 set olds [lindex $parentlist $row]
9f1afe05
PM
4280 set row2 [expr {$row + 1}]
4281 set x [xc $row $col]
4282 set y [yc $row]
4283 set y2 [yc $row2]
e341c06d 4284 set d [expr {int(0.5 * $linespc)}]
513a54dc 4285 set ymid [expr {$y + $d}]
8f7d0cec 4286 set ids [lindex $rowidlist $row2]
9f1afe05
PM
4287 # rmx = right-most X coord used
4288 set rmx 0
9f1afe05 4289 foreach p $olds {
f3408449
PM
4290 set i [lsearch -exact $ids $p]
4291 if {$i < 0} {
4292 puts "oops, parent $p of $id not in list"
4293 continue
4294 }
4295 set x2 [xc $row2 $i]
4296 if {$x2 > $rmx} {
4297 set rmx $x2
4298 }
513a54dc
PM
4299 set j [lsearch -exact $rowids $p]
4300 if {$j < 0} {
eb447a12
PM
4301 # drawlineseg will do this one for us
4302 continue
4303 }
9f1afe05
PM
4304 assigncolor $p
4305 # should handle duplicated parents here...
4306 set coords [list $x $y]
513a54dc
PM
4307 if {$i != $col} {
4308 # if attaching to a vertical segment, draw a smaller
4309 # slant for visual distinctness
4310 if {$i == $j} {
4311 if {$i < $col} {
4312 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4313 } else {
4314 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4315 }
4316 } elseif {$i < $col && $i < $j} {
4317 # segment slants towards us already
4318 lappend coords [xc $row $j] $y
4319 } else {
4320 if {$i < $col - 1} {
4321 lappend coords [expr {$x2 + $linespc}] $y
4322 } elseif {$i > $col + 1} {
4323 lappend coords [expr {$x2 - $linespc}] $y
4324 }
4325 lappend coords $x2 $y2
4326 }
4327 } else {
4328 lappend coords $x2 $y2
9f1afe05 4329 }
c934a8a3 4330 set t [$canv create line $coords -width [linewidth $p] \
9f1afe05
PM
4331 -fill $colormap($p) -tags lines.$p]
4332 $canv lower $t
4333 bindline $t $p
4334 }
322a8cc9
PM
4335 if {$rmx > [lindex $idpos($id) 1]} {
4336 lset idpos($id) 1 $rmx
4337 redrawtags $id
4338 }
9f1afe05
PM
4339}
4340
c934a8a3 4341proc drawlines {id} {
322a8cc9 4342 global canv
9f1afe05 4343
322a8cc9 4344 $canv itemconf lines.$id -width [linewidth $id]
9f1afe05
PM
4345}
4346
322a8cc9 4347proc drawcmittext {id row col} {
7fcc92bf
PM
4348 global linespc canv canv2 canv3 fgcolor curview
4349 global cmitlisted commitinfo rowidlist parentlist
9f1afe05 4350 global rowtextx idpos idtags idheads idotherrefs
0380081c 4351 global linehtag linentag linedtag selectedline
9c311b32 4352 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
9f1afe05 4353
c961b228 4354 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
7fcc92bf 4355 set listed $cmitlisted($curview,$id)
219ea3a9
PM
4356 if {$id eq $nullid} {
4357 set ofill red
8f489363 4358 } elseif {$id eq $nullid2} {
ef3192b8 4359 set ofill green
219ea3a9 4360 } else {
c961b228 4361 set ofill [expr {$listed != 0? "blue": "white"}]
219ea3a9 4362 }
9f1afe05
PM
4363 set x [xc $row $col]
4364 set y [yc $row]
4365 set orad [expr {$linespc / 3}]
c961b228
PM
4366 if {$listed <= 1} {
4367 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4368 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4369 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4370 } elseif {$listed == 2} {
4371 # triangle pointing left for left-side commits
4372 set t [$canv create polygon \
4373 [expr {$x - $orad}] $y \
4374 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4375 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4376 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4377 } else {
4378 # triangle pointing right for right-side commits
4379 set t [$canv create polygon \
4380 [expr {$x + $orad - 1}] $y \
4381 [expr {$x - $orad}] [expr {$y - $orad}] \
4382 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4383 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4384 }
9f1afe05
PM
4385 $canv raise $t
4386 $canv bind $t <1> {selcanvline {} %x %y}
322a8cc9
PM
4387 set rmx [llength [lindex $rowidlist $row]]
4388 set olds [lindex $parentlist $row]
4389 if {$olds ne {}} {
4390 set nextids [lindex $rowidlist [expr {$row + 1}]]
4391 foreach p $olds {
4392 set i [lsearch -exact $nextids $p]
4393 if {$i > $rmx} {
4394 set rmx $i
4395 }
4396 }
9f1afe05 4397 }
322a8cc9 4398 set xt [xc $row $rmx]
9f1afe05
PM
4399 set rowtextx($row) $xt
4400 set idpos($id) [list $x $xt $y]
4401 if {[info exists idtags($id)] || [info exists idheads($id)]
4402 || [info exists idotherrefs($id)]} {
4403 set xt [drawtags $id $x $xt $y]
4404 }
4405 set headline [lindex $commitinfo($id) 0]
4406 set name [lindex $commitinfo($id) 1]
4407 set date [lindex $commitinfo($id) 2]
4408 set date [formatdate $date]
9c311b32
PM
4409 set font mainfont
4410 set nfont mainfont
908c3585
PM
4411 set isbold [ishighlighted $row]
4412 if {$isbold > 0} {
4e7d6779 4413 lappend boldrows $row
9c311b32 4414 set font mainfontbold
908c3585 4415 if {$isbold > 1} {
4e7d6779 4416 lappend boldnamerows $row
9c311b32 4417 set nfont mainfontbold
908c3585 4418 }
da7c24dd 4419 }
f8a2c0d1
PM
4420 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4421 -text $headline -font $font -tags text]
9f1afe05 4422 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
f8a2c0d1
PM
4423 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4424 -text $name -font $nfont -tags text]
4425 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
9c311b32 4426 -text $date -font mainfont -tags text]
0380081c
PM
4427 if {[info exists selectedline] && $selectedline == $row} {
4428 make_secsel $row
4429 }
9c311b32 4430 set xr [expr {$xt + [font measure $font $headline]}]
be0cd098
PM
4431 if {$xr > $canvxmax} {
4432 set canvxmax $xr
4433 setcanvscroll
4434 }
9f1afe05
PM
4435}
4436
4437proc drawcmitrow {row} {
0380081c 4438 global displayorder rowidlist nrows_drawn
005a2f4e 4439 global iddrawn markingmatches
7fcc92bf 4440 global commitinfo numcommits
687c8765 4441 global filehighlight fhighlights findpattern nhighlights
908c3585 4442 global hlview vhighlights
164ff275 4443 global highlight_related rhighlights
9f1afe05 4444
8f7d0cec 4445 if {$row >= $numcommits} return
9f1afe05
PM
4446
4447 set id [lindex $displayorder $row]
908c3585
PM
4448 if {[info exists hlview] && ![info exists vhighlights($row)]} {
4449 askvhighlight $row $id
4450 }
4451 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
4452 askfilehighlight $row $id
4453 }
687c8765 4454 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
60f7a7dc 4455 askfindhighlight $row $id
908c3585 4456 }
b007ee20 4457 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
164ff275
PM
4458 askrelhighlight $row $id
4459 }
005a2f4e
PM
4460 if {![info exists iddrawn($id)]} {
4461 set col [lsearch -exact [lindex $rowidlist $row] $id]
4462 if {$col < 0} {
4463 puts "oops, row $row id $id not in list"
4464 return
4465 }
4466 if {![info exists commitinfo($id)]} {
4467 getcommit $id
4468 }
4469 assigncolor $id
4470 drawcmittext $id $row $col
4471 set iddrawn($id) 1
0380081c 4472 incr nrows_drawn
9f1afe05 4473 }
005a2f4e
PM
4474 if {$markingmatches} {
4475 markrowmatches $row $id
9f1afe05 4476 }
9f1afe05
PM
4477}
4478
322a8cc9 4479proc drawcommits {row {endrow {}}} {
0380081c 4480 global numcommits iddrawn displayorder curview need_redisplay
f5f3c2e2 4481 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
9f1afe05 4482
9f1afe05
PM
4483 if {$row < 0} {
4484 set row 0
4485 }
322a8cc9
PM
4486 if {$endrow eq {}} {
4487 set endrow $row
4488 }
9f1afe05
PM
4489 if {$endrow >= $numcommits} {
4490 set endrow [expr {$numcommits - 1}]
4491 }
322a8cc9 4492
0380081c
PM
4493 set rl1 [expr {$row - $downarrowlen - 3}]
4494 if {$rl1 < 0} {
4495 set rl1 0
4496 }
4497 set ro1 [expr {$row - 3}]
4498 if {$ro1 < 0} {
4499 set ro1 0
4500 }
4501 set r2 [expr {$endrow + $uparrowlen + 3}]
4502 if {$r2 > $numcommits} {
4503 set r2 $numcommits
4504 }
4505 for {set r $rl1} {$r < $r2} {incr r} {
f5f3c2e2 4506 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
0380081c
PM
4507 if {$rl1 < $r} {
4508 layoutrows $rl1 $r
4509 }
4510 set rl1 [expr {$r + 1}]
4511 }
4512 }
4513 if {$rl1 < $r} {
4514 layoutrows $rl1 $r
4515 }
4516 optimize_rows $ro1 0 $r2
4517 if {$need_redisplay || $nrows_drawn > 2000} {
4518 clear_display
4519 drawvisible
4520 }
4521
322a8cc9
PM
4522 # make the lines join to already-drawn rows either side
4523 set r [expr {$row - 1}]
4524 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4525 set r $row
4526 }
4527 set er [expr {$endrow + 1}]
4528 if {$er >= $numcommits ||
4529 ![info exists iddrawn([lindex $displayorder $er])]} {
4530 set er $endrow
4531 }
4532 for {} {$r <= $er} {incr r} {
4533 set id [lindex $displayorder $r]
4534 set wasdrawn [info exists iddrawn($id)]
4fb0fa19 4535 drawcmitrow $r
322a8cc9
PM
4536 if {$r == $er} break
4537 set nextid [lindex $displayorder [expr {$r + 1}]]
e5ef6f95 4538 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
322a8cc9
PM
4539 drawparentlinks $id $r
4540
322a8cc9
PM
4541 set rowids [lindex $rowidlist $r]
4542 foreach lid $rowids {
4543 if {$lid eq {}} continue
e5ef6f95 4544 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
322a8cc9
PM
4545 if {$lid eq $id} {
4546 # see if this is the first child of any of its parents
4547 foreach p [lindex $parentlist $r] {
4548 if {[lsearch -exact $rowids $p] < 0} {
4549 # make this line extend up to the child
e5ef6f95 4550 set lineend($p) [drawlineseg $p $r $er 0]
322a8cc9
PM
4551 }
4552 }
e5ef6f95
PM
4553 } else {
4554 set lineend($lid) [drawlineseg $lid $r $er 1]
322a8cc9
PM
4555 }
4556 }
9f1afe05
PM
4557 }
4558}
4559
7fcc92bf
PM
4560proc undolayout {row} {
4561 global uparrowlen mingaplen downarrowlen
4562 global rowidlist rowisopt rowfinal need_redisplay
4563
4564 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4565 if {$r < 0} {
4566 set r 0
4567 }
4568 if {[llength $rowidlist] > $r} {
4569 incr r -1
4570 set rowidlist [lrange $rowidlist 0 $r]
4571 set rowfinal [lrange $rowfinal 0 $r]
4572 set rowisopt [lrange $rowisopt 0 $r]
4573 set need_redisplay 1
4574 run drawvisible
4575 }
4576}
4577
31c0eaa8
PM
4578proc drawvisible {} {
4579 global canv linespc curview vrowmod selectedline targetrow targetid
42a671fc 4580 global need_redisplay cscroll numcommits
322a8cc9 4581
31c0eaa8 4582 set fs [$canv yview]
322a8cc9
PM
4583 set ymax [lindex [$canv cget -scrollregion] 3]
4584 if {$ymax eq {} || $ymax == 0} return
31c0eaa8
PM
4585 set f0 [lindex $fs 0]
4586 set f1 [lindex $fs 1]
322a8cc9 4587 set y0 [expr {int($f0 * $ymax)}]
322a8cc9 4588 set y1 [expr {int($f1 * $ymax)}]
31c0eaa8
PM
4589
4590 if {[info exists targetid]} {
42a671fc
PM
4591 if {[commitinview $targetid $curview]} {
4592 set r [rowofcommit $targetid]
4593 if {$r != $targetrow} {
4594 # Fix up the scrollregion and change the scrolling position
4595 # now that our target row has moved.
4596 set diff [expr {($r - $targetrow) * $linespc}]
4597 set targetrow $r
4598 setcanvscroll
4599 set ymax [lindex [$canv cget -scrollregion] 3]
4600 incr y0 $diff
4601 incr y1 $diff
4602 set f0 [expr {$y0 / $ymax}]
4603 set f1 [expr {$y1 / $ymax}]
4604 allcanvs yview moveto $f0
4605 $cscroll set $f0 $f1
4606 set need_redisplay 1
4607 }
4608 } else {
4609 unset targetid
31c0eaa8
PM
4610 }
4611 }
4612
4613 set row [expr {int(($y0 - 3) / $linespc) - 1}]
322a8cc9 4614 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
31c0eaa8
PM
4615 if {$endrow >= $vrowmod($curview)} {
4616 update_arcrows $curview
4617 }
4618 if {[info exists selectedline] &&
4619 $row <= $selectedline && $selectedline <= $endrow} {
4620 set targetrow $selectedline
4621 } else {
4622 set targetrow [expr {int(($row + $endrow) / 2)}]
4623 }
42a671fc
PM
4624 if {$targetrow >= $numcommits} {
4625 set targetrow [expr {$numcommits - 1}]
4626 }
31c0eaa8 4627 set targetid [commitonrow $targetrow]
322a8cc9
PM
4628 drawcommits $row $endrow
4629}
4630
9f1afe05 4631proc clear_display {} {
0380081c 4632 global iddrawn linesegs need_redisplay nrows_drawn
164ff275 4633 global vhighlights fhighlights nhighlights rhighlights
9f1afe05
PM
4634
4635 allcanvs delete all
4636 catch {unset iddrawn}
322a8cc9 4637 catch {unset linesegs}
908c3585
PM
4638 catch {unset vhighlights}
4639 catch {unset fhighlights}
4640 catch {unset nhighlights}
164ff275 4641 catch {unset rhighlights}
0380081c
PM
4642 set need_redisplay 0
4643 set nrows_drawn 0
9f1afe05
PM
4644}
4645
50b44ece 4646proc findcrossings {id} {
6e8c8707 4647 global rowidlist parentlist numcommits displayorder
50b44ece
PM
4648
4649 set cross {}
4650 set ccross {}
4651 foreach {s e} [rowranges $id] {
4652 if {$e >= $numcommits} {
4653 set e [expr {$numcommits - 1}]
50b44ece 4654 }
d94f8cd6 4655 if {$e <= $s} continue
50b44ece 4656 for {set row $e} {[incr row -1] >= $s} {} {
6e8c8707
PM
4657 set x [lsearch -exact [lindex $rowidlist $row] $id]
4658 if {$x < 0} break
50b44ece
PM
4659 set olds [lindex $parentlist $row]
4660 set kid [lindex $displayorder $row]
4661 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4662 if {$kidx < 0} continue
4663 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4664 foreach p $olds {
4665 set px [lsearch -exact $nextrow $p]
4666 if {$px < 0} continue
4667 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4668 if {[lsearch -exact $ccross $p] >= 0} continue
4669 if {$x == $px + ($kidx < $px? -1: 1)} {
4670 lappend ccross $p
4671 } elseif {[lsearch -exact $cross $p] < 0} {
4672 lappend cross $p
4673 }
4674 }
4675 }
50b44ece
PM
4676 }
4677 }
4678 return [concat $ccross {{}} $cross]
4679}
4680
e5c2d856 4681proc assigncolor {id} {
aa81d974 4682 global colormap colors nextcolor
7fcc92bf 4683 global parents children children curview
6c20ff34 4684
418c4c7b 4685 if {[info exists colormap($id)]} return
e5c2d856 4686 set ncolors [llength $colors]
da7c24dd
PM
4687 if {[info exists children($curview,$id)]} {
4688 set kids $children($curview,$id)
79b2c75e
PM
4689 } else {
4690 set kids {}
4691 }
4692 if {[llength $kids] == 1} {
4693 set child [lindex $kids 0]
9ccbdfbf 4694 if {[info exists colormap($child)]
7fcc92bf 4695 && [llength $parents($curview,$child)] == 1} {
9ccbdfbf
PM
4696 set colormap($id) $colormap($child)
4697 return
e5c2d856 4698 }
9ccbdfbf
PM
4699 }
4700 set badcolors {}
50b44ece
PM
4701 set origbad {}
4702 foreach x [findcrossings $id] {
4703 if {$x eq {}} {
4704 # delimiter between corner crossings and other crossings
4705 if {[llength $badcolors] >= $ncolors - 1} break
4706 set origbad $badcolors
e5c2d856 4707 }
50b44ece
PM
4708 if {[info exists colormap($x)]
4709 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4710 lappend badcolors $colormap($x)
6c20ff34
PM
4711 }
4712 }
50b44ece
PM
4713 if {[llength $badcolors] >= $ncolors} {
4714 set badcolors $origbad
9ccbdfbf 4715 }
50b44ece 4716 set origbad $badcolors
6c20ff34 4717 if {[llength $badcolors] < $ncolors - 1} {
79b2c75e 4718 foreach child $kids {
6c20ff34
PM
4719 if {[info exists colormap($child)]
4720 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4721 lappend badcolors $colormap($child)
4722 }
7fcc92bf 4723 foreach p $parents($curview,$child) {
79b2c75e
PM
4724 if {[info exists colormap($p)]
4725 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4726 lappend badcolors $colormap($p)
6c20ff34
PM
4727 }
4728 }
4729 }
4730 if {[llength $badcolors] >= $ncolors} {
4731 set badcolors $origbad
4732 }
9ccbdfbf
PM
4733 }
4734 for {set i 0} {$i <= $ncolors} {incr i} {
4735 set c [lindex $colors $nextcolor]
4736 if {[incr nextcolor] >= $ncolors} {
4737 set nextcolor 0
e5c2d856 4738 }
9ccbdfbf 4739 if {[lsearch -exact $badcolors $c]} break
e5c2d856 4740 }
9ccbdfbf 4741 set colormap($id) $c
e5c2d856
PM
4742}
4743
a823a911
PM
4744proc bindline {t id} {
4745 global canv
4746
a823a911
PM
4747 $canv bind $t <Enter> "lineenter %x %y $id"
4748 $canv bind $t <Motion> "linemotion %x %y $id"
4749 $canv bind $t <Leave> "lineleave $id"
fa4da7b3 4750 $canv bind $t <Button-1> "lineclick %x %y $id 1"
a823a911
PM
4751}
4752
bdbfbe3d 4753proc drawtags {id x xt y1} {
8a48571c 4754 global idtags idheads idotherrefs mainhead
bdbfbe3d 4755 global linespc lthickness
7fcc92bf 4756 global canv rowtextx curview fgcolor bgcolor
bdbfbe3d
PM
4757
4758 set marks {}
4759 set ntags 0
f1d83ba3 4760 set nheads 0
bdbfbe3d
PM
4761 if {[info exists idtags($id)]} {
4762 set marks $idtags($id)
4763 set ntags [llength $marks]
4764 }
4765 if {[info exists idheads($id)]} {
4766 set marks [concat $marks $idheads($id)]
f1d83ba3
PM
4767 set nheads [llength $idheads($id)]
4768 }
4769 if {[info exists idotherrefs($id)]} {
4770 set marks [concat $marks $idotherrefs($id)]
bdbfbe3d
PM
4771 }
4772 if {$marks eq {}} {
4773 return $xt
4774 }
4775
4776 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2ed49d54
JH
4777 set yt [expr {$y1 - 0.5 * $linespc}]
4778 set yb [expr {$yt + $linespc - 1}]
bdbfbe3d
PM
4779 set xvals {}
4780 set wvals {}
8a48571c 4781 set i -1
bdbfbe3d 4782 foreach tag $marks {
8a48571c
PM
4783 incr i
4784 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
9c311b32 4785 set wid [font measure mainfontbold $tag]
8a48571c 4786 } else {
9c311b32 4787 set wid [font measure mainfont $tag]
8a48571c 4788 }
bdbfbe3d
PM
4789 lappend xvals $xt
4790 lappend wvals $wid
4791 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4792 }
4793 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4794 -width $lthickness -fill black -tags tag.$id]
4795 $canv lower $t
4796 foreach tag $marks x $xvals wid $wvals {
2ed49d54
JH
4797 set xl [expr {$x + $delta}]
4798 set xr [expr {$x + $delta + $wid + $lthickness}]
9c311b32 4799 set font mainfont
bdbfbe3d
PM
4800 if {[incr ntags -1] >= 0} {
4801 # draw a tag
2ed49d54
JH
4802 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4803 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
106288cb
PM
4804 -width 1 -outline black -fill yellow -tags tag.$id]
4805 $canv bind $t <1> [list showtag $tag 1]
7fcc92bf 4806 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
bdbfbe3d 4807 } else {
f1d83ba3
PM
4808 # draw a head or other ref
4809 if {[incr nheads -1] >= 0} {
4810 set col green
8a48571c 4811 if {$tag eq $mainhead} {
9c311b32 4812 set font mainfontbold
8a48571c 4813 }
f1d83ba3
PM
4814 } else {
4815 set col "#ddddff"
4816 }
2ed49d54 4817 set xl [expr {$xl - $delta/2}]
bdbfbe3d 4818 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
f1d83ba3 4819 -width 1 -outline black -fill $col -tags tag.$id
a970fcf2 4820 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
9c311b32 4821 set rwid [font measure mainfont $remoteprefix]
a970fcf2
JW
4822 set xi [expr {$x + 1}]
4823 set yti [expr {$yt + 1}]
4824 set xri [expr {$x + $rwid}]
4825 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4826 -width 0 -fill "#ffddaa" -tags tag.$id
4827 }
bdbfbe3d 4828 }
f8a2c0d1 4829 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
8a48571c 4830 -font $font -tags [list tag.$id text]]
106288cb
PM
4831 if {$ntags >= 0} {
4832 $canv bind $t <1> [list showtag $tag 1]
10299152
PM
4833 } elseif {$nheads >= 0} {
4834 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
106288cb 4835 }
bdbfbe3d
PM
4836 }
4837 return $xt
4838}
4839
8d858d1a
PM
4840proc xcoord {i level ln} {
4841 global canvx0 xspc1 xspc2
4842
4843 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4844 if {$i > 0 && $i == $level} {
4845 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4846 } elseif {$i > $level} {
4847 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4848 }
4849 return $x
4850}
9ccbdfbf 4851
098dd8a3 4852proc show_status {msg} {
9c311b32 4853 global canv fgcolor
098dd8a3
PM
4854
4855 clear_display
9c311b32 4856 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
f8a2c0d1 4857 -tags text -fill $fgcolor
098dd8a3
PM
4858}
4859
94a2eede
PM
4860# Don't change the text pane cursor if it is currently the hand cursor,
4861# showing that we are over a sha1 ID link.
4862proc settextcursor {c} {
4863 global ctext curtextcursor
4864
4865 if {[$ctext cget -cursor] == $curtextcursor} {
4866 $ctext config -cursor $c
4867 }
4868 set curtextcursor $c
9ccbdfbf
PM
4869}
4870
a137a90f
PM
4871proc nowbusy {what {name {}}} {
4872 global isbusy busyname statusw
da7c24dd
PM
4873
4874 if {[array names isbusy] eq {}} {
4875 . config -cursor watch
4876 settextcursor watch
4877 }
4878 set isbusy($what) 1
a137a90f
PM
4879 set busyname($what) $name
4880 if {$name ne {}} {
4881 $statusw conf -text $name
4882 }
da7c24dd
PM
4883}
4884
4885proc notbusy {what} {
a137a90f 4886 global isbusy maincursor textcursor busyname statusw
da7c24dd 4887
a137a90f
PM
4888 catch {
4889 unset isbusy($what)
4890 if {$busyname($what) ne {} &&
4891 [$statusw cget -text] eq $busyname($what)} {
4892 $statusw conf -text {}
4893 }
4894 }
da7c24dd
PM
4895 if {[array names isbusy] eq {}} {
4896 . config -cursor $maincursor
4897 settextcursor $textcursor
4898 }
4899}
4900
df3d83b1 4901proc findmatches {f} {
4fb0fa19 4902 global findtype findstring
b007ee20 4903 if {$findtype == [mc "Regexp"]} {
4fb0fa19 4904 set matches [regexp -indices -all -inline $findstring $f]
df3d83b1 4905 } else {
4fb0fa19 4906 set fs $findstring
b007ee20 4907 if {$findtype == [mc "IgnCase"]} {
4fb0fa19
PM
4908 set f [string tolower $f]
4909 set fs [string tolower $fs]
df3d83b1
PM
4910 }
4911 set matches {}
4912 set i 0
4fb0fa19
PM
4913 set l [string length $fs]
4914 while {[set j [string first $fs $f $i]] >= 0} {
4915 lappend matches [list $j [expr {$j+$l-1}]]
4916 set i [expr {$j + $l}]
df3d83b1
PM
4917 }
4918 }
4919 return $matches
4920}
4921
cca5d946 4922proc dofind {{dirn 1} {wrap 1}} {
4fb0fa19 4923 global findstring findstartline findcurline selectedline numcommits
cca5d946 4924 global gdttype filehighlight fh_serial find_dirn findallowwrap
b74fd579 4925
cca5d946
PM
4926 if {[info exists find_dirn]} {
4927 if {$find_dirn == $dirn} return
4928 stopfinding
4929 }
df3d83b1 4930 focus .
4fb0fa19
PM
4931 if {$findstring eq {} || $numcommits == 0} return
4932 if {![info exists selectedline]} {
cca5d946 4933 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
98f350e5 4934 } else {
4fb0fa19 4935 set findstartline $selectedline
98f350e5 4936 }
4fb0fa19 4937 set findcurline $findstartline
b007ee20
CS
4938 nowbusy finding [mc "Searching"]
4939 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
687c8765
PM
4940 after cancel do_file_hl $fh_serial
4941 do_file_hl $fh_serial
98f350e5 4942 }
cca5d946
PM
4943 set find_dirn $dirn
4944 set findallowwrap $wrap
4945 run findmore
4fb0fa19
PM
4946}
4947
bb3edc8b
PM
4948proc stopfinding {} {
4949 global find_dirn findcurline fprogcoord
4fb0fa19 4950
bb3edc8b
PM
4951 if {[info exists find_dirn]} {
4952 unset find_dirn
4953 unset findcurline
4954 notbusy finding
4955 set fprogcoord 0
4956 adjustprogress
4fb0fa19
PM
4957 }
4958}
4959
4960proc findmore {} {
687c8765 4961 global commitdata commitinfo numcommits findpattern findloc
7fcc92bf 4962 global findstartline findcurline findallowwrap
bb3edc8b 4963 global find_dirn gdttype fhighlights fprogcoord
cd2bcae7 4964 global curview varcorder vrownum varccommits vrowmod
4fb0fa19 4965
bb3edc8b 4966 if {![info exists find_dirn]} {
4fb0fa19
PM
4967 return 0
4968 }
b007ee20 4969 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4fb0fa19 4970 set l $findcurline
cca5d946
PM
4971 set moretodo 0
4972 if {$find_dirn > 0} {
4973 incr l
4974 if {$l >= $numcommits} {
4975 set l 0
4976 }
4977 if {$l <= $findstartline} {
4978 set lim [expr {$findstartline + 1}]
4979 } else {
4980 set lim $numcommits
4981 set moretodo $findallowwrap
8ed16484 4982 }
4fb0fa19 4983 } else {
cca5d946
PM
4984 if {$l == 0} {
4985 set l $numcommits
98f350e5 4986 }
cca5d946
PM
4987 incr l -1
4988 if {$l >= $findstartline} {
4989 set lim [expr {$findstartline - 1}]
bb3edc8b 4990 } else {
cca5d946
PM
4991 set lim -1
4992 set moretodo $findallowwrap
bb3edc8b 4993 }
687c8765 4994 }
cca5d946
PM
4995 set n [expr {($lim - $l) * $find_dirn}]
4996 if {$n > 500} {
4997 set n 500
4998 set moretodo 1
4fb0fa19 4999 }
cd2bcae7
PM
5000 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5001 update_arcrows $curview
5002 }
687c8765
PM
5003 set found 0
5004 set domore 1
7fcc92bf
PM
5005 set ai [bsearch $vrownum($curview) $l]
5006 set a [lindex $varcorder($curview) $ai]
5007 set arow [lindex $vrownum($curview) $ai]
5008 set ids [lindex $varccommits($curview,$a)]
5009 set arowend [expr {$arow + [llength $ids]}]
b007ee20 5010 if {$gdttype eq [mc "containing:"]} {
cca5d946 5011 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
5012 if {$l < $arow || $l >= $arowend} {
5013 incr ai $find_dirn
5014 set a [lindex $varcorder($curview) $ai]
5015 set arow [lindex $vrownum($curview) $ai]
5016 set ids [lindex $varccommits($curview,$a)]
5017 set arowend [expr {$arow + [llength $ids]}]
5018 }
5019 set id [lindex $ids [expr {$l - $arow}]]
cca5d946 5020 # shouldn't happen unless git log doesn't give all the commits...
7fcc92bf
PM
5021 if {![info exists commitdata($id)] ||
5022 ![doesmatch $commitdata($id)]} {
5023 continue
5024 }
687c8765
PM
5025 if {![info exists commitinfo($id)]} {
5026 getcommit $id
5027 }
5028 set info $commitinfo($id)
5029 foreach f $info ty $fldtypes {
b007ee20 5030 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
687c8765
PM
5031 [doesmatch $f]} {
5032 set found 1
5033 break
5034 }
5035 }
5036 if {$found} break
4fb0fa19 5037 }
687c8765 5038 } else {
cca5d946 5039 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
5040 if {$l < $arow || $l >= $arowend} {
5041 incr ai $find_dirn
5042 set a [lindex $varcorder($curview) $ai]
5043 set arow [lindex $vrownum($curview) $ai]
5044 set ids [lindex $varccommits($curview,$a)]
5045 set arowend [expr {$arow + [llength $ids]}]
5046 }
5047 set id [lindex $ids [expr {$l - $arow}]]
687c8765 5048 if {![info exists fhighlights($l)]} {
cd2bcae7 5049 # this sets fhighlights($l) to -1
687c8765 5050 askfilehighlight $l $id
cd2bcae7
PM
5051 }
5052 if {$fhighlights($l) > 0} {
5053 set found $domore
5054 break
5055 }
5056 if {$fhighlights($l) < 0} {
687c8765
PM
5057 if {$domore} {
5058 set domore 0
cca5d946 5059 set findcurline [expr {$l - $find_dirn}]
687c8765 5060 }
98f350e5
PM
5061 }
5062 }
5063 }
cca5d946 5064 if {$found || ($domore && !$moretodo)} {
4fb0fa19 5065 unset findcurline
687c8765 5066 unset find_dirn
4fb0fa19 5067 notbusy finding
bb3edc8b
PM
5068 set fprogcoord 0
5069 adjustprogress
5070 if {$found} {
5071 findselectline $l
5072 } else {
5073 bell
5074 }
4fb0fa19 5075 return 0
df3d83b1 5076 }
687c8765
PM
5077 if {!$domore} {
5078 flushhighlights
bb3edc8b 5079 } else {
cca5d946 5080 set findcurline [expr {$l - $find_dirn}]
687c8765 5081 }
cca5d946 5082 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
bb3edc8b
PM
5083 if {$n < 0} {
5084 incr n $numcommits
df3d83b1 5085 }
bb3edc8b
PM
5086 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5087 adjustprogress
5088 return $domore
df3d83b1
PM
5089}
5090
5091proc findselectline {l} {
687c8765 5092 global findloc commentend ctext findcurline markingmatches gdttype
005a2f4e
PM
5093
5094 set markingmatches 1
5095 set findcurline $l
d698206c 5096 selectline $l 1
b007ee20 5097 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
df3d83b1
PM
5098 # highlight the matches in the comments
5099 set f [$ctext get 1.0 $commentend]
5100 set matches [findmatches $f]
5101 foreach match $matches {
5102 set start [lindex $match 0]
2ed49d54 5103 set end [expr {[lindex $match 1] + 1}]
df3d83b1
PM
5104 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5105 }
98f350e5 5106 }
005a2f4e 5107 drawvisible
98f350e5
PM
5108}
5109
4fb0fa19 5110# mark the bits of a headline or author that match a find string
005a2f4e
PM
5111proc markmatches {canv l str tag matches font row} {
5112 global selectedline
5113
98f350e5
PM
5114 set bbox [$canv bbox $tag]
5115 set x0 [lindex $bbox 0]
5116 set y0 [lindex $bbox 1]
5117 set y1 [lindex $bbox 3]
5118 foreach match $matches {
5119 set start [lindex $match 0]
5120 set end [lindex $match 1]
5121 if {$start > $end} continue
2ed49d54
JH
5122 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5123 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5124 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5125 [expr {$x0+$xlen+2}] $y1 \
4fb0fa19 5126 -outline {} -tags [list match$l matches] -fill yellow]
98f350e5 5127 $canv lower $t
005a2f4e
PM
5128 if {[info exists selectedline] && $row == $selectedline} {
5129 $canv raise $t secsel
5130 }
98f350e5
PM
5131 }
5132}
5133
5134proc unmarkmatches {} {
bb3edc8b 5135 global markingmatches
4fb0fa19 5136
98f350e5 5137 allcanvs delete matches
4fb0fa19 5138 set markingmatches 0
bb3edc8b 5139 stopfinding
98f350e5
PM
5140}
5141
c8dfbcf9 5142proc selcanvline {w x y} {
fa4da7b3 5143 global canv canvy0 ctext linespc
9f1afe05 5144 global rowtextx
1db95b00 5145 set ymax [lindex [$canv cget -scrollregion] 3]
cfb4563c 5146 if {$ymax == {}} return
1db95b00
PM
5147 set yfrac [lindex [$canv yview] 0]
5148 set y [expr {$y + $yfrac * $ymax}]
5149 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5150 if {$l < 0} {
5151 set l 0
5152 }
c8dfbcf9 5153 if {$w eq $canv} {
fc2a256f
PM
5154 set xmax [lindex [$canv cget -scrollregion] 2]
5155 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5156 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
c8dfbcf9 5157 }
98f350e5 5158 unmarkmatches
d698206c 5159 selectline $l 1
5ad588de
PM
5160}
5161
b1ba39e7
LT
5162proc commit_descriptor {p} {
5163 global commitinfo
b0934489
PM
5164 if {![info exists commitinfo($p)]} {
5165 getcommit $p
5166 }
b1ba39e7 5167 set l "..."
b0934489 5168 if {[llength $commitinfo($p)] > 1} {
b1ba39e7
LT
5169 set l [lindex $commitinfo($p) 0]
5170 }
b8ab2e17 5171 return "$p ($l)\n"
b1ba39e7
LT
5172}
5173
106288cb
PM
5174# append some text to the ctext widget, and make any SHA1 ID
5175# that we know about be a clickable link.
f1b86294 5176proc appendwithlinks {text tags} {
7fcc92bf 5177 global ctext linknum curview pendinglinks
106288cb
PM
5178
5179 set start [$ctext index "end - 1c"]
f1b86294 5180 $ctext insert end $text $tags
106288cb
PM
5181 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5182 foreach l $links {
5183 set s [lindex $l 0]
5184 set e [lindex $l 1]
5185 set linkid [string range $text $s $e]
106288cb 5186 incr e
c73adce2 5187 $ctext tag delete link$linknum
106288cb 5188 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
97645683 5189 setlink $linkid link$linknum
106288cb
PM
5190 incr linknum
5191 }
97645683
PM
5192}
5193
5194proc setlink {id lk} {
7fcc92bf 5195 global curview ctext pendinglinks commitinterest
97645683 5196
7fcc92bf 5197 if {[commitinview $id $curview]} {
97645683 5198 $ctext tag conf $lk -foreground blue -underline 1
7fcc92bf 5199 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
97645683
PM
5200 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5201 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5202 } else {
5203 lappend pendinglinks($id) $lk
5204 lappend commitinterest($id) {makelink %I}
5205 }
5206}
5207
5208proc makelink {id} {
5209 global pendinglinks
5210
5211 if {![info exists pendinglinks($id)]} return
5212 foreach lk $pendinglinks($id) {
5213 setlink $id $lk
5214 }
5215 unset pendinglinks($id)
5216}
5217
5218proc linkcursor {w inc} {
5219 global linkentercount curtextcursor
5220
5221 if {[incr linkentercount $inc] > 0} {
5222 $w configure -cursor hand2
5223 } else {
5224 $w configure -cursor $curtextcursor
5225 if {$linkentercount < 0} {
5226 set linkentercount 0
5227 }
5228 }
106288cb
PM
5229}
5230
6e5f7203
RN
5231proc viewnextline {dir} {
5232 global canv linespc
5233
5234 $canv delete hover
5235 set ymax [lindex [$canv cget -scrollregion] 3]
5236 set wnow [$canv yview]
5237 set wtop [expr {[lindex $wnow 0] * $ymax}]
5238 set newtop [expr {$wtop + $dir * $linespc}]
5239 if {$newtop < 0} {
5240 set newtop 0
5241 } elseif {$newtop > $ymax} {
5242 set newtop $ymax
5243 }
5244 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5245}
5246
ef030b85
PM
5247# add a list of tag or branch names at position pos
5248# returns the number of names inserted
e11f1233 5249proc appendrefs {pos ids var} {
7fcc92bf 5250 global ctext linknum curview $var maxrefs
b8ab2e17 5251
ef030b85
PM
5252 if {[catch {$ctext index $pos}]} {
5253 return 0
5254 }
e11f1233
PM
5255 $ctext conf -state normal
5256 $ctext delete $pos "$pos lineend"
5257 set tags {}
5258 foreach id $ids {
5259 foreach tag [set $var\($id\)] {
5260 lappend tags [list $tag $id]
5261 }
5262 }
0a4dd8b8
PM
5263 if {[llength $tags] > $maxrefs} {
5264 $ctext insert $pos "many ([llength $tags])"
5265 } else {
5266 set tags [lsort -index 0 -decreasing $tags]
5267 set sep {}
5268 foreach ti $tags {
5269 set id [lindex $ti 1]
5270 set lk link$linknum
5271 incr linknum
5272 $ctext tag delete $lk
5273 $ctext insert $pos $sep
5274 $ctext insert $pos [lindex $ti 0] $lk
97645683 5275 setlink $id $lk
0a4dd8b8 5276 set sep ", "
b8ab2e17 5277 }
b8ab2e17 5278 }
e11f1233 5279 $ctext conf -state disabled
ef030b85 5280 return [llength $tags]
b8ab2e17
PM
5281}
5282
e11f1233
PM
5283# called when we have finished computing the nearby tags
5284proc dispneartags {delay} {
5285 global selectedline currentid showneartags tagphase
ca6d8f58 5286
e11f1233
PM
5287 if {![info exists selectedline] || !$showneartags} return
5288 after cancel dispnexttag
5289 if {$delay} {
5290 after 200 dispnexttag
5291 set tagphase -1
5292 } else {
5293 after idle dispnexttag
5294 set tagphase 0
ca6d8f58 5295 }
ca6d8f58
PM
5296}
5297
e11f1233
PM
5298proc dispnexttag {} {
5299 global selectedline currentid showneartags tagphase ctext
b8ab2e17
PM
5300
5301 if {![info exists selectedline] || !$showneartags} return
e11f1233
PM
5302 switch -- $tagphase {
5303 0 {
5304 set dtags [desctags $currentid]
5305 if {$dtags ne {}} {
5306 appendrefs precedes $dtags idtags
5307 }
5308 }
5309 1 {
5310 set atags [anctags $currentid]
5311 if {$atags ne {}} {
5312 appendrefs follows $atags idtags
5313 }
5314 }
5315 2 {
5316 set dheads [descheads $currentid]
5317 if {$dheads ne {}} {
5318 if {[appendrefs branch $dheads idheads] > 1
5319 && [$ctext get "branch -3c"] eq "h"} {
5320 # turn "Branch" into "Branches"
5321 $ctext conf -state normal
5322 $ctext insert "branch -2c" "es"
5323 $ctext conf -state disabled
5324 }
5325 }
ef030b85
PM
5326 }
5327 }
e11f1233
PM
5328 if {[incr tagphase] <= 2} {
5329 after idle dispnexttag
b8ab2e17 5330 }
b8ab2e17
PM
5331}
5332
0380081c
PM
5333proc make_secsel {l} {
5334 global linehtag linentag linedtag canv canv2 canv3
5335
5336 if {![info exists linehtag($l)]} return
5337 $canv delete secsel
5338 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5339 -tags secsel -fill [$canv cget -selectbackground]]
5340 $canv lower $t
5341 $canv2 delete secsel
5342 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5343 -tags secsel -fill [$canv2 cget -selectbackground]]
5344 $canv2 lower $t
5345 $canv3 delete secsel
5346 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5347 -tags secsel -fill [$canv3 cget -selectbackground]]
5348 $canv3 lower $t
5349}
5350
d698206c 5351proc selectline {l isnew} {
0380081c 5352 global canv ctext commitinfo selectedline
7fcc92bf 5353 global canvy0 linespc parents children curview
7fcceed7 5354 global currentid sha1entry
9f1afe05 5355 global commentend idtags linknum
d94f8cd6 5356 global mergemax numcommits pending_select
e11f1233 5357 global cmitmode showneartags allcommits
d698206c 5358
d94f8cd6 5359 catch {unset pending_select}
84ba7345 5360 $canv delete hover
9843c307 5361 normalline
887c996e 5362 unsel_reflist
bb3edc8b 5363 stopfinding
8f7d0cec 5364 if {$l < 0 || $l >= $numcommits} return
5ad588de 5365 set y [expr {$canvy0 + $l * $linespc}]
17386066 5366 set ymax [lindex [$canv cget -scrollregion] 3]
5842215e
PM
5367 set ytop [expr {$y - $linespc - 1}]
5368 set ybot [expr {$y + $linespc + 1}]
5ad588de 5369 set wnow [$canv yview]
2ed49d54
JH
5370 set wtop [expr {[lindex $wnow 0] * $ymax}]
5371 set wbot [expr {[lindex $wnow 1] * $ymax}]
5842215e
PM
5372 set wh [expr {$wbot - $wtop}]
5373 set newtop $wtop
17386066 5374 if {$ytop < $wtop} {
5842215e
PM
5375 if {$ybot < $wtop} {
5376 set newtop [expr {$y - $wh / 2.0}]
5377 } else {
5378 set newtop $ytop
5379 if {$newtop > $wtop - $linespc} {
5380 set newtop [expr {$wtop - $linespc}]
5381 }
17386066 5382 }
5842215e
PM
5383 } elseif {$ybot > $wbot} {
5384 if {$ytop > $wbot} {
5385 set newtop [expr {$y - $wh / 2.0}]
5386 } else {
5387 set newtop [expr {$ybot - $wh}]
5388 if {$newtop < $wtop + $linespc} {
5389 set newtop [expr {$wtop + $linespc}]
5390 }
17386066 5391 }
5842215e
PM
5392 }
5393 if {$newtop != $wtop} {
5394 if {$newtop < 0} {
5395 set newtop 0
5396 }
2ed49d54 5397 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
9f1afe05 5398 drawvisible
5ad588de 5399 }
d698206c 5400
0380081c 5401 make_secsel $l
9f1afe05 5402
fc2a256f 5403 set id [commitonrow $l]
fa4da7b3 5404 if {$isnew} {
fc2a256f 5405 addtohistory [list selbyid $id]
d698206c
PM
5406 }
5407
5ad588de 5408 set selectedline $l
887fe3c4 5409 set currentid $id
98f350e5
PM
5410 $sha1entry delete 0 end
5411 $sha1entry insert 0 $id
5412 $sha1entry selection from 0
5413 $sha1entry selection to end
164ff275 5414 rhighlight_sel $id
98f350e5 5415
5ad588de 5416 $ctext conf -state normal
3ea06f9f 5417 clear_ctext
106288cb 5418 set linknum 0
1db95b00 5419 set info $commitinfo($id)
232475d3 5420 set date [formatdate [lindex $info 2]]
d990cedf 5421 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
232475d3 5422 set date [formatdate [lindex $info 4]]
d990cedf 5423 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
887fe3c4 5424 if {[info exists idtags($id)]} {
d990cedf 5425 $ctext insert end [mc "Tags:"]
887fe3c4
PM
5426 foreach tag $idtags($id) {
5427 $ctext insert end " $tag"
5428 }
5429 $ctext insert end "\n"
5430 }
40b87ff8 5431
f1b86294 5432 set headers {}
7fcc92bf 5433 set olds $parents($curview,$id)
79b2c75e 5434 if {[llength $olds] > 1} {
b77b0278 5435 set np 0
79b2c75e 5436 foreach p $olds {
b77b0278
PM
5437 if {$np >= $mergemax} {
5438 set tag mmax
5439 } else {
5440 set tag m$np
5441 }
d990cedf 5442 $ctext insert end "[mc "Parent"]: " $tag
f1b86294 5443 appendwithlinks [commit_descriptor $p] {}
b77b0278
PM
5444 incr np
5445 }
5446 } else {
79b2c75e 5447 foreach p $olds {
d990cedf 5448 append headers "[mc "Parent"]: [commit_descriptor $p]"
b1ba39e7
LT
5449 }
5450 }
b77b0278 5451
6a90bff1 5452 foreach c $children($curview,$id) {
d990cedf 5453 append headers "[mc "Child"]: [commit_descriptor $c]"
8b192809 5454 }
d698206c
PM
5455
5456 # make anything that looks like a SHA1 ID be a clickable link
f1b86294 5457 appendwithlinks $headers {}
b8ab2e17
PM
5458 if {$showneartags} {
5459 if {![info exists allcommits]} {
5460 getallcommits
5461 }
d990cedf 5462 $ctext insert end "[mc "Branch"]: "
ef030b85
PM
5463 $ctext mark set branch "end -1c"
5464 $ctext mark gravity branch left
d990cedf 5465 $ctext insert end "\n[mc "Follows"]: "
b8ab2e17
PM
5466 $ctext mark set follows "end -1c"
5467 $ctext mark gravity follows left
d990cedf 5468 $ctext insert end "\n[mc "Precedes"]: "
b8ab2e17
PM
5469 $ctext mark set precedes "end -1c"
5470 $ctext mark gravity precedes left
b8ab2e17 5471 $ctext insert end "\n"
e11f1233 5472 dispneartags 1
b8ab2e17
PM
5473 }
5474 $ctext insert end "\n"
43c25074
PM
5475 set comment [lindex $info 5]
5476 if {[string first "\r" $comment] >= 0} {
5477 set comment [string map {"\r" "\n "} $comment]
5478 }
5479 appendwithlinks $comment {comment}
d698206c 5480
df3d83b1 5481 $ctext tag remove found 1.0 end
5ad588de 5482 $ctext conf -state disabled
df3d83b1 5483 set commentend [$ctext index "end - 1c"]
5ad588de 5484
b007ee20 5485 init_flist [mc "Comments"]
f8b28a40
PM
5486 if {$cmitmode eq "tree"} {
5487 gettree $id
5488 } elseif {[llength $olds] <= 1} {
d327244a 5489 startdiff $id
7b5ff7e7 5490 } else {
7fcc92bf 5491 mergediff $id
3c461ffe
PM
5492 }
5493}
5494
6e5f7203
RN
5495proc selfirstline {} {
5496 unmarkmatches
5497 selectline 0 1
5498}
5499
5500proc sellastline {} {
5501 global numcommits
5502 unmarkmatches
5503 set l [expr {$numcommits - 1}]
5504 selectline $l 1
5505}
5506
3c461ffe
PM
5507proc selnextline {dir} {
5508 global selectedline
bd441de4 5509 focus .
3c461ffe 5510 if {![info exists selectedline]} return
2ed49d54 5511 set l [expr {$selectedline + $dir}]
3c461ffe 5512 unmarkmatches
d698206c
PM
5513 selectline $l 1
5514}
5515
6e5f7203
RN
5516proc selnextpage {dir} {
5517 global canv linespc selectedline numcommits
5518
5519 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5520 if {$lpp < 1} {
5521 set lpp 1
5522 }
5523 allcanvs yview scroll [expr {$dir * $lpp}] units
e72ee5eb 5524 drawvisible
6e5f7203
RN
5525 if {![info exists selectedline]} return
5526 set l [expr {$selectedline + $dir * $lpp}]
5527 if {$l < 0} {
5528 set l 0
5529 } elseif {$l >= $numcommits} {
5530 set l [expr $numcommits - 1]
5531 }
5532 unmarkmatches
40b87ff8 5533 selectline $l 1
6e5f7203
RN
5534}
5535
fa4da7b3 5536proc unselectline {} {
50b44ece 5537 global selectedline currentid
fa4da7b3
PM
5538
5539 catch {unset selectedline}
50b44ece 5540 catch {unset currentid}
fa4da7b3 5541 allcanvs delete secsel
164ff275 5542 rhighlight_none
fa4da7b3
PM
5543}
5544
f8b28a40
PM
5545proc reselectline {} {
5546 global selectedline
5547
5548 if {[info exists selectedline]} {
5549 selectline $selectedline 0
5550 }
5551}
5552
fa4da7b3 5553proc addtohistory {cmd} {
2516dae2 5554 global history historyindex curview
fa4da7b3 5555
2516dae2 5556 set elt [list $curview $cmd]
fa4da7b3 5557 if {$historyindex > 0
2516dae2 5558 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
fa4da7b3
PM
5559 return
5560 }
5561
5562 if {$historyindex < [llength $history]} {
2516dae2 5563 set history [lreplace $history $historyindex end $elt]
fa4da7b3 5564 } else {
2516dae2 5565 lappend history $elt
fa4da7b3
PM
5566 }
5567 incr historyindex
5568 if {$historyindex > 1} {
e9937d2a 5569 .tf.bar.leftbut conf -state normal
fa4da7b3 5570 } else {
e9937d2a 5571 .tf.bar.leftbut conf -state disabled
fa4da7b3 5572 }
e9937d2a 5573 .tf.bar.rightbut conf -state disabled
fa4da7b3
PM
5574}
5575
2516dae2
PM
5576proc godo {elt} {
5577 global curview
5578
5579 set view [lindex $elt 0]
5580 set cmd [lindex $elt 1]
5581 if {$curview != $view} {
5582 showview $view
5583 }
5584 eval $cmd
5585}
5586
d698206c
PM
5587proc goback {} {
5588 global history historyindex
bd441de4 5589 focus .
d698206c
PM
5590
5591 if {$historyindex > 1} {
5592 incr historyindex -1
2516dae2 5593 godo [lindex $history [expr {$historyindex - 1}]]
e9937d2a 5594 .tf.bar.rightbut conf -state normal
d698206c
PM
5595 }
5596 if {$historyindex <= 1} {
e9937d2a 5597 .tf.bar.leftbut conf -state disabled
d698206c
PM
5598 }
5599}
5600
5601proc goforw {} {
5602 global history historyindex
bd441de4 5603 focus .
d698206c
PM
5604
5605 if {$historyindex < [llength $history]} {
fa4da7b3 5606 set cmd [lindex $history $historyindex]
d698206c 5607 incr historyindex
2516dae2 5608 godo $cmd
e9937d2a 5609 .tf.bar.leftbut conf -state normal
d698206c
PM
5610 }
5611 if {$historyindex >= [llength $history]} {
e9937d2a 5612 .tf.bar.rightbut conf -state disabled
d698206c 5613 }
e2ed4324
PM
5614}
5615
f8b28a40 5616proc gettree {id} {
8f489363
PM
5617 global treefilelist treeidlist diffids diffmergeid treepending
5618 global nullid nullid2
f8b28a40
PM
5619
5620 set diffids $id
5621 catch {unset diffmergeid}
5622 if {![info exists treefilelist($id)]} {
5623 if {![info exists treepending]} {
8f489363
PM
5624 if {$id eq $nullid} {
5625 set cmd [list | git ls-files]
5626 } elseif {$id eq $nullid2} {
5627 set cmd [list | git ls-files --stage -t]
219ea3a9 5628 } else {
8f489363 5629 set cmd [list | git ls-tree -r $id]
219ea3a9
PM
5630 }
5631 if {[catch {set gtf [open $cmd r]}]} {
f8b28a40
PM
5632 return
5633 }
5634 set treepending $id
5635 set treefilelist($id) {}
5636 set treeidlist($id) {}
5637 fconfigure $gtf -blocking 0
7eb3cb9c 5638 filerun $gtf [list gettreeline $gtf $id]
f8b28a40
PM
5639 }
5640 } else {
5641 setfilelist $id
5642 }
5643}
5644
5645proc gettreeline {gtf id} {
8f489363 5646 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
f8b28a40 5647
7eb3cb9c
PM
5648 set nl 0
5649 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
8f489363
PM
5650 if {$diffids eq $nullid} {
5651 set fname $line
5652 } else {
5653 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
9396cd38
PM
5654 set i [string first "\t" $line]
5655 if {$i < 0} continue
5656 set sha1 [lindex $line 2]
5657 set fname [string range $line [expr {$i+1}] end]
219ea3a9
PM
5658 if {[string index $fname 0] eq "\""} {
5659 set fname [lindex $fname 0]
5660 }
5661 lappend treeidlist($id) $sha1
219ea3a9 5662 }
7eb3cb9c
PM
5663 lappend treefilelist($id) $fname
5664 }
5665 if {![eof $gtf]} {
5666 return [expr {$nl >= 1000? 2: 1}]
f8b28a40 5667 }
f8b28a40
PM
5668 close $gtf
5669 unset treepending
5670 if {$cmitmode ne "tree"} {
5671 if {![info exists diffmergeid]} {
5672 gettreediffs $diffids
5673 }
5674 } elseif {$id ne $diffids} {
5675 gettree $diffids
5676 } else {
5677 setfilelist $id
5678 }
7eb3cb9c 5679 return 0
f8b28a40
PM
5680}
5681
5682proc showfile {f} {
8f489363 5683 global treefilelist treeidlist diffids nullid nullid2
f8b28a40
PM
5684 global ctext commentend
5685
5686 set i [lsearch -exact $treefilelist($diffids) $f]
5687 if {$i < 0} {
5688 puts "oops, $f not in list for id $diffids"
5689 return
5690 }
8f489363
PM
5691 if {$diffids eq $nullid} {
5692 if {[catch {set bf [open $f r]} err]} {
5693 puts "oops, can't read $f: $err"
219ea3a9
PM
5694 return
5695 }
5696 } else {
8f489363
PM
5697 set blob [lindex $treeidlist($diffids) $i]
5698 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5699 puts "oops, error reading blob $blob: $err"
219ea3a9
PM
5700 return
5701 }
f8b28a40
PM
5702 }
5703 fconfigure $bf -blocking 0
7eb3cb9c 5704 filerun $bf [list getblobline $bf $diffids]
f8b28a40 5705 $ctext config -state normal
3ea06f9f 5706 clear_ctext $commentend
f8b28a40
PM
5707 $ctext insert end "\n"
5708 $ctext insert end "$f\n" filesep
5709 $ctext config -state disabled
5710 $ctext yview $commentend
32f1b3e4 5711 settabs 0
f8b28a40
PM
5712}
5713
5714proc getblobline {bf id} {
5715 global diffids cmitmode ctext
5716
5717 if {$id ne $diffids || $cmitmode ne "tree"} {
5718 catch {close $bf}
7eb3cb9c 5719 return 0
f8b28a40
PM
5720 }
5721 $ctext config -state normal
7eb3cb9c
PM
5722 set nl 0
5723 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
f8b28a40
PM
5724 $ctext insert end "$line\n"
5725 }
5726 if {[eof $bf]} {
5727 # delete last newline
5728 $ctext delete "end - 2c" "end - 1c"
5729 close $bf
7eb3cb9c 5730 return 0
f8b28a40
PM
5731 }
5732 $ctext config -state disabled
7eb3cb9c 5733 return [expr {$nl >= 1000? 2: 1}]
f8b28a40
PM
5734}
5735
7fcc92bf 5736proc mergediff {id} {
8d73b242 5737 global diffmergeid mdifffd
7fcceed7 5738 global diffids
7fcc92bf 5739 global parents
bd8f677e 5740 global limitdiffs viewfiles curview
e2ed4324 5741
3c461ffe 5742 set diffmergeid $id
7a1d9d14 5743 set diffids $id
b77b0278 5744 # this doesn't seem to actually affect anything...
8974c6f9 5745 set cmd [concat | git diff-tree --no-commit-id --cc $id]
bd8f677e
PM
5746 if {$limitdiffs && $viewfiles($curview) ne {}} {
5747 set cmd [concat $cmd -- $viewfiles($curview)]
5748 }
b77b0278 5749 if {[catch {set mdf [open $cmd r]} err]} {
d990cedf 5750 error_popup "[mc "Error getting merge diffs:"] $err"
b77b0278 5751 return
9d2a52ec 5752 }
b77b0278
PM
5753 fconfigure $mdf -blocking 0
5754 set mdifffd($id) $mdf
7fcc92bf 5755 set np [llength $parents($curview,$id)]
32f1b3e4 5756 settabs $np
7eb3cb9c 5757 filerun $mdf [list getmergediffline $mdf $id $np]
9d2a52ec
PM
5758}
5759
79b2c75e 5760proc getmergediffline {mdf id np} {
7eb3cb9c 5761 global diffmergeid ctext cflist mergemax
7a1d9d14 5762 global difffilestart mdifffd
9d2a52ec 5763
7eb3cb9c
PM
5764 $ctext conf -state normal
5765 set nr 0
5766 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5767 if {![info exists diffmergeid] || $id != $diffmergeid
5768 || $mdf != $mdifffd($id)} {
b77b0278 5769 close $mdf
7eb3cb9c 5770 return 0
9d2a52ec 5771 }
7eb3cb9c
PM
5772 if {[regexp {^diff --cc (.*)} $line match fname]} {
5773 # start of a new file
5774 $ctext insert end "\n"
5775 set here [$ctext index "end - 1c"]
5776 lappend difffilestart $here
5777 add_flist [list $fname]
5778 set l [expr {(78 - [string length $fname]) / 2}]
5779 set pad [string range "----------------------------------------" 1 $l]
5780 $ctext insert end "$pad $fname $pad\n" filesep
5781 } elseif {[regexp {^@@} $line]} {
5782 $ctext insert end "$line\n" hunksep
5783 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5784 # do nothing
5785 } else {
5786 # parse the prefix - one ' ', '-' or '+' for each parent
5787 set spaces {}
5788 set minuses {}
5789 set pluses {}
5790 set isbad 0
5791 for {set j 0} {$j < $np} {incr j} {
5792 set c [string range $line $j $j]
5793 if {$c == " "} {
5794 lappend spaces $j
5795 } elseif {$c == "-"} {
5796 lappend minuses $j
5797 } elseif {$c == "+"} {
5798 lappend pluses $j
5799 } else {
5800 set isbad 1
5801 break
5802 }
c8a4acbf 5803 }
7eb3cb9c
PM
5804 set tags {}
5805 set num {}
5806 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5807 # line doesn't appear in result, parents in $minuses have the line
5808 set num [lindex $minuses 0]
5809 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5810 # line appears in result, parents in $pluses don't have the line
5811 lappend tags mresult
5812 set num [lindex $spaces 0]
c8a4acbf 5813 }
7eb3cb9c
PM
5814 if {$num ne {}} {
5815 if {$num >= $mergemax} {
5816 set num "max"
5817 }
5818 lappend tags m$num
5819 }
5820 $ctext insert end "$line\n" $tags
c8a4acbf 5821 }
9d2a52ec
PM
5822 }
5823 $ctext conf -state disabled
7eb3cb9c
PM
5824 if {[eof $mdf]} {
5825 close $mdf
5826 return 0
c8a4acbf 5827 }
7eb3cb9c 5828 return [expr {$nr >= 1000? 2: 1}]
c8a4acbf
PM
5829}
5830
3c461ffe 5831proc startdiff {ids} {
8f489363 5832 global treediffs diffids treepending diffmergeid nullid nullid2
c8dfbcf9 5833
32f1b3e4 5834 settabs 1
4f2c2642 5835 set diffids $ids
3c461ffe 5836 catch {unset diffmergeid}
8f489363
PM
5837 if {![info exists treediffs($ids)] ||
5838 [lsearch -exact $ids $nullid] >= 0 ||
5839 [lsearch -exact $ids $nullid2] >= 0} {
c8dfbcf9 5840 if {![info exists treepending]} {
14c9dbd6 5841 gettreediffs $ids
c8dfbcf9
PM
5842 }
5843 } else {
14c9dbd6 5844 addtocflist $ids
c8dfbcf9
PM
5845 }
5846}
5847
7a39a17a
PM
5848proc path_filter {filter name} {
5849 foreach p $filter {
5850 set l [string length $p]
74a40c71
PM
5851 if {[string index $p end] eq "/"} {
5852 if {[string compare -length $l $p $name] == 0} {
5853 return 1
5854 }
5855 } else {
5856 if {[string compare -length $l $p $name] == 0 &&
5857 ([string length $name] == $l ||
5858 [string index $name $l] eq "/")} {
5859 return 1
5860 }
7a39a17a
PM
5861 }
5862 }
5863 return 0
5864}
5865
c8dfbcf9 5866proc addtocflist {ids} {
74a40c71 5867 global treediffs
7a39a17a 5868
74a40c71 5869 add_flist $treediffs($ids)
c8dfbcf9 5870 getblobdiffs $ids
d2610d11
PM
5871}
5872
219ea3a9 5873proc diffcmd {ids flags} {
8f489363 5874 global nullid nullid2
219ea3a9
PM
5875
5876 set i [lsearch -exact $ids $nullid]
8f489363 5877 set j [lsearch -exact $ids $nullid2]
219ea3a9 5878 if {$i >= 0} {
8f489363
PM
5879 if {[llength $ids] > 1 && $j < 0} {
5880 # comparing working directory with some specific revision
5881 set cmd [concat | git diff-index $flags]
5882 if {$i == 0} {
5883 lappend cmd -R [lindex $ids 1]
5884 } else {
5885 lappend cmd [lindex $ids 0]
5886 }
5887 } else {
5888 # comparing working directory with index
5889 set cmd [concat | git diff-files $flags]
5890 if {$j == 1} {
5891 lappend cmd -R
5892 }
5893 }
5894 } elseif {$j >= 0} {
5895 set cmd [concat | git diff-index --cached $flags]
219ea3a9 5896 if {[llength $ids] > 1} {
8f489363 5897 # comparing index with specific revision
219ea3a9
PM
5898 if {$i == 0} {
5899 lappend cmd -R [lindex $ids 1]
5900 } else {
5901 lappend cmd [lindex $ids 0]
5902 }
5903 } else {
8f489363 5904 # comparing index with HEAD
219ea3a9
PM
5905 lappend cmd HEAD
5906 }
5907 } else {
8f489363 5908 set cmd [concat | git diff-tree -r $flags $ids]
219ea3a9
PM
5909 }
5910 return $cmd
5911}
5912
c8dfbcf9 5913proc gettreediffs {ids} {
79b2c75e 5914 global treediff treepending
219ea3a9 5915
c8dfbcf9 5916 set treepending $ids
3c461ffe 5917 set treediff {}
8f489363 5918 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
d2610d11 5919 fconfigure $gdtf -blocking 0
7eb3cb9c 5920 filerun $gdtf [list gettreediffline $gdtf $ids]
d2610d11
PM
5921}
5922
c8dfbcf9 5923proc gettreediffline {gdtf ids} {
3c461ffe 5924 global treediff treediffs treepending diffids diffmergeid
74a40c71 5925 global cmitmode viewfiles curview limitdiffs
3c461ffe 5926
7eb3cb9c
PM
5927 set nr 0
5928 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
9396cd38
PM
5929 set i [string first "\t" $line]
5930 if {$i >= 0} {
5931 set file [string range $line [expr {$i+1}] end]
5932 if {[string index $file 0] eq "\""} {
5933 set file [lindex $file 0]
5934 }
5935 lappend treediff $file
5936 }
7eb3cb9c
PM
5937 }
5938 if {![eof $gdtf]} {
5939 return [expr {$nr >= 1000? 2: 1}]
5940 }
5941 close $gdtf
74a40c71
PM
5942 if {$limitdiffs && $viewfiles($curview) ne {}} {
5943 set flist {}
5944 foreach f $treediff {
5945 if {[path_filter $viewfiles($curview) $f]} {
5946 lappend flist $f
5947 }
5948 }
5949 set treediffs($ids) $flist
5950 } else {
5951 set treediffs($ids) $treediff
5952 }
7eb3cb9c
PM
5953 unset treepending
5954 if {$cmitmode eq "tree"} {
5955 gettree $diffids
5956 } elseif {$ids != $diffids} {
5957 if {![info exists diffmergeid]} {
5958 gettreediffs $diffids
b74fd579 5959 }
7eb3cb9c
PM
5960 } else {
5961 addtocflist $ids
d2610d11 5962 }
7eb3cb9c 5963 return 0
d2610d11
PM
5964}
5965
890fae70
SP
5966# empty string or positive integer
5967proc diffcontextvalidate {v} {
5968 return [regexp {^(|[1-9][0-9]*)$} $v]
5969}
5970
5971proc diffcontextchange {n1 n2 op} {
5972 global diffcontextstring diffcontext
5973
5974 if {[string is integer -strict $diffcontextstring]} {
5975 if {$diffcontextstring > 0} {
5976 set diffcontext $diffcontextstring
5977 reselectline
5978 }
5979 }
5980}
5981
c8dfbcf9 5982proc getblobdiffs {ids} {
8d73b242 5983 global blobdifffd diffids env
7eb3cb9c 5984 global diffinhdr treediffs
890fae70 5985 global diffcontext
7a39a17a 5986 global limitdiffs viewfiles curview
c8dfbcf9 5987
7a39a17a
PM
5988 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5989 if {$limitdiffs && $viewfiles($curview) ne {}} {
bd8f677e 5990 set cmd [concat $cmd -- $viewfiles($curview)]
7a39a17a
PM
5991 }
5992 if {[catch {set bdf [open $cmd r]} err]} {
e5c2d856
PM
5993 puts "error getting diffs: $err"
5994 return
5995 }
4f2c2642 5996 set diffinhdr 0
e5c2d856 5997 fconfigure $bdf -blocking 0
c8dfbcf9 5998 set blobdifffd($ids) $bdf
7eb3cb9c 5999 filerun $bdf [list getblobdiffline $bdf $diffids]
e5c2d856
PM
6000}
6001
89b11d3b
PM
6002proc setinlist {var i val} {
6003 global $var
6004
6005 while {[llength [set $var]] < $i} {
6006 lappend $var {}
6007 }
6008 if {[llength [set $var]] == $i} {
6009 lappend $var $val
6010 } else {
6011 lset $var $i $val
6012 }
6013}
6014
9396cd38
PM
6015proc makediffhdr {fname ids} {
6016 global ctext curdiffstart treediffs
6017
6018 set i [lsearch -exact $treediffs($ids) $fname]
6019 if {$i >= 0} {
6020 setinlist difffilestart $i $curdiffstart
6021 }
6022 set l [expr {(78 - [string length $fname]) / 2}]
6023 set pad [string range "----------------------------------------" 1 $l]
6024 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6025}
6026
c8dfbcf9 6027proc getblobdiffline {bdf ids} {
9396cd38 6028 global diffids blobdifffd ctext curdiffstart
7eab2933 6029 global diffnexthead diffnextnote difffilestart
7eb3cb9c 6030 global diffinhdr treediffs
c8dfbcf9 6031
7eb3cb9c 6032 set nr 0
e5c2d856 6033 $ctext conf -state normal
7eb3cb9c
PM
6034 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6035 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6036 close $bdf
6037 return 0
89b11d3b 6038 }
9396cd38
PM
6039 if {![string compare -length 11 "diff --git " $line]} {
6040 # trim off "diff --git "
6041 set line [string range $line 11 end]
6042 set diffinhdr 1
7eb3cb9c
PM
6043 # start of a new file
6044 $ctext insert end "\n"
9396cd38
PM
6045 set curdiffstart [$ctext index "end - 1c"]
6046 $ctext insert end "\n" filesep
6047 # If the name hasn't changed the length will be odd,
6048 # the middle char will be a space, and the two bits either
6049 # side will be a/name and b/name, or "a/name" and "b/name".
6050 # If the name has changed we'll get "rename from" and
d1cb298b
JS
6051 # "rename to" or "copy from" and "copy to" lines following this,
6052 # and we'll use them to get the filenames.
9396cd38
PM
6053 # This complexity is necessary because spaces in the filename(s)
6054 # don't get escaped.
6055 set l [string length $line]
6056 set i [expr {$l / 2}]
6057 if {!(($l & 1) && [string index $line $i] eq " " &&
6058 [string range $line 2 [expr {$i - 1}]] eq \
6059 [string range $line [expr {$i + 3}] end])} {
6060 continue
89b11d3b 6061 }
9396cd38
PM
6062 # unescape if quoted and chop off the a/ from the front
6063 if {[string index $line 0] eq "\""} {
6064 set fname [string range [lindex $line 0] 2 end]
6065 } else {
6066 set fname [string range $line 2 [expr {$i - 1}]]
7eb3cb9c 6067 }
9396cd38
PM
6068 makediffhdr $fname $ids
6069
6070 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
7eb3cb9c
PM
6071 $line match f1l f1c f2l f2c rest]} {
6072 $ctext insert end "$line\n" hunksep
6073 set diffinhdr 0
9396cd38
PM
6074
6075 } elseif {$diffinhdr} {
5e85ec4c 6076 if {![string compare -length 12 "rename from " $line]} {
d1cb298b 6077 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
9396cd38
PM
6078 if {[string index $fname 0] eq "\""} {
6079 set fname [lindex $fname 0]
6080 }
6081 set i [lsearch -exact $treediffs($ids) $fname]
6082 if {$i >= 0} {
6083 setinlist difffilestart $i $curdiffstart
6084 }
d1cb298b
JS
6085 } elseif {![string compare -length 10 $line "rename to "] ||
6086 ![string compare -length 8 $line "copy to "]} {
6087 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
9396cd38
PM
6088 if {[string index $fname 0] eq "\""} {
6089 set fname [lindex $fname 0]
6090 }
6091 makediffhdr $fname $ids
6092 } elseif {[string compare -length 3 $line "---"] == 0} {
6093 # do nothing
6094 continue
6095 } elseif {[string compare -length 3 $line "+++"] == 0} {
6096 set diffinhdr 0
6097 continue
6098 }
6099 $ctext insert end "$line\n" filesep
6100
e5c2d856 6101 } else {
7eb3cb9c
PM
6102 set x [string range $line 0 0]
6103 if {$x == "-" || $x == "+"} {
6104 set tag [expr {$x == "+"}]
6105 $ctext insert end "$line\n" d$tag
6106 } elseif {$x == " "} {
6107 $ctext insert end "$line\n"
7eb3cb9c 6108 } else {
9396cd38
PM
6109 # "\ No newline at end of file",
6110 # or something else we don't recognize
6111 $ctext insert end "$line\n" hunksep
e5c2d856 6112 }
e5c2d856
PM
6113 }
6114 }
6115 $ctext conf -state disabled
7eb3cb9c
PM
6116 if {[eof $bdf]} {
6117 close $bdf
7eb3cb9c 6118 return 0
c8dfbcf9 6119 }
7eb3cb9c 6120 return [expr {$nr >= 1000? 2: 1}]
e5c2d856
PM
6121}
6122
a8d610a2
PM
6123proc changediffdisp {} {
6124 global ctext diffelide
6125
6126 $ctext tag conf d0 -elide [lindex $diffelide 0]
6127 $ctext tag conf d1 -elide [lindex $diffelide 1]
6128}
6129
67c22874
OH
6130proc prevfile {} {
6131 global difffilestart ctext
6132 set prev [lindex $difffilestart 0]
6133 set here [$ctext index @0,0]
6134 foreach loc $difffilestart {
6135 if {[$ctext compare $loc >= $here]} {
6136 $ctext yview $prev
6137 return
6138 }
6139 set prev $loc
6140 }
6141 $ctext yview $prev
6142}
6143
39ad8570
PM
6144proc nextfile {} {
6145 global difffilestart ctext
6146 set here [$ctext index @0,0]
7fcceed7
PM
6147 foreach loc $difffilestart {
6148 if {[$ctext compare $loc > $here]} {
6149 $ctext yview $loc
67c22874 6150 return
39ad8570
PM
6151 }
6152 }
1db95b00
PM
6153}
6154
3ea06f9f
PM
6155proc clear_ctext {{first 1.0}} {
6156 global ctext smarktop smarkbot
97645683 6157 global pendinglinks
3ea06f9f 6158
1902c270
PM
6159 set l [lindex [split $first .] 0]
6160 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6161 set smarktop $l
3ea06f9f 6162 }
1902c270
PM
6163 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6164 set smarkbot $l
3ea06f9f
PM
6165 }
6166 $ctext delete $first end
97645683
PM
6167 if {$first eq "1.0"} {
6168 catch {unset pendinglinks}
6169 }
3ea06f9f
PM
6170}
6171
32f1b3e4 6172proc settabs {{firstab {}}} {
9c311b32 6173 global firsttabstop tabstop ctext have_tk85
32f1b3e4
PM
6174
6175 if {$firstab ne {} && $have_tk85} {
6176 set firsttabstop $firstab
6177 }
9c311b32 6178 set w [font measure textfont "0"]
32f1b3e4 6179 if {$firsttabstop != 0} {
64b5f146
PM
6180 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6181 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
32f1b3e4
PM
6182 } elseif {$have_tk85 || $tabstop != 8} {
6183 $ctext conf -tabs [expr {$tabstop * $w}]
6184 } else {
6185 $ctext conf -tabs {}
6186 }
3ea06f9f
PM
6187}
6188
6189proc incrsearch {name ix op} {
1902c270 6190 global ctext searchstring searchdirn
3ea06f9f
PM
6191
6192 $ctext tag remove found 1.0 end
1902c270
PM
6193 if {[catch {$ctext index anchor}]} {
6194 # no anchor set, use start of selection, or of visible area
6195 set sel [$ctext tag ranges sel]
6196 if {$sel ne {}} {
6197 $ctext mark set anchor [lindex $sel 0]
6198 } elseif {$searchdirn eq "-forwards"} {
6199 $ctext mark set anchor @0,0
6200 } else {
6201 $ctext mark set anchor @0,[winfo height $ctext]
6202 }
6203 }
3ea06f9f 6204 if {$searchstring ne {}} {
1902c270
PM
6205 set here [$ctext search $searchdirn -- $searchstring anchor]
6206 if {$here ne {}} {
6207 $ctext see $here
6208 }
3ea06f9f
PM
6209 searchmarkvisible 1
6210 }
6211}
6212
6213proc dosearch {} {
1902c270 6214 global sstring ctext searchstring searchdirn
3ea06f9f
PM
6215
6216 focus $sstring
6217 $sstring icursor end
1902c270
PM
6218 set searchdirn -forwards
6219 if {$searchstring ne {}} {
6220 set sel [$ctext tag ranges sel]
6221 if {$sel ne {}} {
6222 set start "[lindex $sel 0] + 1c"
6223 } elseif {[catch {set start [$ctext index anchor]}]} {
6224 set start "@0,0"
6225 }
6226 set match [$ctext search -count mlen -- $searchstring $start]
6227 $ctext tag remove sel 1.0 end
6228 if {$match eq {}} {
6229 bell
6230 return
6231 }
6232 $ctext see $match
6233 set mend "$match + $mlen c"
6234 $ctext tag add sel $match $mend
6235 $ctext mark unset anchor
6236 }
6237}
6238
6239proc dosearchback {} {
6240 global sstring ctext searchstring searchdirn
6241
6242 focus $sstring
6243 $sstring icursor end
6244 set searchdirn -backwards
6245 if {$searchstring ne {}} {
6246 set sel [$ctext tag ranges sel]
6247 if {$sel ne {}} {
6248 set start [lindex $sel 0]
6249 } elseif {[catch {set start [$ctext index anchor]}]} {
6250 set start @0,[winfo height $ctext]
6251 }
6252 set match [$ctext search -backwards -count ml -- $searchstring $start]
6253 $ctext tag remove sel 1.0 end
6254 if {$match eq {}} {
6255 bell
6256 return
6257 }
6258 $ctext see $match
6259 set mend "$match + $ml c"
6260 $ctext tag add sel $match $mend
6261 $ctext mark unset anchor
3ea06f9f 6262 }
3ea06f9f
PM
6263}
6264
6265proc searchmark {first last} {
6266 global ctext searchstring
6267
6268 set mend $first.0
6269 while {1} {
6270 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6271 if {$match eq {}} break
6272 set mend "$match + $mlen c"
6273 $ctext tag add found $match $mend
6274 }
6275}
6276
6277proc searchmarkvisible {doall} {
6278 global ctext smarktop smarkbot
6279
6280 set topline [lindex [split [$ctext index @0,0] .] 0]
6281 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6282 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6283 # no overlap with previous
6284 searchmark $topline $botline
6285 set smarktop $topline
6286 set smarkbot $botline
6287 } else {
6288 if {$topline < $smarktop} {
6289 searchmark $topline [expr {$smarktop-1}]
6290 set smarktop $topline
6291 }
6292 if {$botline > $smarkbot} {
6293 searchmark [expr {$smarkbot+1}] $botline
6294 set smarkbot $botline
6295 }
6296 }
6297}
6298
6299proc scrolltext {f0 f1} {
1902c270 6300 global searchstring
3ea06f9f 6301
e9937d2a 6302 .bleft.sb set $f0 $f1
3ea06f9f
PM
6303 if {$searchstring ne {}} {
6304 searchmarkvisible 0
6305 }
6306}
6307
1d10f36d 6308proc setcoords {} {
9c311b32 6309 global linespc charspc canvx0 canvy0
f6075eba 6310 global xspc1 xspc2 lthickness
8d858d1a 6311
9c311b32
PM
6312 set linespc [font metrics mainfont -linespace]
6313 set charspc [font measure mainfont "m"]
9f1afe05
PM
6314 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6315 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
f6075eba 6316 set lthickness [expr {int($linespc / 9) + 1}]
8d858d1a
PM
6317 set xspc1(0) $linespc
6318 set xspc2 $linespc
9a40c50c 6319}
1db95b00 6320
1d10f36d 6321proc redisplay {} {
be0cd098 6322 global canv
9f1afe05
PM
6323 global selectedline
6324
6325 set ymax [lindex [$canv cget -scrollregion] 3]
6326 if {$ymax eq {} || $ymax == 0} return
6327 set span [$canv yview]
6328 clear_display
be0cd098 6329 setcanvscroll
9f1afe05
PM
6330 allcanvs yview moveto [lindex $span 0]
6331 drawvisible
6332 if {[info exists selectedline]} {
6333 selectline $selectedline 0
ca6d8f58 6334 allcanvs yview moveto [lindex $span 0]
1d10f36d
PM
6335 }
6336}
6337
0ed1dd3c
PM
6338proc parsefont {f n} {
6339 global fontattr
6340
6341 set fontattr($f,family) [lindex $n 0]
6342 set s [lindex $n 1]
6343 if {$s eq {} || $s == 0} {
6344 set s 10
6345 } elseif {$s < 0} {
6346 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
9c311b32 6347 }
0ed1dd3c
PM
6348 set fontattr($f,size) $s
6349 set fontattr($f,weight) normal
6350 set fontattr($f,slant) roman
6351 foreach style [lrange $n 2 end] {
6352 switch -- $style {
6353 "normal" -
6354 "bold" {set fontattr($f,weight) $style}
6355 "roman" -
6356 "italic" {set fontattr($f,slant) $style}
6357 }
9c311b32 6358 }
0ed1dd3c
PM
6359}
6360
6361proc fontflags {f {isbold 0}} {
6362 global fontattr
6363
6364 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6365 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6366 -slant $fontattr($f,slant)]
6367}
6368
6369proc fontname {f} {
6370 global fontattr
6371
6372 set n [list $fontattr($f,family) $fontattr($f,size)]
6373 if {$fontattr($f,weight) eq "bold"} {
6374 lappend n "bold"
9c311b32 6375 }
0ed1dd3c
PM
6376 if {$fontattr($f,slant) eq "italic"} {
6377 lappend n "italic"
9c311b32 6378 }
0ed1dd3c 6379 return $n
9c311b32
PM
6380}
6381
1d10f36d 6382proc incrfont {inc} {
7fcc92bf 6383 global mainfont textfont ctext canv cflist showrefstop
0ed1dd3c
PM
6384 global stopped entries fontattr
6385
1d10f36d 6386 unmarkmatches
0ed1dd3c 6387 set s $fontattr(mainfont,size)
9c311b32
PM
6388 incr s $inc
6389 if {$s < 1} {
6390 set s 1
6391 }
0ed1dd3c 6392 set fontattr(mainfont,size) $s
9c311b32
PM
6393 font config mainfont -size $s
6394 font config mainfontbold -size $s
0ed1dd3c
PM
6395 set mainfont [fontname mainfont]
6396 set s $fontattr(textfont,size)
9c311b32
PM
6397 incr s $inc
6398 if {$s < 1} {
6399 set s 1
6400 }
0ed1dd3c 6401 set fontattr(textfont,size) $s
9c311b32
PM
6402 font config textfont -size $s
6403 font config textfontbold -size $s
0ed1dd3c 6404 set textfont [fontname textfont]
1d10f36d 6405 setcoords
32f1b3e4 6406 settabs
1d10f36d
PM
6407 redisplay
6408}
1db95b00 6409
ee3dc72e
PM
6410proc clearsha1 {} {
6411 global sha1entry sha1string
6412 if {[string length $sha1string] == 40} {
6413 $sha1entry delete 0 end
6414 }
6415}
6416
887fe3c4
PM
6417proc sha1change {n1 n2 op} {
6418 global sha1string currentid sha1but
6419 if {$sha1string == {}
6420 || ([info exists currentid] && $sha1string == $currentid)} {
6421 set state disabled
6422 } else {
6423 set state normal
6424 }
6425 if {[$sha1but cget -state] == $state} return
6426 if {$state == "normal"} {
d990cedf 6427 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
887fe3c4 6428 } else {
d990cedf 6429 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
887fe3c4
PM
6430 }
6431}
6432
6433proc gotocommit {} {
7fcc92bf 6434 global sha1string tagids headids curview varcid
f3b8b3ce 6435
887fe3c4
PM
6436 if {$sha1string == {}
6437 || ([info exists currentid] && $sha1string == $currentid)} return
6438 if {[info exists tagids($sha1string)]} {
6439 set id $tagids($sha1string)
e1007129
SR
6440 } elseif {[info exists headids($sha1string)]} {
6441 set id $headids($sha1string)
887fe3c4
PM
6442 } else {
6443 set id [string tolower $sha1string]
f3b8b3ce 6444 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7fcc92bf 6445 set matches [array names varcid "$curview,$id*"]
f3b8b3ce
PM
6446 if {$matches ne {}} {
6447 if {[llength $matches] > 1} {
d990cedf 6448 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
f3b8b3ce
PM
6449 return
6450 }
7fcc92bf 6451 set id [lindex [split [lindex $matches 0] ","] 1]
f3b8b3ce
PM
6452 }
6453 }
887fe3c4 6454 }
7fcc92bf
PM
6455 if {[commitinview $id $curview]} {
6456 selectline [rowofcommit $id] 1
887fe3c4
PM
6457 return
6458 }
f3b8b3ce 6459 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
d990cedf 6460 set msg [mc "SHA1 id %s is not known" $sha1string]
887fe3c4 6461 } else {
d990cedf 6462 set msg [mc "Tag/Head %s is not known" $sha1string]
887fe3c4 6463 }
d990cedf 6464 error_popup $msg
887fe3c4
PM
6465}
6466
84ba7345
PM
6467proc lineenter {x y id} {
6468 global hoverx hovery hoverid hovertimer
6469 global commitinfo canv
6470
8ed16484 6471 if {![info exists commitinfo($id)] && ![getcommit $id]} return
84ba7345
PM
6472 set hoverx $x
6473 set hovery $y
6474 set hoverid $id
6475 if {[info exists hovertimer]} {
6476 after cancel $hovertimer
6477 }
6478 set hovertimer [after 500 linehover]
6479 $canv delete hover
6480}
6481
6482proc linemotion {x y id} {
6483 global hoverx hovery hoverid hovertimer
6484
6485 if {[info exists hoverid] && $id == $hoverid} {
6486 set hoverx $x
6487 set hovery $y
6488 if {[info exists hovertimer]} {
6489 after cancel $hovertimer
6490 }
6491 set hovertimer [after 500 linehover]
6492 }
6493}
6494
6495proc lineleave {id} {
6496 global hoverid hovertimer canv
6497
6498 if {[info exists hoverid] && $id == $hoverid} {
6499 $canv delete hover
6500 if {[info exists hovertimer]} {
6501 after cancel $hovertimer
6502 unset hovertimer
6503 }
6504 unset hoverid
6505 }
6506}
6507
6508proc linehover {} {
6509 global hoverx hovery hoverid hovertimer
6510 global canv linespc lthickness
9c311b32 6511 global commitinfo
84ba7345
PM
6512
6513 set text [lindex $commitinfo($hoverid) 0]
6514 set ymax [lindex [$canv cget -scrollregion] 3]
6515 if {$ymax == {}} return
6516 set yfrac [lindex [$canv yview] 0]
6517 set x [expr {$hoverx + 2 * $linespc}]
6518 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6519 set x0 [expr {$x - 2 * $lthickness}]
6520 set y0 [expr {$y - 2 * $lthickness}]
9c311b32 6521 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
84ba7345
PM
6522 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6523 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6524 -fill \#ffff80 -outline black -width 1 -tags hover]
6525 $canv raise $t
f8a2c0d1 6526 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
9c311b32 6527 -font mainfont]
84ba7345
PM
6528 $canv raise $t
6529}
6530
9843c307 6531proc clickisonarrow {id y} {
50b44ece 6532 global lthickness
9843c307 6533
50b44ece 6534 set ranges [rowranges $id]
9843c307 6535 set thresh [expr {2 * $lthickness + 6}]
50b44ece 6536 set n [expr {[llength $ranges] - 1}]
f6342480 6537 for {set i 1} {$i < $n} {incr i} {
50b44ece 6538 set row [lindex $ranges $i]
f6342480
PM
6539 if {abs([yc $row] - $y) < $thresh} {
6540 return $i
9843c307
PM
6541 }
6542 }
6543 return {}
6544}
6545
f6342480 6546proc arrowjump {id n y} {
50b44ece 6547 global canv
9843c307 6548
f6342480
PM
6549 # 1 <-> 2, 3 <-> 4, etc...
6550 set n [expr {(($n - 1) ^ 1) + 1}]
50b44ece 6551 set row [lindex [rowranges $id] $n]
f6342480 6552 set yt [yc $row]
9843c307
PM
6553 set ymax [lindex [$canv cget -scrollregion] 3]
6554 if {$ymax eq {} || $ymax <= 0} return
6555 set view [$canv yview]
6556 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6557 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6558 if {$yfrac < 0} {
6559 set yfrac 0
6560 }
f6342480 6561 allcanvs yview moveto $yfrac
9843c307
PM
6562}
6563
fa4da7b3 6564proc lineclick {x y id isnew} {
7fcc92bf 6565 global ctext commitinfo children canv thickerline curview
c8dfbcf9 6566
8ed16484 6567 if {![info exists commitinfo($id)] && ![getcommit $id]} return
c8dfbcf9 6568 unmarkmatches
fa4da7b3 6569 unselectline
9843c307
PM
6570 normalline
6571 $canv delete hover
6572 # draw this line thicker than normal
9843c307 6573 set thickerline $id
c934a8a3 6574 drawlines $id
fa4da7b3 6575 if {$isnew} {
9843c307
PM
6576 set ymax [lindex [$canv cget -scrollregion] 3]
6577 if {$ymax eq {}} return
6578 set yfrac [lindex [$canv yview] 0]
6579 set y [expr {$y + $yfrac * $ymax}]
6580 }
6581 set dirn [clickisonarrow $id $y]
6582 if {$dirn ne {}} {
6583 arrowjump $id $dirn $y
6584 return
6585 }
6586
6587 if {$isnew} {
6588 addtohistory [list lineclick $x $y $id 0]
fa4da7b3 6589 }
c8dfbcf9
PM
6590 # fill the details pane with info about this line
6591 $ctext conf -state normal
3ea06f9f 6592 clear_ctext
32f1b3e4 6593 settabs 0
d990cedf 6594 $ctext insert end "[mc "Parent"]:\t"
97645683
PM
6595 $ctext insert end $id link0
6596 setlink $id link0
c8dfbcf9 6597 set info $commitinfo($id)
fa4da7b3 6598 $ctext insert end "\n\t[lindex $info 0]\n"
d990cedf 6599 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
232475d3 6600 set date [formatdate [lindex $info 2]]
d990cedf 6601 $ctext insert end "\t[mc "Date"]:\t$date\n"
da7c24dd 6602 set kids $children($curview,$id)
79b2c75e 6603 if {$kids ne {}} {
d990cedf 6604 $ctext insert end "\n[mc "Children"]:"
fa4da7b3 6605 set i 0
79b2c75e 6606 foreach child $kids {
fa4da7b3 6607 incr i
8ed16484 6608 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
c8dfbcf9 6609 set info $commitinfo($child)
fa4da7b3 6610 $ctext insert end "\n\t"
97645683
PM
6611 $ctext insert end $child link$i
6612 setlink $child link$i
fa4da7b3 6613 $ctext insert end "\n\t[lindex $info 0]"
d990cedf 6614 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
232475d3 6615 set date [formatdate [lindex $info 2]]
d990cedf 6616 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
c8dfbcf9
PM
6617 }
6618 }
6619 $ctext conf -state disabled
7fcceed7 6620 init_flist {}
c8dfbcf9
PM
6621}
6622
9843c307
PM
6623proc normalline {} {
6624 global thickerline
6625 if {[info exists thickerline]} {
c934a8a3 6626 set id $thickerline
9843c307 6627 unset thickerline
c934a8a3 6628 drawlines $id
9843c307
PM
6629 }
6630}
6631
c8dfbcf9 6632proc selbyid {id} {
7fcc92bf
PM
6633 global curview
6634 if {[commitinview $id $curview]} {
6635 selectline [rowofcommit $id] 1
c8dfbcf9
PM
6636 }
6637}
6638
6639proc mstime {} {
6640 global startmstime
6641 if {![info exists startmstime]} {
6642 set startmstime [clock clicks -milliseconds]
6643 }
6644 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6645}
6646
6647proc rowmenu {x y id} {
7fcc92bf 6648 global rowctxmenu selectedline rowmenuid curview
8f489363 6649 global nullid nullid2 fakerowmenu mainhead
c8dfbcf9 6650
bb3edc8b 6651 stopfinding
219ea3a9 6652 set rowmenuid $id
da7c24dd 6653 if {![info exists selectedline]
7fcc92bf 6654 || [rowofcommit $id] eq $selectedline} {
c8dfbcf9
PM
6655 set state disabled
6656 } else {
6657 set state normal
6658 }
8f489363 6659 if {$id ne $nullid && $id ne $nullid2} {
219ea3a9 6660 set menu $rowctxmenu
d990cedf 6661 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
219ea3a9
PM
6662 } else {
6663 set menu $fakerowmenu
6664 }
d990cedf
CS
6665 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6666 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6667 $menu entryconfigure [mc "Make patch"] -state $state
219ea3a9 6668 tk_popup $menu $x $y
c8dfbcf9
PM
6669}
6670
6671proc diffvssel {dirn} {
7fcc92bf 6672 global rowmenuid selectedline
c8dfbcf9
PM
6673
6674 if {![info exists selectedline]} return
6675 if {$dirn} {
7fcc92bf 6676 set oldid [commitonrow $selectedline]
c8dfbcf9
PM
6677 set newid $rowmenuid
6678 } else {
6679 set oldid $rowmenuid
7fcc92bf 6680 set newid [commitonrow $selectedline]
c8dfbcf9 6681 }
fa4da7b3
PM
6682 addtohistory [list doseldiff $oldid $newid]
6683 doseldiff $oldid $newid
6684}
6685
6686proc doseldiff {oldid newid} {
7fcceed7 6687 global ctext
fa4da7b3
PM
6688 global commitinfo
6689
c8dfbcf9 6690 $ctext conf -state normal
3ea06f9f 6691 clear_ctext
d990cedf
CS
6692 init_flist [mc "Top"]
6693 $ctext insert end "[mc "From"] "
97645683
PM
6694 $ctext insert end $oldid link0
6695 setlink $oldid link0
fa4da7b3 6696 $ctext insert end "\n "
c8dfbcf9 6697 $ctext insert end [lindex $commitinfo($oldid) 0]
d990cedf 6698 $ctext insert end "\n\n[mc "To"] "
97645683
PM
6699 $ctext insert end $newid link1
6700 setlink $newid link1
fa4da7b3 6701 $ctext insert end "\n "
c8dfbcf9
PM
6702 $ctext insert end [lindex $commitinfo($newid) 0]
6703 $ctext insert end "\n"
6704 $ctext conf -state disabled
c8dfbcf9 6705 $ctext tag remove found 1.0 end
d327244a 6706 startdiff [list $oldid $newid]
c8dfbcf9
PM
6707}
6708
74daedb6
PM
6709proc mkpatch {} {
6710 global rowmenuid currentid commitinfo patchtop patchnum
6711
6712 if {![info exists currentid]} return
6713 set oldid $currentid
6714 set oldhead [lindex $commitinfo($oldid) 0]
6715 set newid $rowmenuid
6716 set newhead [lindex $commitinfo($newid) 0]
6717 set top .patch
6718 set patchtop $top
6719 catch {destroy $top}
6720 toplevel $top
d990cedf 6721 label $top.title -text [mc "Generate patch"]
4a2139f5 6722 grid $top.title - -pady 10
d990cedf 6723 label $top.from -text [mc "From:"]
4a2139f5 6724 entry $top.fromsha1 -width 40 -relief flat
74daedb6
PM
6725 $top.fromsha1 insert 0 $oldid
6726 $top.fromsha1 conf -state readonly
6727 grid $top.from $top.fromsha1 -sticky w
4a2139f5 6728 entry $top.fromhead -width 60 -relief flat
74daedb6
PM
6729 $top.fromhead insert 0 $oldhead
6730 $top.fromhead conf -state readonly
6731 grid x $top.fromhead -sticky w
d990cedf 6732 label $top.to -text [mc "To:"]
4a2139f5 6733 entry $top.tosha1 -width 40 -relief flat
74daedb6
PM
6734 $top.tosha1 insert 0 $newid
6735 $top.tosha1 conf -state readonly
6736 grid $top.to $top.tosha1 -sticky w
4a2139f5 6737 entry $top.tohead -width 60 -relief flat
74daedb6
PM
6738 $top.tohead insert 0 $newhead
6739 $top.tohead conf -state readonly
6740 grid x $top.tohead -sticky w
d990cedf 6741 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
74daedb6 6742 grid $top.rev x -pady 10
d990cedf 6743 label $top.flab -text [mc "Output file:"]
74daedb6
PM
6744 entry $top.fname -width 60
6745 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6746 incr patchnum
bdbfbe3d 6747 grid $top.flab $top.fname -sticky w
74daedb6 6748 frame $top.buts
d990cedf
CS
6749 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6750 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
74daedb6
PM
6751 grid $top.buts.gen $top.buts.can
6752 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6753 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6754 grid $top.buts - -pady 10 -sticky ew
bdbfbe3d 6755 focus $top.fname
74daedb6
PM
6756}
6757
6758proc mkpatchrev {} {
6759 global patchtop
6760
6761 set oldid [$patchtop.fromsha1 get]
6762 set oldhead [$patchtop.fromhead get]
6763 set newid [$patchtop.tosha1 get]
6764 set newhead [$patchtop.tohead get]
6765 foreach e [list fromsha1 fromhead tosha1 tohead] \
6766 v [list $newid $newhead $oldid $oldhead] {
6767 $patchtop.$e conf -state normal
6768 $patchtop.$e delete 0 end
6769 $patchtop.$e insert 0 $v
6770 $patchtop.$e conf -state readonly
6771 }
6772}
6773
6774proc mkpatchgo {} {
8f489363 6775 global patchtop nullid nullid2
74daedb6
PM
6776
6777 set oldid [$patchtop.fromsha1 get]
6778 set newid [$patchtop.tosha1 get]
6779 set fname [$patchtop.fname get]
8f489363 6780 set cmd [diffcmd [list $oldid $newid] -p]
d372e216
PM
6781 # trim off the initial "|"
6782 set cmd [lrange $cmd 1 end]
219ea3a9
PM
6783 lappend cmd >$fname &
6784 if {[catch {eval exec $cmd} err]} {
d990cedf 6785 error_popup "[mc "Error creating patch:"] $err"
74daedb6
PM
6786 }
6787 catch {destroy $patchtop}
6788 unset patchtop
6789}
6790
6791proc mkpatchcan {} {
6792 global patchtop
6793
6794 catch {destroy $patchtop}
6795 unset patchtop
6796}
6797
bdbfbe3d
PM
6798proc mktag {} {
6799 global rowmenuid mktagtop commitinfo
6800
6801 set top .maketag
6802 set mktagtop $top
6803 catch {destroy $top}
6804 toplevel $top
d990cedf 6805 label $top.title -text [mc "Create tag"]
4a2139f5 6806 grid $top.title - -pady 10
d990cedf 6807 label $top.id -text [mc "ID:"]
4a2139f5 6808 entry $top.sha1 -width 40 -relief flat
bdbfbe3d
PM
6809 $top.sha1 insert 0 $rowmenuid
6810 $top.sha1 conf -state readonly
6811 grid $top.id $top.sha1 -sticky w
4a2139f5 6812 entry $top.head -width 60 -relief flat
bdbfbe3d
PM
6813 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6814 $top.head conf -state readonly
6815 grid x $top.head -sticky w
d990cedf 6816 label $top.tlab -text [mc "Tag name:"]
4a2139f5 6817 entry $top.tag -width 60
bdbfbe3d
PM
6818 grid $top.tlab $top.tag -sticky w
6819 frame $top.buts
d990cedf
CS
6820 button $top.buts.gen -text [mc "Create"] -command mktaggo
6821 button $top.buts.can -text [mc "Cancel"] -command mktagcan
bdbfbe3d
PM
6822 grid $top.buts.gen $top.buts.can
6823 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6824 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6825 grid $top.buts - -pady 10 -sticky ew
6826 focus $top.tag
6827}
6828
6829proc domktag {} {
6830 global mktagtop env tagids idtags
bdbfbe3d
PM
6831
6832 set id [$mktagtop.sha1 get]
6833 set tag [$mktagtop.tag get]
6834 if {$tag == {}} {
d990cedf 6835 error_popup [mc "No tag name specified"]
bdbfbe3d
PM
6836 return
6837 }
6838 if {[info exists tagids($tag)]} {
d990cedf 6839 error_popup [mc "Tag \"%s\" already exists" $tag]
bdbfbe3d
PM
6840 return
6841 }
6842 if {[catch {
73b6a6cb 6843 set dir [gitdir]
bdbfbe3d
PM
6844 set fname [file join $dir "refs/tags" $tag]
6845 set f [open $fname w]
6846 puts $f $id
6847 close $f
6848 } err]} {
d990cedf 6849 error_popup "[mc "Error creating tag:"] $err"
bdbfbe3d
PM
6850 return
6851 }
6852
6853 set tagids($tag) $id
6854 lappend idtags($id) $tag
f1d83ba3 6855 redrawtags $id
ceadfe90 6856 addedtag $id
887c996e
PM
6857 dispneartags 0
6858 run refill_reflist
f1d83ba3
PM
6859}
6860
6861proc redrawtags {id} {
fc2a256f 6862 global canv linehtag idpos currentid curview
9c311b32 6863 global canvxmax iddrawn
f1d83ba3 6864
7fcc92bf 6865 if {![commitinview $id $curview]} return
322a8cc9 6866 if {![info exists iddrawn($id)]} return
fc2a256f 6867 set row [rowofcommit $id]
bdbfbe3d
PM
6868 $canv delete tag.$id
6869 set xt [eval drawtags $id $idpos($id)]
fc2a256f
PM
6870 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6871 set text [$canv itemcget $linehtag($row) -text]
6872 set font [$canv itemcget $linehtag($row) -font]
6873 set xr [expr {$xt + [font measure $font $text]}]
b8ab2e17
PM
6874 if {$xr > $canvxmax} {
6875 set canvxmax $xr
6876 setcanvscroll
6877 }
fc2a256f
PM
6878 if {[info exists currentid] && $currentid == $id} {
6879 make_secsel $row
bdbfbe3d
PM
6880 }
6881}
6882
6883proc mktagcan {} {
6884 global mktagtop
6885
6886 catch {destroy $mktagtop}
6887 unset mktagtop
6888}
6889
6890proc mktaggo {} {
6891 domktag
6892 mktagcan
6893}
6894
4a2139f5
PM
6895proc writecommit {} {
6896 global rowmenuid wrcomtop commitinfo wrcomcmd
6897
6898 set top .writecommit
6899 set wrcomtop $top
6900 catch {destroy $top}
6901 toplevel $top
d990cedf 6902 label $top.title -text [mc "Write commit to file"]
4a2139f5 6903 grid $top.title - -pady 10
d990cedf 6904 label $top.id -text [mc "ID:"]
4a2139f5
PM
6905 entry $top.sha1 -width 40 -relief flat
6906 $top.sha1 insert 0 $rowmenuid
6907 $top.sha1 conf -state readonly
6908 grid $top.id $top.sha1 -sticky w
6909 entry $top.head -width 60 -relief flat
6910 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6911 $top.head conf -state readonly
6912 grid x $top.head -sticky w
d990cedf 6913 label $top.clab -text [mc "Command:"]
4a2139f5
PM
6914 entry $top.cmd -width 60 -textvariable wrcomcmd
6915 grid $top.clab $top.cmd -sticky w -pady 10
d990cedf 6916 label $top.flab -text [mc "Output file:"]
4a2139f5
PM
6917 entry $top.fname -width 60
6918 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6919 grid $top.flab $top.fname -sticky w
6920 frame $top.buts
d990cedf
CS
6921 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6922 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
4a2139f5
PM
6923 grid $top.buts.gen $top.buts.can
6924 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6925 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6926 grid $top.buts - -pady 10 -sticky ew
6927 focus $top.fname
6928}
6929
6930proc wrcomgo {} {
6931 global wrcomtop
6932
6933 set id [$wrcomtop.sha1 get]
6934 set cmd "echo $id | [$wrcomtop.cmd get]"
6935 set fname [$wrcomtop.fname get]
6936 if {[catch {exec sh -c $cmd >$fname &} err]} {
d990cedf 6937 error_popup "[mc "Error writing commit:"] $err"
4a2139f5
PM
6938 }
6939 catch {destroy $wrcomtop}
6940 unset wrcomtop
6941}
6942
6943proc wrcomcan {} {
6944 global wrcomtop
6945
6946 catch {destroy $wrcomtop}
6947 unset wrcomtop
6948}
6949
d6ac1a86
PM
6950proc mkbranch {} {
6951 global rowmenuid mkbrtop
6952
6953 set top .makebranch
6954 catch {destroy $top}
6955 toplevel $top
d990cedf 6956 label $top.title -text [mc "Create new branch"]
d6ac1a86 6957 grid $top.title - -pady 10
d990cedf 6958 label $top.id -text [mc "ID:"]
d6ac1a86
PM
6959 entry $top.sha1 -width 40 -relief flat
6960 $top.sha1 insert 0 $rowmenuid
6961 $top.sha1 conf -state readonly
6962 grid $top.id $top.sha1 -sticky w
d990cedf 6963 label $top.nlab -text [mc "Name:"]
d6ac1a86
PM
6964 entry $top.name -width 40
6965 grid $top.nlab $top.name -sticky w
6966 frame $top.buts
d990cedf
CS
6967 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6968 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
d6ac1a86
PM
6969 grid $top.buts.go $top.buts.can
6970 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6971 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6972 grid $top.buts - -pady 10 -sticky ew
6973 focus $top.name
6974}
6975
6976proc mkbrgo {top} {
6977 global headids idheads
6978
6979 set name [$top.name get]
6980 set id [$top.sha1 get]
6981 if {$name eq {}} {
d990cedf 6982 error_popup [mc "Please specify a name for the new branch"]
d6ac1a86
PM
6983 return
6984 }
6985 catch {destroy $top}
6986 nowbusy newbranch
6987 update
6988 if {[catch {
6989 exec git branch $name $id
6990 } err]} {
6991 notbusy newbranch
6992 error_popup $err
6993 } else {
e11f1233
PM
6994 set headids($name) $id
6995 lappend idheads($id) $name
ca6d8f58 6996 addedhead $id $name
d6ac1a86
PM
6997 notbusy newbranch
6998 redrawtags $id
e11f1233 6999 dispneartags 0
887c996e 7000 run refill_reflist
d6ac1a86
PM
7001 }
7002}
7003
ca6d8f58 7004proc cherrypick {} {
7fcc92bf 7005 global rowmenuid curview
e11f1233 7006 global mainhead
ca6d8f58 7007
e11f1233
PM
7008 set oldhead [exec git rev-parse HEAD]
7009 set dheads [descheads $rowmenuid]
7010 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
d990cedf
CS
7011 set ok [confirm_popup [mc "Commit %s is already\
7012 included in branch %s -- really re-apply it?" \
7013 [string range $rowmenuid 0 7] $mainhead]]
ca6d8f58
PM
7014 if {!$ok} return
7015 }
d990cedf 7016 nowbusy cherrypick [mc "Cherry-picking"]
ca6d8f58 7017 update
ca6d8f58
PM
7018 # Unfortunately git-cherry-pick writes stuff to stderr even when
7019 # no error occurs, and exec takes that as an indication of error...
7020 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7021 notbusy cherrypick
7022 error_popup $err
7023 return
7024 }
7025 set newhead [exec git rev-parse HEAD]
7026 if {$newhead eq $oldhead} {
7027 notbusy cherrypick
d990cedf 7028 error_popup [mc "No changes committed"]
ca6d8f58
PM
7029 return
7030 }
e11f1233 7031 addnewchild $newhead $oldhead
7fcc92bf
PM
7032 if {[commitinview $oldhead $curview]} {
7033 insertrow $newhead $oldhead $curview
ca6d8f58 7034 if {$mainhead ne {}} {
e11f1233 7035 movehead $newhead $mainhead
ca6d8f58
PM
7036 movedhead $newhead $mainhead
7037 }
7038 redrawtags $oldhead
7039 redrawtags $newhead
7040 }
7041 notbusy cherrypick
7042}
7043
6fb735ae
PM
7044proc resethead {} {
7045 global mainheadid mainhead rowmenuid confirm_ok resettype
6fb735ae
PM
7046
7047 set confirm_ok 0
7048 set w ".confirmreset"
7049 toplevel $w
7050 wm transient $w .
d990cedf 7051 wm title $w [mc "Confirm reset"]
6fb735ae 7052 message $w.m -text \
d990cedf 7053 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6fb735ae
PM
7054 -justify center -aspect 1000
7055 pack $w.m -side top -fill x -padx 20 -pady 20
7056 frame $w.f -relief sunken -border 2
d990cedf 7057 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6fb735ae
PM
7058 grid $w.f.rt -sticky w
7059 set resettype mixed
7060 radiobutton $w.f.soft -value soft -variable resettype -justify left \
d990cedf 7061 -text [mc "Soft: Leave working tree and index untouched"]
6fb735ae
PM
7062 grid $w.f.soft -sticky w
7063 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
d990cedf 7064 -text [mc "Mixed: Leave working tree untouched, reset index"]
6fb735ae
PM
7065 grid $w.f.mixed -sticky w
7066 radiobutton $w.f.hard -value hard -variable resettype -justify left \
d990cedf 7067 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6fb735ae
PM
7068 grid $w.f.hard -sticky w
7069 pack $w.f -side top -fill x
d990cedf 7070 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6fb735ae 7071 pack $w.ok -side left -fill x -padx 20 -pady 20
d990cedf 7072 button $w.cancel -text [mc Cancel] -command "destroy $w"
6fb735ae
PM
7073 pack $w.cancel -side right -fill x -padx 20 -pady 20
7074 bind $w <Visibility> "grab $w; focus $w"
7075 tkwait window $w
7076 if {!$confirm_ok} return
706d6c3e
PM
7077 if {[catch {set fd [open \
7078 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6fb735ae
PM
7079 error_popup $err
7080 } else {
706d6c3e 7081 dohidelocalchanges
a137a90f 7082 filerun $fd [list readresetstat $fd]
d990cedf 7083 nowbusy reset [mc "Resetting"]
706d6c3e
PM
7084 }
7085}
7086
a137a90f
PM
7087proc readresetstat {fd} {
7088 global mainhead mainheadid showlocalchanges rprogcoord
706d6c3e
PM
7089
7090 if {[gets $fd line] >= 0} {
7091 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
a137a90f
PM
7092 set rprogcoord [expr {1.0 * $m / $n}]
7093 adjustprogress
706d6c3e
PM
7094 }
7095 return 1
7096 }
a137a90f
PM
7097 set rprogcoord 0
7098 adjustprogress
706d6c3e
PM
7099 notbusy reset
7100 if {[catch {close $fd} err]} {
7101 error_popup $err
7102 }
7103 set oldhead $mainheadid
7104 set newhead [exec git rev-parse HEAD]
7105 if {$newhead ne $oldhead} {
7106 movehead $newhead $mainhead
7107 movedhead $newhead $mainhead
7108 set mainheadid $newhead
6fb735ae 7109 redrawtags $oldhead
706d6c3e 7110 redrawtags $newhead
6fb735ae
PM
7111 }
7112 if {$showlocalchanges} {
7113 doshowlocalchanges
7114 }
706d6c3e 7115 return 0
6fb735ae
PM
7116}
7117
10299152
PM
7118# context menu for a head
7119proc headmenu {x y id head} {
00609463 7120 global headmenuid headmenuhead headctxmenu mainhead
10299152 7121
bb3edc8b 7122 stopfinding
10299152
PM
7123 set headmenuid $id
7124 set headmenuhead $head
00609463
PM
7125 set state normal
7126 if {$head eq $mainhead} {
7127 set state disabled
7128 }
7129 $headctxmenu entryconfigure 0 -state $state
7130 $headctxmenu entryconfigure 1 -state $state
10299152
PM
7131 tk_popup $headctxmenu $x $y
7132}
7133
7134proc cobranch {} {
7135 global headmenuid headmenuhead mainhead headids
219ea3a9 7136 global showlocalchanges mainheadid
10299152
PM
7137
7138 # check the tree is clean first??
7139 set oldmainhead $mainhead
d990cedf 7140 nowbusy checkout [mc "Checking out"]
10299152 7141 update
219ea3a9 7142 dohidelocalchanges
10299152 7143 if {[catch {
696cf493 7144 exec git checkout -q $headmenuhead
10299152
PM
7145 } err]} {
7146 notbusy checkout
7147 error_popup $err
7148 } else {
7149 notbusy checkout
53cda8d9 7150 set mainhead $headmenuhead
219ea3a9 7151 set mainheadid $headmenuid
10299152
PM
7152 if {[info exists headids($oldmainhead)]} {
7153 redrawtags $headids($oldmainhead)
7154 }
7155 redrawtags $headmenuid
6fb735ae
PM
7156 }
7157 if {$showlocalchanges} {
7158 dodiffindex
10299152
PM
7159 }
7160}
7161
7162proc rmbranch {} {
e11f1233 7163 global headmenuid headmenuhead mainhead
b1054ac9 7164 global idheads
10299152
PM
7165
7166 set head $headmenuhead
7167 set id $headmenuid
00609463 7168 # this check shouldn't be needed any more...
10299152 7169 if {$head eq $mainhead} {
d990cedf 7170 error_popup [mc "Cannot delete the currently checked-out branch"]
10299152
PM
7171 return
7172 }
e11f1233 7173 set dheads [descheads $id]
d7b16113 7174 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
10299152 7175 # the stuff on this branch isn't on any other branch
d990cedf
CS
7176 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7177 branch.\nReally delete branch %s?" $head $head]]} return
10299152
PM
7178 }
7179 nowbusy rmbranch
7180 update
7181 if {[catch {exec git branch -D $head} err]} {
7182 notbusy rmbranch
7183 error_popup $err
7184 return
7185 }
e11f1233 7186 removehead $id $head
ca6d8f58 7187 removedhead $id $head
10299152
PM
7188 redrawtags $id
7189 notbusy rmbranch
e11f1233 7190 dispneartags 0
887c996e
PM
7191 run refill_reflist
7192}
7193
7194# Display a list of tags and heads
7195proc showrefs {} {
9c311b32
PM
7196 global showrefstop bgcolor fgcolor selectbgcolor
7197 global bglist fglist reflistfilter reflist maincursor
887c996e
PM
7198
7199 set top .showrefs
7200 set showrefstop $top
7201 if {[winfo exists $top]} {
7202 raise $top
7203 refill_reflist
7204 return
7205 }
7206 toplevel $top
d990cedf 7207 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
887c996e 7208 text $top.list -background $bgcolor -foreground $fgcolor \
9c311b32 7209 -selectbackground $selectbgcolor -font mainfont \
887c996e
PM
7210 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7211 -width 30 -height 20 -cursor $maincursor \
7212 -spacing1 1 -spacing3 1 -state disabled
7213 $top.list tag configure highlight -background $selectbgcolor
7214 lappend bglist $top.list
7215 lappend fglist $top.list
7216 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7217 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7218 grid $top.list $top.ysb -sticky nsew
7219 grid $top.xsb x -sticky ew
7220 frame $top.f
b039f0a6
PM
7221 label $top.f.l -text "[mc "Filter"]: "
7222 entry $top.f.e -width 20 -textvariable reflistfilter
887c996e
PM
7223 set reflistfilter "*"
7224 trace add variable reflistfilter write reflistfilter_change
7225 pack $top.f.e -side right -fill x -expand 1
7226 pack $top.f.l -side left
7227 grid $top.f - -sticky ew -pady 2
b039f0a6 7228 button $top.close -command [list destroy $top] -text [mc "Close"]
887c996e
PM
7229 grid $top.close -
7230 grid columnconfigure $top 0 -weight 1
7231 grid rowconfigure $top 0 -weight 1
7232 bind $top.list <1> {break}
7233 bind $top.list <B1-Motion> {break}
7234 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7235 set reflist {}
7236 refill_reflist
7237}
7238
7239proc sel_reflist {w x y} {
7240 global showrefstop reflist headids tagids otherrefids
7241
7242 if {![winfo exists $showrefstop]} return
7243 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7244 set ref [lindex $reflist [expr {$l-1}]]
7245 set n [lindex $ref 0]
7246 switch -- [lindex $ref 1] {
7247 "H" {selbyid $headids($n)}
7248 "T" {selbyid $tagids($n)}
7249 "o" {selbyid $otherrefids($n)}
7250 }
7251 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7252}
7253
7254proc unsel_reflist {} {
7255 global showrefstop
7256
7257 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7258 $showrefstop.list tag remove highlight 0.0 end
7259}
7260
7261proc reflistfilter_change {n1 n2 op} {
7262 global reflistfilter
7263
7264 after cancel refill_reflist
7265 after 200 refill_reflist
7266}
7267
7268proc refill_reflist {} {
7269 global reflist reflistfilter showrefstop headids tagids otherrefids
7fcc92bf 7270 global curview commitinterest
887c996e
PM
7271
7272 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7273 set refs {}
7274 foreach n [array names headids] {
7275 if {[string match $reflistfilter $n]} {
7fcc92bf 7276 if {[commitinview $headids($n) $curview]} {
887c996e
PM
7277 lappend refs [list $n H]
7278 } else {
7279 set commitinterest($headids($n)) {run refill_reflist}
7280 }
7281 }
7282 }
7283 foreach n [array names tagids] {
7284 if {[string match $reflistfilter $n]} {
7fcc92bf 7285 if {[commitinview $tagids($n) $curview]} {
887c996e
PM
7286 lappend refs [list $n T]
7287 } else {
7288 set commitinterest($tagids($n)) {run refill_reflist}
7289 }
7290 }
7291 }
7292 foreach n [array names otherrefids] {
7293 if {[string match $reflistfilter $n]} {
7fcc92bf 7294 if {[commitinview $otherrefids($n) $curview]} {
887c996e
PM
7295 lappend refs [list $n o]
7296 } else {
7297 set commitinterest($otherrefids($n)) {run refill_reflist}
7298 }
7299 }
7300 }
7301 set refs [lsort -index 0 $refs]
7302 if {$refs eq $reflist} return
7303
7304 # Update the contents of $showrefstop.list according to the
7305 # differences between $reflist (old) and $refs (new)
7306 $showrefstop.list conf -state normal
7307 $showrefstop.list insert end "\n"
7308 set i 0
7309 set j 0
7310 while {$i < [llength $reflist] || $j < [llength $refs]} {
7311 if {$i < [llength $reflist]} {
7312 if {$j < [llength $refs]} {
7313 set cmp [string compare [lindex $reflist $i 0] \
7314 [lindex $refs $j 0]]
7315 if {$cmp == 0} {
7316 set cmp [string compare [lindex $reflist $i 1] \
7317 [lindex $refs $j 1]]
7318 }
7319 } else {
7320 set cmp -1
7321 }
7322 } else {
7323 set cmp 1
7324 }
7325 switch -- $cmp {
7326 -1 {
7327 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7328 incr i
7329 }
7330 0 {
7331 incr i
7332 incr j
7333 }
7334 1 {
7335 set l [expr {$j + 1}]
7336 $showrefstop.list image create $l.0 -align baseline \
7337 -image reficon-[lindex $refs $j 1] -padx 2
7338 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7339 incr j
7340 }
7341 }
7342 }
7343 set reflist $refs
7344 # delete last newline
7345 $showrefstop.list delete end-2c end-1c
7346 $showrefstop.list conf -state disabled
10299152
PM
7347}
7348
b8ab2e17
PM
7349# Stuff for finding nearby tags
7350proc getallcommits {} {
5cd15b6b
PM
7351 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7352 global idheads idtags idotherrefs allparents tagobjid
f1d83ba3 7353
a69b2d1a 7354 if {![info exists allcommits]} {
a69b2d1a
PM
7355 set nextarc 0
7356 set allcommits 0
7357 set seeds {}
5cd15b6b
PM
7358 set allcwait 0
7359 set cachedarcs 0
7360 set allccache [file join [gitdir] "gitk.cache"]
7361 if {![catch {
7362 set f [open $allccache r]
7363 set allcwait 1
7364 getcache $f
7365 }]} return
a69b2d1a 7366 }
2d71bccc 7367
5cd15b6b
PM
7368 if {$allcwait} {
7369 return
7370 }
7371 set cmd [list | git rev-list --parents]
7372 set allcupdate [expr {$seeds ne {}}]
7373 if {!$allcupdate} {
7374 set ids "--all"
7375 } else {
7376 set refs [concat [array names idheads] [array names idtags] \
7377 [array names idotherrefs]]
7378 set ids {}
7379 set tagobjs {}
7380 foreach name [array names tagobjid] {
7381 lappend tagobjs $tagobjid($name)
7382 }
7383 foreach id [lsort -unique $refs] {
7384 if {![info exists allparents($id)] &&
7385 [lsearch -exact $tagobjs $id] < 0} {
7386 lappend ids $id
7387 }
7388 }
7389 if {$ids ne {}} {
7390 foreach id $seeds {
7391 lappend ids "^$id"
7392 }
7393 }
7394 }
7395 if {$ids ne {}} {
7396 set fd [open [concat $cmd $ids] r]
7397 fconfigure $fd -blocking 0
7398 incr allcommits
7399 nowbusy allcommits
7400 filerun $fd [list getallclines $fd]
7401 } else {
7402 dispneartags 0
2d71bccc 7403 }
e11f1233
PM
7404}
7405
7406# Since most commits have 1 parent and 1 child, we group strings of
7407# such commits into "arcs" joining branch/merge points (BMPs), which
7408# are commits that either don't have 1 parent or don't have 1 child.
7409#
7410# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7411# arcout(id) - outgoing arcs for BMP
7412# arcids(a) - list of IDs on arc including end but not start
7413# arcstart(a) - BMP ID at start of arc
7414# arcend(a) - BMP ID at end of arc
7415# growing(a) - arc a is still growing
7416# arctags(a) - IDs out of arcids (excluding end) that have tags
7417# archeads(a) - IDs out of arcids (excluding end) that have heads
7418# The start of an arc is at the descendent end, so "incoming" means
7419# coming from descendents, and "outgoing" means going towards ancestors.
7420
7421proc getallclines {fd} {
5cd15b6b 7422 global allparents allchildren idtags idheads nextarc
e11f1233 7423 global arcnos arcids arctags arcout arcend arcstart archeads growing
5cd15b6b
PM
7424 global seeds allcommits cachedarcs allcupdate
7425
e11f1233 7426 set nid 0
7eb3cb9c 7427 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
e11f1233
PM
7428 set id [lindex $line 0]
7429 if {[info exists allparents($id)]} {
7430 # seen it already
7431 continue
7432 }
5cd15b6b 7433 set cachedarcs 0
e11f1233
PM
7434 set olds [lrange $line 1 end]
7435 set allparents($id) $olds
7436 if {![info exists allchildren($id)]} {
7437 set allchildren($id) {}
7438 set arcnos($id) {}
7439 lappend seeds $id
7440 } else {
7441 set a $arcnos($id)
7442 if {[llength $olds] == 1 && [llength $a] == 1} {
7443 lappend arcids($a) $id
7444 if {[info exists idtags($id)]} {
7445 lappend arctags($a) $id
b8ab2e17 7446 }
e11f1233
PM
7447 if {[info exists idheads($id)]} {
7448 lappend archeads($a) $id
7449 }
7450 if {[info exists allparents($olds)]} {
7451 # seen parent already
7452 if {![info exists arcout($olds)]} {
7453 splitarc $olds
7454 }
7455 lappend arcids($a) $olds
7456 set arcend($a) $olds
7457 unset growing($a)
7458 }
7459 lappend allchildren($olds) $id
7460 lappend arcnos($olds) $a
7461 continue
7462 }
7463 }
e11f1233
PM
7464 foreach a $arcnos($id) {
7465 lappend arcids($a) $id
7466 set arcend($a) $id
7467 unset growing($a)
7468 }
7469
7470 set ao {}
7471 foreach p $olds {
7472 lappend allchildren($p) $id
7473 set a [incr nextarc]
7474 set arcstart($a) $id
7475 set archeads($a) {}
7476 set arctags($a) {}
7477 set archeads($a) {}
7478 set arcids($a) {}
7479 lappend ao $a
7480 set growing($a) 1
7481 if {[info exists allparents($p)]} {
7482 # seen it already, may need to make a new branch
7483 if {![info exists arcout($p)]} {
7484 splitarc $p
7485 }
7486 lappend arcids($a) $p
7487 set arcend($a) $p
7488 unset growing($a)
7489 }
7490 lappend arcnos($p) $a
7491 }
7492 set arcout($id) $ao
f1d83ba3 7493 }
f3326b66
PM
7494 if {$nid > 0} {
7495 global cached_dheads cached_dtags cached_atags
7496 catch {unset cached_dheads}
7497 catch {unset cached_dtags}
7498 catch {unset cached_atags}
7499 }
7eb3cb9c
PM
7500 if {![eof $fd]} {
7501 return [expr {$nid >= 1000? 2: 1}]
7502 }
5cd15b6b
PM
7503 set cacheok 1
7504 if {[catch {
7505 fconfigure $fd -blocking 1
7506 close $fd
7507 } err]} {
7508 # got an error reading the list of commits
7509 # if we were updating, try rereading the whole thing again
7510 if {$allcupdate} {
7511 incr allcommits -1
7512 dropcache $err
7513 return
7514 }
d990cedf 7515 error_popup "[mc "Error reading commit topology information;\
5cd15b6b 7516 branch and preceding/following tag information\
d990cedf 7517 will be incomplete."]\n($err)"
5cd15b6b
PM
7518 set cacheok 0
7519 }
e11f1233
PM
7520 if {[incr allcommits -1] == 0} {
7521 notbusy allcommits
5cd15b6b
PM
7522 if {$cacheok} {
7523 run savecache
7524 }
e11f1233
PM
7525 }
7526 dispneartags 0
7eb3cb9c 7527 return 0
b8ab2e17
PM
7528}
7529
e11f1233
PM
7530proc recalcarc {a} {
7531 global arctags archeads arcids idtags idheads
b8ab2e17 7532
e11f1233
PM
7533 set at {}
7534 set ah {}
7535 foreach id [lrange $arcids($a) 0 end-1] {
7536 if {[info exists idtags($id)]} {
7537 lappend at $id
7538 }
7539 if {[info exists idheads($id)]} {
7540 lappend ah $id
b8ab2e17 7541 }
f1d83ba3 7542 }
e11f1233
PM
7543 set arctags($a) $at
7544 set archeads($a) $ah
b8ab2e17
PM
7545}
7546
e11f1233 7547proc splitarc {p} {
5cd15b6b 7548 global arcnos arcids nextarc arctags archeads idtags idheads
e11f1233 7549 global arcstart arcend arcout allparents growing
cec7bece 7550
e11f1233
PM
7551 set a $arcnos($p)
7552 if {[llength $a] != 1} {
7553 puts "oops splitarc called but [llength $a] arcs already"
7554 return
7555 }
7556 set a [lindex $a 0]
7557 set i [lsearch -exact $arcids($a) $p]
7558 if {$i < 0} {
7559 puts "oops splitarc $p not in arc $a"
7560 return
7561 }
7562 set na [incr nextarc]
7563 if {[info exists arcend($a)]} {
7564 set arcend($na) $arcend($a)
7565 } else {
7566 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7567 set j [lsearch -exact $arcnos($l) $a]
7568 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7569 }
7570 set tail [lrange $arcids($a) [expr {$i+1}] end]
7571 set arcids($a) [lrange $arcids($a) 0 $i]
7572 set arcend($a) $p
7573 set arcstart($na) $p
7574 set arcout($p) $na
7575 set arcids($na) $tail
7576 if {[info exists growing($a)]} {
7577 set growing($na) 1
7578 unset growing($a)
7579 }
e11f1233
PM
7580
7581 foreach id $tail {
7582 if {[llength $arcnos($id)] == 1} {
7583 set arcnos($id) $na
cec7bece 7584 } else {
e11f1233
PM
7585 set j [lsearch -exact $arcnos($id) $a]
7586 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
cec7bece 7587 }
e11f1233
PM
7588 }
7589
7590 # reconstruct tags and heads lists
7591 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7592 recalcarc $a
7593 recalcarc $na
7594 } else {
7595 set arctags($na) {}
7596 set archeads($na) {}
7597 }
7598}
7599
7600# Update things for a new commit added that is a child of one
7601# existing commit. Used when cherry-picking.
7602proc addnewchild {id p} {
5cd15b6b 7603 global allparents allchildren idtags nextarc
e11f1233 7604 global arcnos arcids arctags arcout arcend arcstart archeads growing
719c2b9d 7605 global seeds allcommits
e11f1233 7606
3ebba3c7 7607 if {![info exists allcommits] || ![info exists arcnos($p)]} return
e11f1233
PM
7608 set allparents($id) [list $p]
7609 set allchildren($id) {}
7610 set arcnos($id) {}
7611 lappend seeds $id
e11f1233
PM
7612 lappend allchildren($p) $id
7613 set a [incr nextarc]
7614 set arcstart($a) $id
7615 set archeads($a) {}
7616 set arctags($a) {}
7617 set arcids($a) [list $p]
7618 set arcend($a) $p
7619 if {![info exists arcout($p)]} {
7620 splitarc $p
7621 }
7622 lappend arcnos($p) $a
7623 set arcout($id) [list $a]
7624}
7625
5cd15b6b
PM
7626# This implements a cache for the topology information.
7627# The cache saves, for each arc, the start and end of the arc,
7628# the ids on the arc, and the outgoing arcs from the end.
7629proc readcache {f} {
7630 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7631 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7632 global allcwait
7633
7634 set a $nextarc
7635 set lim $cachedarcs
7636 if {$lim - $a > 500} {
7637 set lim [expr {$a + 500}]
7638 }
7639 if {[catch {
7640 if {$a == $lim} {
7641 # finish reading the cache and setting up arctags, etc.
7642 set line [gets $f]
7643 if {$line ne "1"} {error "bad final version"}
7644 close $f
7645 foreach id [array names idtags] {
7646 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7647 [llength $allparents($id)] == 1} {
7648 set a [lindex $arcnos($id) 0]
7649 if {$arctags($a) eq {}} {
7650 recalcarc $a
7651 }
7652 }
7653 }
7654 foreach id [array names idheads] {
7655 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7656 [llength $allparents($id)] == 1} {
7657 set a [lindex $arcnos($id) 0]
7658 if {$archeads($a) eq {}} {
7659 recalcarc $a
7660 }
7661 }
7662 }
7663 foreach id [lsort -unique $possible_seeds] {
7664 if {$arcnos($id) eq {}} {
7665 lappend seeds $id
7666 }
7667 }
7668 set allcwait 0
7669 } else {
7670 while {[incr a] <= $lim} {
7671 set line [gets $f]
7672 if {[llength $line] != 3} {error "bad line"}
7673 set s [lindex $line 0]
7674 set arcstart($a) $s
7675 lappend arcout($s) $a
7676 if {![info exists arcnos($s)]} {
7677 lappend possible_seeds $s
7678 set arcnos($s) {}
7679 }
7680 set e [lindex $line 1]
7681 if {$e eq {}} {
7682 set growing($a) 1
7683 } else {
7684 set arcend($a) $e
7685 if {![info exists arcout($e)]} {
7686 set arcout($e) {}
7687 }
7688 }
7689 set arcids($a) [lindex $line 2]
7690 foreach id $arcids($a) {
7691 lappend allparents($s) $id
7692 set s $id
7693 lappend arcnos($id) $a
7694 }
7695 if {![info exists allparents($s)]} {
7696 set allparents($s) {}
7697 }
7698 set arctags($a) {}
7699 set archeads($a) {}
7700 }
7701 set nextarc [expr {$a - 1}]
7702 }
7703 } err]} {
7704 dropcache $err
7705 return 0
7706 }
7707 if {!$allcwait} {
7708 getallcommits
7709 }
7710 return $allcwait
7711}
7712
7713proc getcache {f} {
7714 global nextarc cachedarcs possible_seeds
7715
7716 if {[catch {
7717 set line [gets $f]
7718 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7719 # make sure it's an integer
7720 set cachedarcs [expr {int([lindex $line 1])}]
7721 if {$cachedarcs < 0} {error "bad number of arcs"}
7722 set nextarc 0
7723 set possible_seeds {}
7724 run readcache $f
7725 } err]} {
7726 dropcache $err
7727 }
7728 return 0
7729}
7730
7731proc dropcache {err} {
7732 global allcwait nextarc cachedarcs seeds
7733
7734 #puts "dropping cache ($err)"
7735 foreach v {arcnos arcout arcids arcstart arcend growing \
7736 arctags archeads allparents allchildren} {
7737 global $v
7738 catch {unset $v}
7739 }
7740 set allcwait 0
7741 set nextarc 0
7742 set cachedarcs 0
7743 set seeds {}
7744 getallcommits
7745}
7746
7747proc writecache {f} {
7748 global cachearc cachedarcs allccache
7749 global arcstart arcend arcnos arcids arcout
7750
7751 set a $cachearc
7752 set lim $cachedarcs
7753 if {$lim - $a > 1000} {
7754 set lim [expr {$a + 1000}]
7755 }
7756 if {[catch {
7757 while {[incr a] <= $lim} {
7758 if {[info exists arcend($a)]} {
7759 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7760 } else {
7761 puts $f [list $arcstart($a) {} $arcids($a)]
7762 }
7763 }
7764 } err]} {
7765 catch {close $f}
7766 catch {file delete $allccache}
7767 #puts "writing cache failed ($err)"
7768 return 0
7769 }
7770 set cachearc [expr {$a - 1}]
7771 if {$a > $cachedarcs} {
7772 puts $f "1"
7773 close $f
7774 return 0
7775 }
7776 return 1
7777}
7778
7779proc savecache {} {
7780 global nextarc cachedarcs cachearc allccache
7781
7782 if {$nextarc == $cachedarcs} return
7783 set cachearc 0
7784 set cachedarcs $nextarc
7785 catch {
7786 set f [open $allccache w]
7787 puts $f [list 1 $cachedarcs]
7788 run writecache $f
7789 }
7790}
7791
e11f1233
PM
7792# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7793# or 0 if neither is true.
7794proc anc_or_desc {a b} {
7795 global arcout arcstart arcend arcnos cached_isanc
7796
7797 if {$arcnos($a) eq $arcnos($b)} {
7798 # Both are on the same arc(s); either both are the same BMP,
7799 # or if one is not a BMP, the other is also not a BMP or is
7800 # the BMP at end of the arc (and it only has 1 incoming arc).
69c0b5d2
PM
7801 # Or both can be BMPs with no incoming arcs.
7802 if {$a eq $b || $arcnos($a) eq {}} {
e11f1233 7803 return 0
cec7bece 7804 }
e11f1233
PM
7805 # assert {[llength $arcnos($a)] == 1}
7806 set arc [lindex $arcnos($a) 0]
7807 set i [lsearch -exact $arcids($arc) $a]
7808 set j [lsearch -exact $arcids($arc) $b]
7809 if {$i < 0 || $i > $j} {
7810 return 1
7811 } else {
7812 return -1
cec7bece
PM
7813 }
7814 }
e11f1233
PM
7815
7816 if {![info exists arcout($a)]} {
7817 set arc [lindex $arcnos($a) 0]
7818 if {[info exists arcend($arc)]} {
7819 set aend $arcend($arc)
7820 } else {
7821 set aend {}
cec7bece 7822 }
e11f1233
PM
7823 set a $arcstart($arc)
7824 } else {
7825 set aend $a
7826 }
7827 if {![info exists arcout($b)]} {
7828 set arc [lindex $arcnos($b) 0]
7829 if {[info exists arcend($arc)]} {
7830 set bend $arcend($arc)
7831 } else {
7832 set bend {}
cec7bece 7833 }
e11f1233
PM
7834 set b $arcstart($arc)
7835 } else {
7836 set bend $b
cec7bece 7837 }
e11f1233
PM
7838 if {$a eq $bend} {
7839 return 1
7840 }
7841 if {$b eq $aend} {
7842 return -1
7843 }
7844 if {[info exists cached_isanc($a,$bend)]} {
7845 if {$cached_isanc($a,$bend)} {
7846 return 1
7847 }
7848 }
7849 if {[info exists cached_isanc($b,$aend)]} {
7850 if {$cached_isanc($b,$aend)} {
7851 return -1
7852 }
7853 if {[info exists cached_isanc($a,$bend)]} {
7854 return 0
7855 }
cec7bece 7856 }
cec7bece 7857
e11f1233
PM
7858 set todo [list $a $b]
7859 set anc($a) a
7860 set anc($b) b
7861 for {set i 0} {$i < [llength $todo]} {incr i} {
7862 set x [lindex $todo $i]
7863 if {$anc($x) eq {}} {
7864 continue
7865 }
7866 foreach arc $arcnos($x) {
7867 set xd $arcstart($arc)
7868 if {$xd eq $bend} {
7869 set cached_isanc($a,$bend) 1
7870 set cached_isanc($b,$aend) 0
7871 return 1
7872 } elseif {$xd eq $aend} {
7873 set cached_isanc($b,$aend) 1
7874 set cached_isanc($a,$bend) 0
7875 return -1
7876 }
7877 if {![info exists anc($xd)]} {
7878 set anc($xd) $anc($x)
7879 lappend todo $xd
7880 } elseif {$anc($xd) ne $anc($x)} {
7881 set anc($xd) {}
7882 }
7883 }
7884 }
7885 set cached_isanc($a,$bend) 0
7886 set cached_isanc($b,$aend) 0
7887 return 0
7888}
b8ab2e17 7889
e11f1233
PM
7890# This identifies whether $desc has an ancestor that is
7891# a growing tip of the graph and which is not an ancestor of $anc
7892# and returns 0 if so and 1 if not.
7893# If we subsequently discover a tag on such a growing tip, and that
7894# turns out to be a descendent of $anc (which it could, since we
7895# don't necessarily see children before parents), then $desc
7896# isn't a good choice to display as a descendent tag of
7897# $anc (since it is the descendent of another tag which is
7898# a descendent of $anc). Similarly, $anc isn't a good choice to
7899# display as a ancestor tag of $desc.
7900#
7901proc is_certain {desc anc} {
7902 global arcnos arcout arcstart arcend growing problems
7903
7904 set certain {}
7905 if {[llength $arcnos($anc)] == 1} {
7906 # tags on the same arc are certain
7907 if {$arcnos($desc) eq $arcnos($anc)} {
7908 return 1
b8ab2e17 7909 }
e11f1233
PM
7910 if {![info exists arcout($anc)]} {
7911 # if $anc is partway along an arc, use the start of the arc instead
7912 set a [lindex $arcnos($anc) 0]
7913 set anc $arcstart($a)
b8ab2e17 7914 }
e11f1233
PM
7915 }
7916 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7917 set x $desc
7918 } else {
7919 set a [lindex $arcnos($desc) 0]
7920 set x $arcend($a)
7921 }
7922 if {$x == $anc} {
7923 return 1
7924 }
7925 set anclist [list $x]
7926 set dl($x) 1
7927 set nnh 1
7928 set ngrowanc 0
7929 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7930 set x [lindex $anclist $i]
7931 if {$dl($x)} {
7932 incr nnh -1
7933 }
7934 set done($x) 1
7935 foreach a $arcout($x) {
7936 if {[info exists growing($a)]} {
7937 if {![info exists growanc($x)] && $dl($x)} {
7938 set growanc($x) 1
7939 incr ngrowanc
7940 }
7941 } else {
7942 set y $arcend($a)
7943 if {[info exists dl($y)]} {
7944 if {$dl($y)} {
7945 if {!$dl($x)} {
7946 set dl($y) 0
7947 if {![info exists done($y)]} {
7948 incr nnh -1
7949 }
7950 if {[info exists growanc($x)]} {
7951 incr ngrowanc -1
7952 }
7953 set xl [list $y]
7954 for {set k 0} {$k < [llength $xl]} {incr k} {
7955 set z [lindex $xl $k]
7956 foreach c $arcout($z) {
7957 if {[info exists arcend($c)]} {
7958 set v $arcend($c)
7959 if {[info exists dl($v)] && $dl($v)} {
7960 set dl($v) 0
7961 if {![info exists done($v)]} {
7962 incr nnh -1
7963 }
7964 if {[info exists growanc($v)]} {
7965 incr ngrowanc -1
7966 }
7967 lappend xl $v
7968 }
7969 }
7970 }
7971 }
7972 }
7973 }
7974 } elseif {$y eq $anc || !$dl($x)} {
7975 set dl($y) 0
7976 lappend anclist $y
7977 } else {
7978 set dl($y) 1
7979 lappend anclist $y
7980 incr nnh
7981 }
7982 }
b8ab2e17
PM
7983 }
7984 }
e11f1233
PM
7985 foreach x [array names growanc] {
7986 if {$dl($x)} {
7987 return 0
b8ab2e17 7988 }
7eb3cb9c 7989 return 0
b8ab2e17 7990 }
e11f1233 7991 return 1
b8ab2e17
PM
7992}
7993
e11f1233
PM
7994proc validate_arctags {a} {
7995 global arctags idtags
b8ab2e17 7996
e11f1233
PM
7997 set i -1
7998 set na $arctags($a)
7999 foreach id $arctags($a) {
8000 incr i
8001 if {![info exists idtags($id)]} {
8002 set na [lreplace $na $i $i]
8003 incr i -1
8004 }
8005 }
8006 set arctags($a) $na
8007}
8008
8009proc validate_archeads {a} {
8010 global archeads idheads
8011
8012 set i -1
8013 set na $archeads($a)
8014 foreach id $archeads($a) {
8015 incr i
8016 if {![info exists idheads($id)]} {
8017 set na [lreplace $na $i $i]
8018 incr i -1
8019 }
8020 }
8021 set archeads($a) $na
8022}
8023
8024# Return the list of IDs that have tags that are descendents of id,
8025# ignoring IDs that are descendents of IDs already reported.
8026proc desctags {id} {
8027 global arcnos arcstart arcids arctags idtags allparents
8028 global growing cached_dtags
8029
8030 if {![info exists allparents($id)]} {
8031 return {}
8032 }
8033 set t1 [clock clicks -milliseconds]
8034 set argid $id
8035 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8036 # part-way along an arc; check that arc first
8037 set a [lindex $arcnos($id) 0]
8038 if {$arctags($a) ne {}} {
8039 validate_arctags $a
8040 set i [lsearch -exact $arcids($a) $id]
8041 set tid {}
8042 foreach t $arctags($a) {
8043 set j [lsearch -exact $arcids($a) $t]
8044 if {$j >= $i} break
8045 set tid $t
b8ab2e17 8046 }
e11f1233
PM
8047 if {$tid ne {}} {
8048 return $tid
b8ab2e17
PM
8049 }
8050 }
e11f1233
PM
8051 set id $arcstart($a)
8052 if {[info exists idtags($id)]} {
8053 return $id
8054 }
8055 }
8056 if {[info exists cached_dtags($id)]} {
8057 return $cached_dtags($id)
8058 }
8059
8060 set origid $id
8061 set todo [list $id]
8062 set queued($id) 1
8063 set nc 1
8064 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8065 set id [lindex $todo $i]
8066 set done($id) 1
8067 set ta [info exists hastaggedancestor($id)]
8068 if {!$ta} {
8069 incr nc -1
8070 }
8071 # ignore tags on starting node
8072 if {!$ta && $i > 0} {
8073 if {[info exists idtags($id)]} {
8074 set tagloc($id) $id
8075 set ta 1
8076 } elseif {[info exists cached_dtags($id)]} {
8077 set tagloc($id) $cached_dtags($id)
8078 set ta 1
8079 }
8080 }
8081 foreach a $arcnos($id) {
8082 set d $arcstart($a)
8083 if {!$ta && $arctags($a) ne {}} {
8084 validate_arctags $a
8085 if {$arctags($a) ne {}} {
8086 lappend tagloc($id) [lindex $arctags($a) end]
8087 }
8088 }
8089 if {$ta || $arctags($a) ne {}} {
8090 set tomark [list $d]
8091 for {set j 0} {$j < [llength $tomark]} {incr j} {
8092 set dd [lindex $tomark $j]
8093 if {![info exists hastaggedancestor($dd)]} {
8094 if {[info exists done($dd)]} {
8095 foreach b $arcnos($dd) {
8096 lappend tomark $arcstart($b)
8097 }
8098 if {[info exists tagloc($dd)]} {
8099 unset tagloc($dd)
8100 }
8101 } elseif {[info exists queued($dd)]} {
8102 incr nc -1
8103 }
8104 set hastaggedancestor($dd) 1
8105 }
8106 }
8107 }
8108 if {![info exists queued($d)]} {
8109 lappend todo $d
8110 set queued($d) 1
8111 if {![info exists hastaggedancestor($d)]} {
8112 incr nc
8113 }
8114 }
b8ab2e17 8115 }
f1d83ba3 8116 }
e11f1233
PM
8117 set tags {}
8118 foreach id [array names tagloc] {
8119 if {![info exists hastaggedancestor($id)]} {
8120 foreach t $tagloc($id) {
8121 if {[lsearch -exact $tags $t] < 0} {
8122 lappend tags $t
8123 }
8124 }
8125 }
8126 }
8127 set t2 [clock clicks -milliseconds]
8128 set loopix $i
f1d83ba3 8129
e11f1233
PM
8130 # remove tags that are descendents of other tags
8131 for {set i 0} {$i < [llength $tags]} {incr i} {
8132 set a [lindex $tags $i]
8133 for {set j 0} {$j < $i} {incr j} {
8134 set b [lindex $tags $j]
8135 set r [anc_or_desc $a $b]
8136 if {$r == 1} {
8137 set tags [lreplace $tags $j $j]
8138 incr j -1
8139 incr i -1
8140 } elseif {$r == -1} {
8141 set tags [lreplace $tags $i $i]
8142 incr i -1
8143 break
ceadfe90
PM
8144 }
8145 }
8146 }
8147
e11f1233
PM
8148 if {[array names growing] ne {}} {
8149 # graph isn't finished, need to check if any tag could get
8150 # eclipsed by another tag coming later. Simply ignore any
8151 # tags that could later get eclipsed.
8152 set ctags {}
8153 foreach t $tags {
8154 if {[is_certain $t $origid]} {
8155 lappend ctags $t
8156 }
ceadfe90 8157 }
e11f1233
PM
8158 if {$tags eq $ctags} {
8159 set cached_dtags($origid) $tags
8160 } else {
8161 set tags $ctags
ceadfe90 8162 }
e11f1233
PM
8163 } else {
8164 set cached_dtags($origid) $tags
8165 }
8166 set t3 [clock clicks -milliseconds]
8167 if {0 && $t3 - $t1 >= 100} {
8168 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8169 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
ceadfe90 8170 }
e11f1233
PM
8171 return $tags
8172}
ceadfe90 8173
e11f1233
PM
8174proc anctags {id} {
8175 global arcnos arcids arcout arcend arctags idtags allparents
8176 global growing cached_atags
8177
8178 if {![info exists allparents($id)]} {
8179 return {}
8180 }
8181 set t1 [clock clicks -milliseconds]
8182 set argid $id
8183 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8184 # part-way along an arc; check that arc first
8185 set a [lindex $arcnos($id) 0]
8186 if {$arctags($a) ne {}} {
8187 validate_arctags $a
8188 set i [lsearch -exact $arcids($a) $id]
8189 foreach t $arctags($a) {
8190 set j [lsearch -exact $arcids($a) $t]
8191 if {$j > $i} {
8192 return $t
8193 }
8194 }
ceadfe90 8195 }
e11f1233
PM
8196 if {![info exists arcend($a)]} {
8197 return {}
8198 }
8199 set id $arcend($a)
8200 if {[info exists idtags($id)]} {
8201 return $id
8202 }
8203 }
8204 if {[info exists cached_atags($id)]} {
8205 return $cached_atags($id)
8206 }
8207
8208 set origid $id
8209 set todo [list $id]
8210 set queued($id) 1
8211 set taglist {}
8212 set nc 1
8213 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8214 set id [lindex $todo $i]
8215 set done($id) 1
8216 set td [info exists hastaggeddescendent($id)]
8217 if {!$td} {
8218 incr nc -1
8219 }
8220 # ignore tags on starting node
8221 if {!$td && $i > 0} {
8222 if {[info exists idtags($id)]} {
8223 set tagloc($id) $id
8224 set td 1
8225 } elseif {[info exists cached_atags($id)]} {
8226 set tagloc($id) $cached_atags($id)
8227 set td 1
8228 }
8229 }
8230 foreach a $arcout($id) {
8231 if {!$td && $arctags($a) ne {}} {
8232 validate_arctags $a
8233 if {$arctags($a) ne {}} {
8234 lappend tagloc($id) [lindex $arctags($a) 0]
8235 }
8236 }
8237 if {![info exists arcend($a)]} continue
8238 set d $arcend($a)
8239 if {$td || $arctags($a) ne {}} {
8240 set tomark [list $d]
8241 for {set j 0} {$j < [llength $tomark]} {incr j} {
8242 set dd [lindex $tomark $j]
8243 if {![info exists hastaggeddescendent($dd)]} {
8244 if {[info exists done($dd)]} {
8245 foreach b $arcout($dd) {
8246 if {[info exists arcend($b)]} {
8247 lappend tomark $arcend($b)
8248 }
8249 }
8250 if {[info exists tagloc($dd)]} {
8251 unset tagloc($dd)
8252 }
8253 } elseif {[info exists queued($dd)]} {
8254 incr nc -1
8255 }
8256 set hastaggeddescendent($dd) 1
8257 }
8258 }
8259 }
8260 if {![info exists queued($d)]} {
8261 lappend todo $d
8262 set queued($d) 1
8263 if {![info exists hastaggeddescendent($d)]} {
8264 incr nc
8265 }
8266 }
8267 }
8268 }
8269 set t2 [clock clicks -milliseconds]
8270 set loopix $i
8271 set tags {}
8272 foreach id [array names tagloc] {
8273 if {![info exists hastaggeddescendent($id)]} {
8274 foreach t $tagloc($id) {
8275 if {[lsearch -exact $tags $t] < 0} {
8276 lappend tags $t
8277 }
8278 }
ceadfe90
PM
8279 }
8280 }
ceadfe90 8281
e11f1233
PM
8282 # remove tags that are ancestors of other tags
8283 for {set i 0} {$i < [llength $tags]} {incr i} {
8284 set a [lindex $tags $i]
8285 for {set j 0} {$j < $i} {incr j} {
8286 set b [lindex $tags $j]
8287 set r [anc_or_desc $a $b]
8288 if {$r == -1} {
8289 set tags [lreplace $tags $j $j]
8290 incr j -1
8291 incr i -1
8292 } elseif {$r == 1} {
8293 set tags [lreplace $tags $i $i]
8294 incr i -1
8295 break
8296 }
8297 }
8298 }
8299
8300 if {[array names growing] ne {}} {
8301 # graph isn't finished, need to check if any tag could get
8302 # eclipsed by another tag coming later. Simply ignore any
8303 # tags that could later get eclipsed.
8304 set ctags {}
8305 foreach t $tags {
8306 if {[is_certain $origid $t]} {
8307 lappend ctags $t
8308 }
8309 }
8310 if {$tags eq $ctags} {
8311 set cached_atags($origid) $tags
8312 } else {
8313 set tags $ctags
d6ac1a86 8314 }
e11f1233
PM
8315 } else {
8316 set cached_atags($origid) $tags
8317 }
8318 set t3 [clock clicks -milliseconds]
8319 if {0 && $t3 - $t1 >= 100} {
8320 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8321 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
d6ac1a86 8322 }
e11f1233 8323 return $tags
d6ac1a86
PM
8324}
8325
e11f1233
PM
8326# Return the list of IDs that have heads that are descendents of id,
8327# including id itself if it has a head.
8328proc descheads {id} {
8329 global arcnos arcstart arcids archeads idheads cached_dheads
8330 global allparents
ca6d8f58 8331
e11f1233
PM
8332 if {![info exists allparents($id)]} {
8333 return {}
8334 }
f3326b66 8335 set aret {}
e11f1233
PM
8336 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8337 # part-way along an arc; check it first
8338 set a [lindex $arcnos($id) 0]
8339 if {$archeads($a) ne {}} {
8340 validate_archeads $a
8341 set i [lsearch -exact $arcids($a) $id]
8342 foreach t $archeads($a) {
8343 set j [lsearch -exact $arcids($a) $t]
8344 if {$j > $i} break
f3326b66 8345 lappend aret $t
e11f1233 8346 }
ca6d8f58 8347 }
e11f1233 8348 set id $arcstart($a)
ca6d8f58 8349 }
e11f1233
PM
8350 set origid $id
8351 set todo [list $id]
8352 set seen($id) 1
f3326b66 8353 set ret {}
e11f1233
PM
8354 for {set i 0} {$i < [llength $todo]} {incr i} {
8355 set id [lindex $todo $i]
8356 if {[info exists cached_dheads($id)]} {
8357 set ret [concat $ret $cached_dheads($id)]
8358 } else {
8359 if {[info exists idheads($id)]} {
8360 lappend ret $id
8361 }
8362 foreach a $arcnos($id) {
8363 if {$archeads($a) ne {}} {
706d6c3e
PM
8364 validate_archeads $a
8365 if {$archeads($a) ne {}} {
8366 set ret [concat $ret $archeads($a)]
8367 }
e11f1233
PM
8368 }
8369 set d $arcstart($a)
8370 if {![info exists seen($d)]} {
8371 lappend todo $d
8372 set seen($d) 1
8373 }
8374 }
10299152 8375 }
10299152 8376 }
e11f1233
PM
8377 set ret [lsort -unique $ret]
8378 set cached_dheads($origid) $ret
f3326b66 8379 return [concat $ret $aret]
10299152
PM
8380}
8381
e11f1233
PM
8382proc addedtag {id} {
8383 global arcnos arcout cached_dtags cached_atags
ca6d8f58 8384
e11f1233
PM
8385 if {![info exists arcnos($id)]} return
8386 if {![info exists arcout($id)]} {
8387 recalcarc [lindex $arcnos($id) 0]
ca6d8f58 8388 }
e11f1233
PM
8389 catch {unset cached_dtags}
8390 catch {unset cached_atags}
ca6d8f58
PM
8391}
8392
e11f1233
PM
8393proc addedhead {hid head} {
8394 global arcnos arcout cached_dheads
8395
8396 if {![info exists arcnos($hid)]} return
8397 if {![info exists arcout($hid)]} {
8398 recalcarc [lindex $arcnos($hid) 0]
8399 }
8400 catch {unset cached_dheads}
8401}
8402
8403proc removedhead {hid head} {
8404 global cached_dheads
8405
8406 catch {unset cached_dheads}
8407}
8408
8409proc movedhead {hid head} {
8410 global arcnos arcout cached_dheads
cec7bece 8411
e11f1233
PM
8412 if {![info exists arcnos($hid)]} return
8413 if {![info exists arcout($hid)]} {
8414 recalcarc [lindex $arcnos($hid) 0]
cec7bece 8415 }
e11f1233
PM
8416 catch {unset cached_dheads}
8417}
8418
8419proc changedrefs {} {
8420 global cached_dheads cached_dtags cached_atags
8421 global arctags archeads arcnos arcout idheads idtags
8422
8423 foreach id [concat [array names idheads] [array names idtags]] {
8424 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8425 set a [lindex $arcnos($id) 0]
8426 if {![info exists donearc($a)]} {
8427 recalcarc $a
8428 set donearc($a) 1
8429 }
cec7bece
PM
8430 }
8431 }
e11f1233
PM
8432 catch {unset cached_dtags}
8433 catch {unset cached_atags}
8434 catch {unset cached_dheads}
cec7bece
PM
8435}
8436
f1d83ba3 8437proc rereadrefs {} {
fc2a256f 8438 global idtags idheads idotherrefs mainheadid
f1d83ba3
PM
8439
8440 set refids [concat [array names idtags] \
8441 [array names idheads] [array names idotherrefs]]
8442 foreach id $refids {
8443 if {![info exists ref($id)]} {
8444 set ref($id) [listrefs $id]
8445 }
8446 }
fc2a256f 8447 set oldmainhead $mainheadid
f1d83ba3 8448 readrefs
cec7bece 8449 changedrefs
f1d83ba3
PM
8450 set refids [lsort -unique [concat $refids [array names idtags] \
8451 [array names idheads] [array names idotherrefs]]]
8452 foreach id $refids {
8453 set v [listrefs $id]
cec7bece 8454 if {![info exists ref($id)] || $ref($id) != $v ||
fc2a256f
PM
8455 ($id eq $oldmainhead && $id ne $mainheadid) ||
8456 ($id eq $mainheadid && $id ne $oldmainhead)} {
f1d83ba3
PM
8457 redrawtags $id
8458 }
8459 }
887c996e 8460 run refill_reflist
f1d83ba3
PM
8461}
8462
2e1ded44
JH
8463proc listrefs {id} {
8464 global idtags idheads idotherrefs
8465
8466 set x {}
8467 if {[info exists idtags($id)]} {
8468 set x $idtags($id)
8469 }
8470 set y {}
8471 if {[info exists idheads($id)]} {
8472 set y $idheads($id)
8473 }
8474 set z {}
8475 if {[info exists idotherrefs($id)]} {
8476 set z $idotherrefs($id)
8477 }
8478 return [list $x $y $z]
8479}
8480
106288cb 8481proc showtag {tag isnew} {
62d3ea65 8482 global ctext tagcontents tagids linknum tagobjid
106288cb
PM
8483
8484 if {$isnew} {
8485 addtohistory [list showtag $tag 0]
8486 }
8487 $ctext conf -state normal
3ea06f9f 8488 clear_ctext
32f1b3e4 8489 settabs 0
106288cb 8490 set linknum 0
62d3ea65
PM
8491 if {![info exists tagcontents($tag)]} {
8492 catch {
8493 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8494 }
8495 }
106288cb
PM
8496 if {[info exists tagcontents($tag)]} {
8497 set text $tagcontents($tag)
8498 } else {
d990cedf 8499 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
106288cb 8500 }
f1b86294 8501 appendwithlinks $text {}
106288cb 8502 $ctext conf -state disabled
7fcceed7 8503 init_flist {}
106288cb
PM
8504}
8505
1d10f36d
PM
8506proc doquit {} {
8507 global stopped
8508 set stopped 100
b6047c5a 8509 savestuff .
1d10f36d
PM
8510 destroy .
8511}
1db95b00 8512
9a7558f3
PM
8513proc mkfontdisp {font top which} {
8514 global fontattr fontpref $font
8515
8516 set fontpref($font) [set $font]
8517 button $top.${font}but -text $which -font optionfont \
8518 -command [list choosefont $font $which]
8519 label $top.$font -relief flat -font $font \
8520 -text $fontattr($font,family) -justify left
8521 grid x $top.${font}but $top.$font -sticky w
8522}
8523
8524proc choosefont {font which} {
8525 global fontparam fontlist fonttop fontattr
8526
8527 set fontparam(which) $which
8528 set fontparam(font) $font
8529 set fontparam(family) [font actual $font -family]
8530 set fontparam(size) $fontattr($font,size)
8531 set fontparam(weight) $fontattr($font,weight)
8532 set fontparam(slant) $fontattr($font,slant)
8533 set top .gitkfont
8534 set fonttop $top
8535 if {![winfo exists $top]} {
8536 font create sample
8537 eval font config sample [font actual $font]
8538 toplevel $top
d990cedf 8539 wm title $top [mc "Gitk font chooser"]
b039f0a6 8540 label $top.l -textvariable fontparam(which)
9a7558f3
PM
8541 pack $top.l -side top
8542 set fontlist [lsort [font families]]
8543 frame $top.f
8544 listbox $top.f.fam -listvariable fontlist \
8545 -yscrollcommand [list $top.f.sb set]
8546 bind $top.f.fam <<ListboxSelect>> selfontfam
8547 scrollbar $top.f.sb -command [list $top.f.fam yview]
8548 pack $top.f.sb -side right -fill y
8549 pack $top.f.fam -side left -fill both -expand 1
8550 pack $top.f -side top -fill both -expand 1
8551 frame $top.g
8552 spinbox $top.g.size -from 4 -to 40 -width 4 \
8553 -textvariable fontparam(size) \
8554 -validatecommand {string is integer -strict %s}
8555 checkbutton $top.g.bold -padx 5 \
d990cedf 8556 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9a7558f3
PM
8557 -variable fontparam(weight) -onvalue bold -offvalue normal
8558 checkbutton $top.g.ital -padx 5 \
d990cedf 8559 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9a7558f3
PM
8560 -variable fontparam(slant) -onvalue italic -offvalue roman
8561 pack $top.g.size $top.g.bold $top.g.ital -side left
8562 pack $top.g -side top
8563 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8564 -background white
8565 $top.c create text 100 25 -anchor center -text $which -font sample \
8566 -fill black -tags text
8567 bind $top.c <Configure> [list centertext $top.c]
8568 pack $top.c -side top -fill x
8569 frame $top.buts
b039f0a6
PM
8570 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8571 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9a7558f3
PM
8572 grid $top.buts.ok $top.buts.can
8573 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8574 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8575 pack $top.buts -side bottom -fill x
8576 trace add variable fontparam write chg_fontparam
8577 } else {
8578 raise $top
8579 $top.c itemconf text -text $which
8580 }
8581 set i [lsearch -exact $fontlist $fontparam(family)]
8582 if {$i >= 0} {
8583 $top.f.fam selection set $i
8584 $top.f.fam see $i
8585 }
8586}
8587
8588proc centertext {w} {
8589 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8590}
8591
8592proc fontok {} {
8593 global fontparam fontpref prefstop
8594
8595 set f $fontparam(font)
8596 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8597 if {$fontparam(weight) eq "bold"} {
8598 lappend fontpref($f) "bold"
8599 }
8600 if {$fontparam(slant) eq "italic"} {
8601 lappend fontpref($f) "italic"
8602 }
8603 set w $prefstop.$f
8604 $w conf -text $fontparam(family) -font $fontpref($f)
8605
8606 fontcan
8607}
8608
8609proc fontcan {} {
8610 global fonttop fontparam
8611
8612 if {[info exists fonttop]} {
8613 catch {destroy $fonttop}
8614 catch {font delete sample}
8615 unset fonttop
8616 unset fontparam
8617 }
8618}
8619
8620proc selfontfam {} {
8621 global fonttop fontparam
8622
8623 set i [$fonttop.f.fam curselection]
8624 if {$i ne {}} {
8625 set fontparam(family) [$fonttop.f.fam get $i]
8626 }
8627}
8628
8629proc chg_fontparam {v sub op} {
8630 global fontparam
8631
8632 font config sample -$sub $fontparam($sub)
8633}
8634
712fcc08 8635proc doprefs {} {
8d73b242 8636 global maxwidth maxgraphpct
219ea3a9 8637 global oldprefs prefstop showneartags showlocalchanges
60378c0c 8638 global bgcolor fgcolor ctext diffcolors selectbgcolor
b039f0a6 8639 global tabstop limitdiffs
232475d3 8640
712fcc08
PM
8641 set top .gitkprefs
8642 set prefstop $top
8643 if {[winfo exists $top]} {
8644 raise $top
8645 return
757f17bc 8646 }
3de07118 8647 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
94503918 8648 limitdiffs tabstop} {
712fcc08 8649 set oldprefs($v) [set $v]
232475d3 8650 }
712fcc08 8651 toplevel $top
d990cedf
CS
8652 wm title $top [mc "Gitk preferences"]
8653 label $top.ldisp -text [mc "Commit list display options"]
712fcc08
PM
8654 grid $top.ldisp - -sticky w -pady 10
8655 label $top.spacer -text " "
d990cedf 8656 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
712fcc08
PM
8657 -font optionfont
8658 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8659 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
d990cedf 8660 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
712fcc08
PM
8661 -font optionfont
8662 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8663 grid x $top.maxpctl $top.maxpct -sticky w
219ea3a9 8664 frame $top.showlocal
d990cedf 8665 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
219ea3a9
PM
8666 checkbutton $top.showlocal.b -variable showlocalchanges
8667 pack $top.showlocal.b $top.showlocal.l -side left
8668 grid x $top.showlocal -sticky w
f8a2c0d1 8669
d990cedf 8670 label $top.ddisp -text [mc "Diff display options"]
712fcc08 8671 grid $top.ddisp - -sticky w -pady 10
d990cedf 8672 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
94503918
PM
8673 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8674 grid x $top.tabstopl $top.tabstop -sticky w
b8ab2e17 8675 frame $top.ntag
d990cedf 8676 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
b8ab2e17
PM
8677 checkbutton $top.ntag.b -variable showneartags
8678 pack $top.ntag.b $top.ntag.l -side left
8679 grid x $top.ntag -sticky w
7a39a17a 8680 frame $top.ldiff
d990cedf 8681 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7a39a17a
PM
8682 checkbutton $top.ldiff.b -variable limitdiffs
8683 pack $top.ldiff.b $top.ldiff.l -side left
8684 grid x $top.ldiff -sticky w
f8a2c0d1 8685
d990cedf 8686 label $top.cdisp -text [mc "Colors: press to choose"]
f8a2c0d1
PM
8687 grid $top.cdisp - -sticky w -pady 10
8688 label $top.bg -padx 40 -relief sunk -background $bgcolor
d990cedf 8689 button $top.bgbut -text [mc "Background"] -font optionfont \
f8a2c0d1
PM
8690 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8691 grid x $top.bgbut $top.bg -sticky w
8692 label $top.fg -padx 40 -relief sunk -background $fgcolor
d990cedf 8693 button $top.fgbut -text [mc "Foreground"] -font optionfont \
f8a2c0d1
PM
8694 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8695 grid x $top.fgbut $top.fg -sticky w
8696 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
d990cedf 8697 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
f8a2c0d1
PM
8698 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8699 [list $ctext tag conf d0 -foreground]]
8700 grid x $top.diffoldbut $top.diffold -sticky w
8701 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
d990cedf 8702 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
f8a2c0d1
PM
8703 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8704 [list $ctext tag conf d1 -foreground]]
8705 grid x $top.diffnewbut $top.diffnew -sticky w
8706 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
d990cedf 8707 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
f8a2c0d1
PM
8708 -command [list choosecolor diffcolors 2 $top.hunksep \
8709 "diff hunk header" \
8710 [list $ctext tag conf hunksep -foreground]]
8711 grid x $top.hunksepbut $top.hunksep -sticky w
60378c0c 8712 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
d990cedf 8713 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
281404ca 8714 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
60378c0c 8715 grid x $top.selbgbut $top.selbgsep -sticky w
f8a2c0d1 8716
d990cedf 8717 label $top.cfont -text [mc "Fonts: press to choose"]
9a7558f3 8718 grid $top.cfont - -sticky w -pady 10
d990cedf
CS
8719 mkfontdisp mainfont $top [mc "Main font"]
8720 mkfontdisp textfont $top [mc "Diff display font"]
8721 mkfontdisp uifont $top [mc "User interface font"]
9a7558f3 8722
712fcc08 8723 frame $top.buts
d990cedf 8724 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
d990cedf 8725 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
712fcc08
PM
8726 grid $top.buts.ok $top.buts.can
8727 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8728 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8729 grid $top.buts - - -pady 10 -sticky ew
3a950e9a 8730 bind $top <Visibility> "focus $top.buts.ok"
712fcc08
PM
8731}
8732
f8a2c0d1
PM
8733proc choosecolor {v vi w x cmd} {
8734 global $v
8735
8736 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
d990cedf 8737 -title [mc "Gitk: choose color for %s" $x]]
f8a2c0d1
PM
8738 if {$c eq {}} return
8739 $w conf -background $c
8740 lset $v $vi $c
8741 eval $cmd $c
8742}
8743
60378c0c
ML
8744proc setselbg {c} {
8745 global bglist cflist
8746 foreach w $bglist {
8747 $w configure -selectbackground $c
8748 }
8749 $cflist tag configure highlight \
8750 -background [$cflist cget -selectbackground]
8751 allcanvs itemconf secsel -fill $c
8752}
8753
f8a2c0d1
PM
8754proc setbg {c} {
8755 global bglist
8756
8757 foreach w $bglist {
8758 $w conf -background $c
8759 }
8760}
8761
8762proc setfg {c} {
8763 global fglist canv
8764
8765 foreach w $fglist {
8766 $w conf -foreground $c
8767 }
8768 allcanvs itemconf text -fill $c
8769 $canv itemconf circle -outline $c
8770}
8771
712fcc08 8772proc prefscan {} {
94503918 8773 global oldprefs prefstop
712fcc08 8774
3de07118 8775 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
94503918
PM
8776 limitdiffs tabstop} {
8777 global $v
712fcc08
PM
8778 set $v $oldprefs($v)
8779 }
8780 catch {destroy $prefstop}
8781 unset prefstop
9a7558f3 8782 fontcan
712fcc08
PM
8783}
8784
8785proc prefsok {} {
8786 global maxwidth maxgraphpct
219ea3a9 8787 global oldprefs prefstop showneartags showlocalchanges
9a7558f3 8788 global fontpref mainfont textfont uifont
7b3b1515 8789 global limitdiffs treediffs
712fcc08
PM
8790
8791 catch {destroy $prefstop}
8792 unset prefstop
9a7558f3
PM
8793 fontcan
8794 set fontchanged 0
8795 if {$mainfont ne $fontpref(mainfont)} {
8796 set mainfont $fontpref(mainfont)
8797 parsefont mainfont $mainfont
8798 eval font configure mainfont [fontflags mainfont]
8799 eval font configure mainfontbold [fontflags mainfont 1]
8800 setcoords
8801 set fontchanged 1
8802 }
8803 if {$textfont ne $fontpref(textfont)} {
8804 set textfont $fontpref(textfont)
8805 parsefont textfont $textfont
8806 eval font configure textfont [fontflags textfont]
8807 eval font configure textfontbold [fontflags textfont 1]
8808 }
8809 if {$uifont ne $fontpref(uifont)} {
8810 set uifont $fontpref(uifont)
8811 parsefont uifont $uifont
8812 eval font configure uifont [fontflags uifont]
8813 }
32f1b3e4 8814 settabs
219ea3a9
PM
8815 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8816 if {$showlocalchanges} {
8817 doshowlocalchanges
8818 } else {
8819 dohidelocalchanges
8820 }
8821 }
74a40c71
PM
8822 if {$limitdiffs != $oldprefs(limitdiffs)} {
8823 # treediffs elements are limited by path
8824 catch {unset treediffs}
8825 }
9a7558f3 8826 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
712fcc08
PM
8827 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8828 redisplay
7a39a17a
PM
8829 } elseif {$showneartags != $oldprefs(showneartags) ||
8830 $limitdiffs != $oldprefs(limitdiffs)} {
b8ab2e17 8831 reselectline
712fcc08
PM
8832 }
8833}
8834
8835proc formatdate {d} {
e8b5f4be 8836 global datetimeformat
219ea3a9 8837 if {$d ne {}} {
e8b5f4be 8838 set d [clock format $d -format $datetimeformat]
219ea3a9
PM
8839 }
8840 return $d
232475d3
PM
8841}
8842
fd8ccbec
PM
8843# This list of encoding names and aliases is distilled from
8844# http://www.iana.org/assignments/character-sets.
8845# Not all of them are supported by Tcl.
8846set encoding_aliases {
8847 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8848 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8849 { ISO-10646-UTF-1 csISO10646UTF1 }
8850 { ISO_646.basic:1983 ref csISO646basic1983 }
8851 { INVARIANT csINVARIANT }
8852 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8853 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8854 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8855 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8856 { NATS-DANO iso-ir-9-1 csNATSDANO }
8857 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8858 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8859 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8860 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8861 { ISO-2022-KR csISO2022KR }
8862 { EUC-KR csEUCKR }
8863 { ISO-2022-JP csISO2022JP }
8864 { ISO-2022-JP-2 csISO2022JP2 }
8865 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8866 csISO13JISC6220jp }
8867 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8868 { IT iso-ir-15 ISO646-IT csISO15Italian }
8869 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8870 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8871 { greek7-old iso-ir-18 csISO18Greek7Old }
8872 { latin-greek iso-ir-19 csISO19LatinGreek }
8873 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8874 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8875 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8876 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8877 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8878 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8879 { INIS iso-ir-49 csISO49INIS }
8880 { INIS-8 iso-ir-50 csISO50INIS8 }
8881 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8882 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8883 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8884 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8885 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8886 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8887 csISO60Norwegian1 }
8888 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8889 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8890 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8891 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8892 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8893 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8894 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8895 { greek7 iso-ir-88 csISO88Greek7 }
8896 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8897 { iso-ir-90 csISO90 }
8898 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8899 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8900 csISO92JISC62991984b }
8901 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8902 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8903 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8904 csISO95JIS62291984handadd }
8905 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8906 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8907 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8908 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8909 CP819 csISOLatin1 }
8910 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8911 { T.61-7bit iso-ir-102 csISO102T617bit }
8912 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8913 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8914 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8915 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8916 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8917 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8918 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8919 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8920 arabic csISOLatinArabic }
8921 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8922 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8923 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8924 greek greek8 csISOLatinGreek }
8925 { T.101-G2 iso-ir-128 csISO128T101G2 }
8926 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8927 csISOLatinHebrew }
8928 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8929 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8930 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8931 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8932 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8933 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8934 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8935 csISOLatinCyrillic }
8936 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8937 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8938 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8939 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8940 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8941 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8942 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8943 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8944 { ISO_10367-box iso-ir-155 csISO10367Box }
8945 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8946 { latin-lap lap iso-ir-158 csISO158Lap }
8947 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8948 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8949 { us-dk csUSDK }
8950 { dk-us csDKUS }
8951 { JIS_X0201 X0201 csHalfWidthKatakana }
8952 { KSC5636 ISO646-KR csKSC5636 }
8953 { ISO-10646-UCS-2 csUnicode }
8954 { ISO-10646-UCS-4 csUCS4 }
8955 { DEC-MCS dec csDECMCS }
8956 { hp-roman8 roman8 r8 csHPRoman8 }
8957 { macintosh mac csMacintosh }
8958 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8959 csIBM037 }
8960 { IBM038 EBCDIC-INT cp038 csIBM038 }
8961 { IBM273 CP273 csIBM273 }
8962 { IBM274 EBCDIC-BE CP274 csIBM274 }
8963 { IBM275 EBCDIC-BR cp275 csIBM275 }
8964 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8965 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8966 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8967 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8968 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8969 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8970 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8971 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8972 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8973 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8974 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8975 { IBM437 cp437 437 csPC8CodePage437 }
8976 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8977 { IBM775 cp775 csPC775Baltic }
8978 { IBM850 cp850 850 csPC850Multilingual }
8979 { IBM851 cp851 851 csIBM851 }
8980 { IBM852 cp852 852 csPCp852 }
8981 { IBM855 cp855 855 csIBM855 }
8982 { IBM857 cp857 857 csIBM857 }
8983 { IBM860 cp860 860 csIBM860 }
8984 { IBM861 cp861 861 cp-is csIBM861 }
8985 { IBM862 cp862 862 csPC862LatinHebrew }
8986 { IBM863 cp863 863 csIBM863 }
8987 { IBM864 cp864 csIBM864 }
8988 { IBM865 cp865 865 csIBM865 }
8989 { IBM866 cp866 866 csIBM866 }
8990 { IBM868 CP868 cp-ar csIBM868 }
8991 { IBM869 cp869 869 cp-gr csIBM869 }
8992 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8993 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8994 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8995 { IBM891 cp891 csIBM891 }
8996 { IBM903 cp903 csIBM903 }
8997 { IBM904 cp904 904 csIBBM904 }
8998 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8999 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9000 { IBM1026 CP1026 csIBM1026 }
9001 { EBCDIC-AT-DE csIBMEBCDICATDE }
9002 { EBCDIC-AT-DE-A csEBCDICATDEA }
9003 { EBCDIC-CA-FR csEBCDICCAFR }
9004 { EBCDIC-DK-NO csEBCDICDKNO }
9005 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9006 { EBCDIC-FI-SE csEBCDICFISE }
9007 { EBCDIC-FI-SE-A csEBCDICFISEA }
9008 { EBCDIC-FR csEBCDICFR }
9009 { EBCDIC-IT csEBCDICIT }
9010 { EBCDIC-PT csEBCDICPT }
9011 { EBCDIC-ES csEBCDICES }
9012 { EBCDIC-ES-A csEBCDICESA }
9013 { EBCDIC-ES-S csEBCDICESS }
9014 { EBCDIC-UK csEBCDICUK }
9015 { EBCDIC-US csEBCDICUS }
9016 { UNKNOWN-8BIT csUnknown8BiT }
9017 { MNEMONIC csMnemonic }
9018 { MNEM csMnem }
9019 { VISCII csVISCII }
9020 { VIQR csVIQR }
9021 { KOI8-R csKOI8R }
9022 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9023 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9024 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9025 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9026 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9027 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9028 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9029 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9030 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9031 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9032 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9033 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9034 { IBM1047 IBM-1047 }
9035 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9036 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9037 { UNICODE-1-1 csUnicode11 }
9038 { CESU-8 csCESU-8 }
9039 { BOCU-1 csBOCU-1 }
9040 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9041 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9042 l8 }
9043 { ISO-8859-15 ISO_8859-15 Latin-9 }
9044 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9045 { GBK CP936 MS936 windows-936 }
9046 { JIS_Encoding csJISEncoding }
9047 { Shift_JIS MS_Kanji csShiftJIS }
9048 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9049 EUC-JP }
9050 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9051 { ISO-10646-UCS-Basic csUnicodeASCII }
9052 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9053 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9054 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9055 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9056 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9057 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9058 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9059 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9060 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9061 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9062 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9063 { Ventura-US csVenturaUS }
9064 { Ventura-International csVenturaInternational }
9065 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9066 { PC8-Turkish csPC8Turkish }
9067 { IBM-Symbols csIBMSymbols }
9068 { IBM-Thai csIBMThai }
9069 { HP-Legal csHPLegal }
9070 { HP-Pi-font csHPPiFont }
9071 { HP-Math8 csHPMath8 }
9072 { Adobe-Symbol-Encoding csHPPSMath }
9073 { HP-DeskTop csHPDesktop }
9074 { Ventura-Math csVenturaMath }
9075 { Microsoft-Publishing csMicrosoftPublishing }
9076 { Windows-31J csWindows31J }
9077 { GB2312 csGB2312 }
9078 { Big5 csBig5 }
9079}
9080
9081proc tcl_encoding {enc} {
9082 global encoding_aliases
9083 set names [encoding names]
9084 set lcnames [string tolower $names]
9085 set enc [string tolower $enc]
9086 set i [lsearch -exact $lcnames $enc]
9087 if {$i < 0} {
9088 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9089 if {[regsub {^iso[-_]} $enc iso encx]} {
9090 set i [lsearch -exact $lcnames $encx]
9091 }
9092 }
9093 if {$i < 0} {
9094 foreach l $encoding_aliases {
9095 set ll [string tolower $l]
9096 if {[lsearch -exact $ll $enc] < 0} continue
9097 # look through the aliases for one that tcl knows about
9098 foreach e $ll {
9099 set i [lsearch -exact $lcnames $e]
9100 if {$i < 0} {
9101 if {[regsub {^iso[-_]} $e iso ex]} {
9102 set i [lsearch -exact $lcnames $ex]
9103 }
9104 }
9105 if {$i >= 0} break
9106 }
9107 break
9108 }
9109 }
9110 if {$i >= 0} {
9111 return [lindex $names $i]
9112 }
9113 return {}
9114}
9115
5d7589d4
PM
9116# First check that Tcl/Tk is recent enough
9117if {[catch {package require Tk 8.4} err]} {
d990cedf
CS
9118 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9119 Gitk requires at least Tcl/Tk 8.4."]
5d7589d4
PM
9120 exit 1
9121}
9122
1d10f36d
PM
9123# defaults...
9124set datemode 0
8974c6f9 9125set wrcomcmd "git diff-tree --stdin -p --pretty"
671bc153 9126
fd8ccbec 9127set gitencoding {}
671bc153 9128catch {
27cb61ca 9129 set gitencoding [exec git config --get i18n.commitencoding]
671bc153
JH
9130}
9131if {$gitencoding == ""} {
fd8ccbec
PM
9132 set gitencoding "utf-8"
9133}
9134set tclencoding [tcl_encoding $gitencoding]
9135if {$tclencoding == {}} {
9136 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
671bc153 9137}
1db95b00 9138
1d10f36d 9139set mainfont {Helvetica 9}
1d10f36d 9140set textfont {Courier 9}
4840be66 9141set uifont {Helvetica 9 bold}
7e12f1a6 9142set tabstop 8
b74fd579 9143set findmergefiles 0
8d858d1a 9144set maxgraphpct 50
f6075eba 9145set maxwidth 16
232475d3 9146set revlistorder 0
757f17bc 9147set fastdate 0
6e8c8707
PM
9148set uparrowlen 5
9149set downarrowlen 5
9150set mingaplen 100
f8b28a40 9151set cmitmode "patch"
f1b86294 9152set wrapcomment "none"
b8ab2e17 9153set showneartags 1
0a4dd8b8 9154set maxrefs 20
322a8cc9 9155set maxlinelen 200
219ea3a9 9156set showlocalchanges 1
7a39a17a 9157set limitdiffs 1
e8b5f4be 9158set datetimeformat "%Y-%m-%d %H:%M:%S"
1d10f36d
PM
9159
9160set colors {green red blue magenta darkgrey brown orange}
f8a2c0d1
PM
9161set bgcolor white
9162set fgcolor black
9163set diffcolors {red "#00a000" blue}
890fae70 9164set diffcontext 3
60378c0c 9165set selectbgcolor gray85
1d10f36d 9166
663c3aa9
CS
9167## For msgcat loading, first locate the installation location.
9168if { [info exists ::env(GITK_MSGSDIR)] } {
9169 ## Msgsdir was manually set in the environment.
9170 set gitk_msgsdir $::env(GITK_MSGSDIR)
9171} else {
9172 ## Let's guess the prefix from argv0.
9173 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9174 set gitk_libdir [file join $gitk_prefix share gitk lib]
9175 set gitk_msgsdir [file join $gitk_libdir msgs]
9176 unset gitk_prefix
9177}
9178
9179## Internationalization (i18n) through msgcat and gettext. See
9180## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9181package require msgcat
9182namespace import ::msgcat::mc
9183## And eventually load the actual message catalog
9184::msgcat::mcload $gitk_msgsdir
9185
1d10f36d
PM
9186catch {source ~/.gitk}
9187
712fcc08 9188font create optionfont -family sans-serif -size -12
17386066 9189
0ed1dd3c
PM
9190parsefont mainfont $mainfont
9191eval font create mainfont [fontflags mainfont]
9192eval font create mainfontbold [fontflags mainfont 1]
9193
9194parsefont textfont $textfont
9195eval font create textfont [fontflags textfont]
9196eval font create textfontbold [fontflags textfont 1]
9197
9198parsefont uifont $uifont
9199eval font create uifont [fontflags uifont]
17386066 9200
b039f0a6
PM
9201setoptions
9202
cdaee5db 9203# check that we can find a .git directory somewhere...
6c87d60c 9204if {[catch {set gitdir [gitdir]}]} {
d990cedf 9205 show_error {} . [mc "Cannot find a git repository here."]
6c87d60c
AR
9206 exit 1
9207}
cdaee5db 9208if {![file isdirectory $gitdir]} {
d990cedf 9209 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
cdaee5db
PM
9210 exit 1
9211}
9212
7a39a17a 9213set mergeonly 0
1d10f36d 9214set revtreeargs {}
cdaee5db
PM
9215set cmdline_files {}
9216set i 0
1d10f36d 9217foreach arg $argv {
6ebedabf
PM
9218 switch -- $arg {
9219 "" { }
9220 "-d" { set datemode 1 }
7a39a17a
PM
9221 "--merge" {
9222 set mergeonly 1
9223 lappend revtreeargs $arg
9224 }
cdaee5db
PM
9225 "--" {
9226 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9227 break
9228 }
1d10f36d
PM
9229 default {
9230 lappend revtreeargs $arg
9231 }
9232 }
cdaee5db 9233 incr i
1db95b00 9234}
1d10f36d 9235
cdaee5db
PM
9236if {$i >= [llength $argv] && $revtreeargs ne {}} {
9237 # no -- on command line, but some arguments (other than -d)
098dd8a3 9238 if {[catch {
8974c6f9 9239 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
098dd8a3
PM
9240 set cmdline_files [split $f "\n"]
9241 set n [llength $cmdline_files]
9242 set revtreeargs [lrange $revtreeargs 0 end-$n]
cdaee5db
PM
9243 # Unfortunately git rev-parse doesn't produce an error when
9244 # something is both a revision and a filename. To be consistent
9245 # with git log and git rev-list, check revtreeargs for filenames.
9246 foreach arg $revtreeargs {
9247 if {[file exists $arg]} {
d990cedf
CS
9248 show_error {} . [mc "Ambiguous argument '%s': both revision\
9249 and filename" $arg]
cdaee5db
PM
9250 exit 1
9251 }
9252 }
098dd8a3
PM
9253 } err]} {
9254 # unfortunately we get both stdout and stderr in $err,
9255 # so look for "fatal:".
9256 set i [string first "fatal:" $err]
9257 if {$i > 0} {
b5e09633 9258 set err [string range $err [expr {$i + 6}] end]
098dd8a3 9259 }
d990cedf 9260 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
098dd8a3
PM
9261 exit 1
9262 }
9263}
9264
7a39a17a
PM
9265if {$mergeonly} {
9266 # find the list of unmerged files
9267 set mlist {}
9268 set nr_unmerged 0
9269 if {[catch {
9270 set fd [open "| git ls-files -u" r]
9271 } err]} {
d990cedf 9272 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
7a39a17a
PM
9273 exit 1
9274 }
9275 while {[gets $fd line] >= 0} {
9276 set i [string first "\t" $line]
9277 if {$i < 0} continue
9278 set fname [string range $line [expr {$i+1}] end]
9279 if {[lsearch -exact $mlist $fname] >= 0} continue
9280 incr nr_unmerged
9281 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9282 lappend mlist $fname
9283 }
9284 }
9285 catch {close $fd}
9286 if {$mlist eq {}} {
9287 if {$nr_unmerged == 0} {
d990cedf
CS
9288 show_error {} . [mc "No files selected: --merge specified but\
9289 no files are unmerged."]
7a39a17a 9290 } else {
d990cedf
CS
9291 show_error {} . [mc "No files selected: --merge specified but\
9292 no unmerged files are within file limit."]
7a39a17a
PM
9293 }
9294 exit 1
9295 }
9296 set cmdline_files $mlist
9297}
9298
219ea3a9 9299set nullid "0000000000000000000000000000000000000000"
8f489363
PM
9300set nullid2 "0000000000000000000000000000000000000001"
9301
32f1b3e4 9302set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
219ea3a9 9303
7eb3cb9c 9304set runq {}
d698206c
PM
9305set history {}
9306set historyindex 0
908c3585 9307set fh_serial 0
908c3585 9308set nhl_names {}
63b79191 9309set highlight_paths {}
687c8765 9310set findpattern {}
1902c270 9311set searchdirn -forwards
4e7d6779
PM
9312set boldrows {}
9313set boldnamerows {}
a8d610a2 9314set diffelide {0 0}
4fb0fa19 9315set markingmatches 0
97645683 9316set linkentercount 0
0380081c
PM
9317set need_redisplay 0
9318set nrows_drawn 0
32f1b3e4 9319set firsttabstop 0
9f1afe05 9320
50b44ece
PM
9321set nextviewnum 1
9322set curview 0
a90a6d24 9323set selectedview 0
b007ee20
CS
9324set selectedhlview [mc "None"]
9325set highlight_related [mc "None"]
687c8765 9326set highlight_files {}
50b44ece 9327set viewfiles(0) {}
a90a6d24 9328set viewperm(0) 0
098dd8a3 9329set viewargs(0) {}
50b44ece 9330
7fcc92bf 9331set loginstance 0
098dd8a3 9332set cmdlineok 0
1d10f36d 9333set stopped 0
0fba86b3 9334set stuffsaved 0
74daedb6 9335set patchnum 0
219ea3a9 9336set lserial 0
1d10f36d 9337setcoords
d94f8cd6 9338makewindow
0eafba14
PM
9339# wait for the window to become visible
9340tkwait visibility .
6c283328 9341wm title . "[file tail $argv0]: [file tail [pwd]]"
887fe3c4 9342readrefs
a8aaf19c 9343
098dd8a3 9344if {$cmdline_files ne {} || $revtreeargs ne {}} {
50b44ece
PM
9345 # create a view for the files/dirs specified on the command line
9346 set curview 1
a90a6d24 9347 set selectedview 1
50b44ece 9348 set nextviewnum 2
d990cedf 9349 set viewname(1) [mc "Command line"]
50b44ece 9350 set viewfiles(1) $cmdline_files
098dd8a3 9351 set viewargs(1) $revtreeargs
a90a6d24 9352 set viewperm(1) 0
da7c24dd 9353 addviewmenu 1
d990cedf
CS
9354 .bar.view entryconf [mc "Edit view..."] -state normal
9355 .bar.view entryconf [mc "Delete view"] -state normal
50b44ece 9356}
a90a6d24
PM
9357
9358if {[info exists permviews]} {
9359 foreach v $permviews {
9360 set n $nextviewnum
9361 incr nextviewnum
9362 set viewname($n) [lindex $v 0]
9363 set viewfiles($n) [lindex $v 1]
098dd8a3 9364 set viewargs($n) [lindex $v 2]
a90a6d24 9365 set viewperm($n) 1
da7c24dd 9366 addviewmenu $n
a90a6d24
PM
9367 }
9368}
a8aaf19c 9369getcommits