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