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