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