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