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