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