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