Merge branch 'tg/t-readme-updates'
[git] / gitk-git / gitk
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
4
5 # Copyright © 2005-2016 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 vinlinediff
160     global worddiff git_version
161
162     set vdatemode($n) 0
163     set vmergeonly($n) 0
164     set vinlinediff($n) 0
165     set glflags {}
166     set diffargs {}
167     set nextisval 0
168     set revargs {}
169     set origargs $arglist
170     set allknown 1
171     set filtered 0
172     set i -1
173     foreach arg $arglist {
174         incr i
175         if {$nextisval} {
176             lappend glflags $arg
177             set nextisval 0
178             continue
179         }
180         switch -glob -- $arg {
181             "-d" -
182             "--date-order" {
183                 set vdatemode($n) 1
184                 # remove from origargs in case we hit an unknown option
185                 set origargs [lreplace $origargs $i $i]
186                 incr i -1
187             }
188             "-[puabwcrRBMC]" -
189             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
190             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
191             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
192             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
193             "--ignore-space-change" - "-U*" - "--unified=*" {
194                 # These request or affect diff output, which we don't want.
195                 # Some could be used to set our defaults for diff display.
196                 lappend diffargs $arg
197             }
198             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
199             "--name-only" - "--name-status" - "--color" -
200             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
201             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
202             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
203             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
204             "--objects" - "--objects-edge" - "--reverse" {
205                 # These cause our parsing of git log's output to fail, or else
206                 # they're options we want to set ourselves, so ignore them.
207             }
208             "--color-words*" - "--word-diff=color" {
209                 # These trigger a word diff in the console interface,
210                 # so help the user by enabling our own support
211                 if {[package vcompare $git_version "1.7.2"] >= 0} {
212                     set worddiff [mc "Color words"]
213                 }
214             }
215             "--word-diff*" {
216                 if {[package vcompare $git_version "1.7.2"] >= 0} {
217                     set worddiff [mc "Markup words"]
218                 }
219             }
220             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
221             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
222             "--full-history" - "--dense" - "--sparse" -
223             "--follow" - "--left-right" - "--encoding=*" {
224                 # These are harmless, and some are even useful
225                 lappend glflags $arg
226             }
227             "--diff-filter=*" - "--no-merges" - "--unpacked" -
228             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
229             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
230             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
231             "--remove-empty" - "--first-parent" - "--cherry-pick" -
232             "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
233             "--simplify-by-decoration" {
234                 # These mean that we get a subset of the commits
235                 set filtered 1
236                 lappend glflags $arg
237             }
238             "-L*" {
239                 # Line-log with 'stuck' argument (unstuck form is
240                 # not supported)
241                 set filtered 1
242                 set vinlinediff($n) 1
243                 set allknown 0
244                 lappend glflags $arg
245             }
246             "-n" {
247                 # This appears to be the only one that has a value as a
248                 # separate word following it
249                 set filtered 1
250                 set nextisval 1
251                 lappend glflags $arg
252             }
253             "--not" - "--all" {
254                 lappend revargs $arg
255             }
256             "--merge" {
257                 set vmergeonly($n) 1
258                 # git rev-parse doesn't understand --merge
259                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
260             }
261             "--no-replace-objects" {
262                 set env(GIT_NO_REPLACE_OBJECTS) "1"
263             }
264             "-*" {
265                 # Other flag arguments including -<n>
266                 if {[string is digit -strict [string range $arg 1 end]]} {
267                     set filtered 1
268                 } else {
269                     # a flag argument that we don't recognize;
270                     # that means we can't optimize
271                     set allknown 0
272                 }
273                 lappend glflags $arg
274             }
275             default {
276                 # Non-flag arguments specify commits or ranges of commits
277                 if {[string match "*...*" $arg]} {
278                     lappend revargs --gitk-symmetric-diff-marker
279                 }
280                 lappend revargs $arg
281             }
282         }
283     }
284     set vdflags($n) $diffargs
285     set vflags($n) $glflags
286     set vrevs($n) $revargs
287     set vfiltered($n) $filtered
288     set vorigargs($n) $origargs
289     return $allknown
290 }
291
292 proc parseviewrevs {view revs} {
293     global vposids vnegids
294
295     if {$revs eq {}} {
296         set revs HEAD
297     } elseif {[lsearch -exact $revs --all] >= 0} {
298         lappend revs HEAD
299     }
300     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
301         # we get stdout followed by stderr in $err
302         # for an unknown rev, git rev-parse echoes it and then errors out
303         set errlines [split $err "\n"]
304         set badrev {}
305         for {set l 0} {$l < [llength $errlines]} {incr l} {
306             set line [lindex $errlines $l]
307             if {!([string length $line] == 40 && [string is xdigit $line])} {
308                 if {[string match "fatal:*" $line]} {
309                     if {[string match "fatal: ambiguous argument*" $line]
310                         && $badrev ne {}} {
311                         if {[llength $badrev] == 1} {
312                             set err "unknown revision $badrev"
313                         } else {
314                             set err "unknown revisions: [join $badrev ", "]"
315                         }
316                     } else {
317                         set err [join [lrange $errlines $l end] "\n"]
318                     }
319                     break
320                 }
321                 lappend badrev $line
322             }
323         }
324         error_popup "[mc "Error parsing revisions:"] $err"
325         return {}
326     }
327     set ret {}
328     set pos {}
329     set neg {}
330     set sdm 0
331     foreach id [split $ids "\n"] {
332         if {$id eq "--gitk-symmetric-diff-marker"} {
333             set sdm 4
334         } elseif {[string match "^*" $id]} {
335             if {$sdm != 1} {
336                 lappend ret $id
337                 if {$sdm == 3} {
338                     set sdm 0
339                 }
340             }
341             lappend neg [string range $id 1 end]
342         } else {
343             if {$sdm != 2} {
344                 lappend ret $id
345             } else {
346                 lset ret end $id...[lindex $ret end]
347             }
348             lappend pos $id
349         }
350         incr sdm -1
351     }
352     set vposids($view) $pos
353     set vnegids($view) $neg
354     return $ret
355 }
356
357 # Start off a git log process and arrange to read its output
358 proc start_rev_list {view} {
359     global startmsecs commitidx viewcomplete curview
360     global tclencoding
361     global viewargs viewargscmd viewfiles vfilelimit
362     global showlocalchanges
363     global viewactive viewinstances vmergeonly
364     global mainheadid viewmainheadid viewmainheadid_orig
365     global vcanopt vflags vrevs vorigargs
366     global show_notes
367
368     set startmsecs [clock clicks -milliseconds]
369     set commitidx($view) 0
370     # these are set this way for the error exits
371     set viewcomplete($view) 1
372     set viewactive($view) 0
373     varcinit $view
374
375     set args $viewargs($view)
376     if {$viewargscmd($view) ne {}} {
377         if {[catch {
378             set str [exec sh -c $viewargscmd($view)]
379         } err]} {
380             error_popup "[mc "Error executing --argscmd command:"] $err"
381             return 0
382         }
383         set args [concat $args [split $str "\n"]]
384     }
385     set vcanopt($view) [parseviewargs $view $args]
386
387     set files $viewfiles($view)
388     if {$vmergeonly($view)} {
389         set files [unmerged_files $files]
390         if {$files eq {}} {
391             global nr_unmerged
392             if {$nr_unmerged == 0} {
393                 error_popup [mc "No files selected: --merge specified but\
394                              no files are unmerged."]
395             } else {
396                 error_popup [mc "No files selected: --merge specified but\
397                              no unmerged files are within file limit."]
398             }
399             return 0
400         }
401     }
402     set vfilelimit($view) $files
403
404     if {$vcanopt($view)} {
405         set revs [parseviewrevs $view $vrevs($view)]
406         if {$revs eq {}} {
407             return 0
408         }
409         set args [concat $vflags($view) $revs]
410     } else {
411         set args $vorigargs($view)
412     }
413
414     if {[catch {
415         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
416                         --parents --boundary $args "--" $files] r]
417     } err]} {
418         error_popup "[mc "Error executing git log:"] $err"
419         return 0
420     }
421     set i [reg_instance $fd]
422     set viewinstances($view) [list $i]
423     set viewmainheadid($view) $mainheadid
424     set viewmainheadid_orig($view) $mainheadid
425     if {$files ne {} && $mainheadid ne {}} {
426         get_viewmainhead $view
427     }
428     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
429         interestedin $viewmainheadid($view) dodiffindex
430     }
431     fconfigure $fd -blocking 0 -translation lf -eofchar {}
432     if {$tclencoding != {}} {
433         fconfigure $fd -encoding $tclencoding
434     }
435     filerun $fd [list getcommitlines $fd $i $view 0]
436     nowbusy $view [mc "Reading"]
437     set viewcomplete($view) 0
438     set viewactive($view) 1
439     return 1
440 }
441
442 proc stop_instance {inst} {
443     global commfd leftover
444
445     set fd $commfd($inst)
446     catch {
447         set pid [pid $fd]
448
449         if {$::tcl_platform(platform) eq {windows}} {
450             exec taskkill /pid $pid
451         } else {
452             exec kill $pid
453         }
454     }
455     catch {close $fd}
456     nukefile $fd
457     unset commfd($inst)
458     unset leftover($inst)
459 }
460
461 proc stop_backends {} {
462     global commfd
463
464     foreach inst [array names commfd] {
465         stop_instance $inst
466     }
467 }
468
469 proc stop_rev_list {view} {
470     global viewinstances
471
472     foreach inst $viewinstances($view) {
473         stop_instance $inst
474     }
475     set viewinstances($view) {}
476 }
477
478 proc reset_pending_select {selid} {
479     global pending_select mainheadid selectheadid
480
481     if {$selid ne {}} {
482         set pending_select $selid
483     } elseif {$selectheadid ne {}} {
484         set pending_select $selectheadid
485     } else {
486         set pending_select $mainheadid
487     }
488 }
489
490 proc getcommits {selid} {
491     global canv curview need_redisplay viewactive
492
493     initlayout
494     if {[start_rev_list $curview]} {
495         reset_pending_select $selid
496         show_status [mc "Reading commits..."]
497         set need_redisplay 1
498     } else {
499         show_status [mc "No commits selected"]
500     }
501 }
502
503 proc updatecommits {} {
504     global curview vcanopt vorigargs vfilelimit viewinstances
505     global viewactive viewcomplete tclencoding
506     global startmsecs showneartags showlocalchanges
507     global mainheadid viewmainheadid viewmainheadid_orig pending_select
508     global hasworktree
509     global varcid vposids vnegids vflags vrevs
510     global show_notes
511
512     set hasworktree [hasworktree]
513     rereadrefs
514     set view $curview
515     if {$mainheadid ne $viewmainheadid_orig($view)} {
516         if {$showlocalchanges} {
517             dohidelocalchanges
518         }
519         set viewmainheadid($view) $mainheadid
520         set viewmainheadid_orig($view) $mainheadid
521         if {$vfilelimit($view) ne {}} {
522             get_viewmainhead $view
523         }
524     }
525     if {$showlocalchanges} {
526         doshowlocalchanges
527     }
528     if {$vcanopt($view)} {
529         set oldpos $vposids($view)
530         set oldneg $vnegids($view)
531         set revs [parseviewrevs $view $vrevs($view)]
532         if {$revs eq {}} {
533             return
534         }
535         # note: getting the delta when negative refs change is hard,
536         # and could require multiple git log invocations, so in that
537         # case we ask git log for all the commits (not just the delta)
538         if {$oldneg eq $vnegids($view)} {
539             set newrevs {}
540             set npos 0
541             # take out positive refs that we asked for before or
542             # that we have already seen
543             foreach rev $revs {
544                 if {[string length $rev] == 40} {
545                     if {[lsearch -exact $oldpos $rev] < 0
546                         && ![info exists varcid($view,$rev)]} {
547                         lappend newrevs $rev
548                         incr npos
549                     }
550                 } else {
551                     lappend $newrevs $rev
552                 }
553             }
554             if {$npos == 0} return
555             set revs $newrevs
556             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
557         }
558         set args [concat $vflags($view) $revs --not $oldpos]
559     } else {
560         set args $vorigargs($view)
561     }
562     if {[catch {
563         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
564                         --parents --boundary $args "--" $vfilelimit($view)] r]
565     } err]} {
566         error_popup "[mc "Error executing git log:"] $err"
567         return
568     }
569     if {$viewactive($view) == 0} {
570         set startmsecs [clock clicks -milliseconds]
571     }
572     set i [reg_instance $fd]
573     lappend viewinstances($view) $i
574     fconfigure $fd -blocking 0 -translation lf -eofchar {}
575     if {$tclencoding != {}} {
576         fconfigure $fd -encoding $tclencoding
577     }
578     filerun $fd [list getcommitlines $fd $i $view 1]
579     incr viewactive($view)
580     set viewcomplete($view) 0
581     reset_pending_select {}
582     nowbusy $view [mc "Reading"]
583     if {$showneartags} {
584         getallcommits
585     }
586 }
587
588 proc reloadcommits {} {
589     global curview viewcomplete selectedline currentid thickerline
590     global showneartags treediffs commitinterest cached_commitrow
591     global targetid commitinfo
592
593     set selid {}
594     if {$selectedline ne {}} {
595         set selid $currentid
596     }
597
598     if {!$viewcomplete($curview)} {
599         stop_rev_list $curview
600     }
601     resetvarcs $curview
602     set selectedline {}
603     unset -nocomplain currentid
604     unset -nocomplain thickerline
605     unset -nocomplain treediffs
606     readrefs
607     changedrefs
608     if {$showneartags} {
609         getallcommits
610     }
611     clear_display
612     unset -nocomplain commitinfo
613     unset -nocomplain commitinterest
614     unset -nocomplain cached_commitrow
615     unset -nocomplain targetid
616     setcanvscroll
617     getcommits $selid
618     return 0
619 }
620
621 # This makes a string representation of a positive integer which
622 # sorts as a string in numerical order
623 proc strrep {n} {
624     if {$n < 16} {
625         return [format "%x" $n]
626     } elseif {$n < 256} {
627         return [format "x%.2x" $n]
628     } elseif {$n < 65536} {
629         return [format "y%.4x" $n]
630     }
631     return [format "z%.8x" $n]
632 }
633
634 # Procedures used in reordering commits from git log (without
635 # --topo-order) into the order for display.
636
637 proc varcinit {view} {
638     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
639     global vtokmod varcmod vrowmod varcix vlastins
640
641     set varcstart($view) {{}}
642     set vupptr($view) {0}
643     set vdownptr($view) {0}
644     set vleftptr($view) {0}
645     set vbackptr($view) {0}
646     set varctok($view) {{}}
647     set varcrow($view) {{}}
648     set vtokmod($view) {}
649     set varcmod($view) 0
650     set vrowmod($view) 0
651     set varcix($view) {{}}
652     set vlastins($view) {0}
653 }
654
655 proc resetvarcs {view} {
656     global varcid varccommits parents children vseedcount ordertok
657     global vshortids
658
659     foreach vid [array names varcid $view,*] {
660         unset varcid($vid)
661         unset children($vid)
662         unset parents($vid)
663     }
664     foreach vid [array names vshortids $view,*] {
665         unset vshortids($vid)
666     }
667     # some commits might have children but haven't been seen yet
668     foreach vid [array names children $view,*] {
669         unset children($vid)
670     }
671     foreach va [array names varccommits $view,*] {
672         unset varccommits($va)
673     }
674     foreach vd [array names vseedcount $view,*] {
675         unset vseedcount($vd)
676     }
677     unset -nocomplain ordertok
678 }
679
680 # returns a list of the commits with no children
681 proc seeds {v} {
682     global vdownptr vleftptr varcstart
683
684     set ret {}
685     set a [lindex $vdownptr($v) 0]
686     while {$a != 0} {
687         lappend ret [lindex $varcstart($v) $a]
688         set a [lindex $vleftptr($v) $a]
689     }
690     return $ret
691 }
692
693 proc newvarc {view id} {
694     global varcid varctok parents children vdatemode
695     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
696     global commitdata commitinfo vseedcount varccommits vlastins
697
698     set a [llength $varctok($view)]
699     set vid $view,$id
700     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
701         if {![info exists commitinfo($id)]} {
702             parsecommit $id $commitdata($id) 1
703         }
704         set cdate [lindex [lindex $commitinfo($id) 4] 0]
705         if {![string is integer -strict $cdate]} {
706             set cdate 0
707         }
708         if {![info exists vseedcount($view,$cdate)]} {
709             set vseedcount($view,$cdate) -1
710         }
711         set c [incr vseedcount($view,$cdate)]
712         set cdate [expr {$cdate ^ 0xffffffff}]
713         set tok "s[strrep $cdate][strrep $c]"
714     } else {
715         set tok {}
716     }
717     set ka 0
718     if {[llength $children($vid)] > 0} {
719         set kid [lindex $children($vid) end]
720         set k $varcid($view,$kid)
721         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
722             set ki $kid
723             set ka $k
724             set tok [lindex $varctok($view) $k]
725         }
726     }
727     if {$ka != 0} {
728         set i [lsearch -exact $parents($view,$ki) $id]
729         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
730         append tok [strrep $j]
731     }
732     set c [lindex $vlastins($view) $ka]
733     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
734         set c $ka
735         set b [lindex $vdownptr($view) $ka]
736     } else {
737         set b [lindex $vleftptr($view) $c]
738     }
739     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
740         set c $b
741         set b [lindex $vleftptr($view) $c]
742     }
743     if {$c == $ka} {
744         lset vdownptr($view) $ka $a
745         lappend vbackptr($view) 0
746     } else {
747         lset vleftptr($view) $c $a
748         lappend vbackptr($view) $c
749     }
750     lset vlastins($view) $ka $a
751     lappend vupptr($view) $ka
752     lappend vleftptr($view) $b
753     if {$b != 0} {
754         lset vbackptr($view) $b $a
755     }
756     lappend varctok($view) $tok
757     lappend varcstart($view) $id
758     lappend vdownptr($view) 0
759     lappend varcrow($view) {}
760     lappend varcix($view) {}
761     set varccommits($view,$a) {}
762     lappend vlastins($view) 0
763     return $a
764 }
765
766 proc splitvarc {p v} {
767     global varcid varcstart varccommits varctok vtokmod
768     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
769
770     set oa $varcid($v,$p)
771     set otok [lindex $varctok($v) $oa]
772     set ac $varccommits($v,$oa)
773     set i [lsearch -exact $varccommits($v,$oa) $p]
774     if {$i <= 0} return
775     set na [llength $varctok($v)]
776     # "%" sorts before "0"...
777     set tok "$otok%[strrep $i]"
778     lappend varctok($v) $tok
779     lappend varcrow($v) {}
780     lappend varcix($v) {}
781     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
782     set varccommits($v,$na) [lrange $ac $i end]
783     lappend varcstart($v) $p
784     foreach id $varccommits($v,$na) {
785         set varcid($v,$id) $na
786     }
787     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
788     lappend vlastins($v) [lindex $vlastins($v) $oa]
789     lset vdownptr($v) $oa $na
790     lset vlastins($v) $oa 0
791     lappend vupptr($v) $oa
792     lappend vleftptr($v) 0
793     lappend vbackptr($v) 0
794     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
795         lset vupptr($v) $b $na
796     }
797     if {[string compare $otok $vtokmod($v)] <= 0} {
798         modify_arc $v $oa
799     }
800 }
801
802 proc renumbervarc {a v} {
803     global parents children varctok varcstart varccommits
804     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
805
806     set t1 [clock clicks -milliseconds]
807     set todo {}
808     set isrelated($a) 1
809     set kidchanged($a) 1
810     set ntot 0
811     while {$a != 0} {
812         if {[info exists isrelated($a)]} {
813             lappend todo $a
814             set id [lindex $varccommits($v,$a) end]
815             foreach p $parents($v,$id) {
816                 if {[info exists varcid($v,$p)]} {
817                     set isrelated($varcid($v,$p)) 1
818                 }
819             }
820         }
821         incr ntot
822         set b [lindex $vdownptr($v) $a]
823         if {$b == 0} {
824             while {$a != 0} {
825                 set b [lindex $vleftptr($v) $a]
826                 if {$b != 0} break
827                 set a [lindex $vupptr($v) $a]
828             }
829         }
830         set a $b
831     }
832     foreach a $todo {
833         if {![info exists kidchanged($a)]} continue
834         set id [lindex $varcstart($v) $a]
835         if {[llength $children($v,$id)] > 1} {
836             set children($v,$id) [lsort -command [list vtokcmp $v] \
837                                       $children($v,$id)]
838         }
839         set oldtok [lindex $varctok($v) $a]
840         if {!$vdatemode($v)} {
841             set tok {}
842         } else {
843             set tok $oldtok
844         }
845         set ka 0
846         set kid [last_real_child $v,$id]
847         if {$kid ne {}} {
848             set k $varcid($v,$kid)
849             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
850                 set ki $kid
851                 set ka $k
852                 set tok [lindex $varctok($v) $k]
853             }
854         }
855         if {$ka != 0} {
856             set i [lsearch -exact $parents($v,$ki) $id]
857             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
858             append tok [strrep $j]
859         }
860         if {$tok eq $oldtok} {
861             continue
862         }
863         set id [lindex $varccommits($v,$a) end]
864         foreach p $parents($v,$id) {
865             if {[info exists varcid($v,$p)]} {
866                 set kidchanged($varcid($v,$p)) 1
867             } else {
868                 set sortkids($p) 1
869             }
870         }
871         lset varctok($v) $a $tok
872         set b [lindex $vupptr($v) $a]
873         if {$b != $ka} {
874             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
875                 modify_arc $v $ka
876             }
877             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
878                 modify_arc $v $b
879             }
880             set c [lindex $vbackptr($v) $a]
881             set d [lindex $vleftptr($v) $a]
882             if {$c == 0} {
883                 lset vdownptr($v) $b $d
884             } else {
885                 lset vleftptr($v) $c $d
886             }
887             if {$d != 0} {
888                 lset vbackptr($v) $d $c
889             }
890             if {[lindex $vlastins($v) $b] == $a} {
891                 lset vlastins($v) $b $c
892             }
893             lset vupptr($v) $a $ka
894             set c [lindex $vlastins($v) $ka]
895             if {$c == 0 || \
896                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
897                 set c $ka
898                 set b [lindex $vdownptr($v) $ka]
899             } else {
900                 set b [lindex $vleftptr($v) $c]
901             }
902             while {$b != 0 && \
903                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
904                 set c $b
905                 set b [lindex $vleftptr($v) $c]
906             }
907             if {$c == $ka} {
908                 lset vdownptr($v) $ka $a
909                 lset vbackptr($v) $a 0
910             } else {
911                 lset vleftptr($v) $c $a
912                 lset vbackptr($v) $a $c
913             }
914             lset vleftptr($v) $a $b
915             if {$b != 0} {
916                 lset vbackptr($v) $b $a
917             }
918             lset vlastins($v) $ka $a
919         }
920     }
921     foreach id [array names sortkids] {
922         if {[llength $children($v,$id)] > 1} {
923             set children($v,$id) [lsort -command [list vtokcmp $v] \
924                                       $children($v,$id)]
925         }
926     }
927     set t2 [clock clicks -milliseconds]
928     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
929 }
930
931 # Fix up the graph after we have found out that in view $v,
932 # $p (a commit that we have already seen) is actually the parent
933 # of the last commit in arc $a.
934 proc fix_reversal {p a v} {
935     global varcid varcstart varctok vupptr
936
937     set pa $varcid($v,$p)
938     if {$p ne [lindex $varcstart($v) $pa]} {
939         splitvarc $p $v
940         set pa $varcid($v,$p)
941     }
942     # seeds always need to be renumbered
943     if {[lindex $vupptr($v) $pa] == 0 ||
944         [string compare [lindex $varctok($v) $a] \
945              [lindex $varctok($v) $pa]] > 0} {
946         renumbervarc $pa $v
947     }
948 }
949
950 proc insertrow {id p v} {
951     global cmitlisted children parents varcid varctok vtokmod
952     global varccommits ordertok commitidx numcommits curview
953     global targetid targetrow vshortids
954
955     readcommit $id
956     set vid $v,$id
957     set cmitlisted($vid) 1
958     set children($vid) {}
959     set parents($vid) [list $p]
960     set a [newvarc $v $id]
961     set varcid($vid) $a
962     lappend vshortids($v,[string range $id 0 3]) $id
963     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
964         modify_arc $v $a
965     }
966     lappend varccommits($v,$a) $id
967     set vp $v,$p
968     if {[llength [lappend children($vp) $id]] > 1} {
969         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
970         unset -nocomplain ordertok
971     }
972     fix_reversal $p $a $v
973     incr commitidx($v)
974     if {$v == $curview} {
975         set numcommits $commitidx($v)
976         setcanvscroll
977         if {[info exists targetid]} {
978             if {![comes_before $targetid $p]} {
979                 incr targetrow
980             }
981         }
982     }
983 }
984
985 proc insertfakerow {id p} {
986     global varcid varccommits parents children cmitlisted
987     global commitidx varctok vtokmod targetid targetrow curview numcommits
988
989     set v $curview
990     set a $varcid($v,$p)
991     set i [lsearch -exact $varccommits($v,$a) $p]
992     if {$i < 0} {
993         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
994         return
995     }
996     set children($v,$id) {}
997     set parents($v,$id) [list $p]
998     set varcid($v,$id) $a
999     lappend children($v,$p) $id
1000     set cmitlisted($v,$id) 1
1001     set numcommits [incr commitidx($v)]
1002     # note we deliberately don't update varcstart($v) even if $i == 0
1003     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1004     modify_arc $v $a $i
1005     if {[info exists targetid]} {
1006         if {![comes_before $targetid $p]} {
1007             incr targetrow
1008         }
1009     }
1010     setcanvscroll
1011     drawvisible
1012 }
1013
1014 proc removefakerow {id} {
1015     global varcid varccommits parents children commitidx
1016     global varctok vtokmod cmitlisted currentid selectedline
1017     global targetid curview numcommits
1018
1019     set v $curview
1020     if {[llength $parents($v,$id)] != 1} {
1021         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1022         return
1023     }
1024     set p [lindex $parents($v,$id) 0]
1025     set a $varcid($v,$id)
1026     set i [lsearch -exact $varccommits($v,$a) $id]
1027     if {$i < 0} {
1028         puts "oops: removefakerow can't find [shortids $id] on arc $a"
1029         return
1030     }
1031     unset varcid($v,$id)
1032     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1033     unset parents($v,$id)
1034     unset children($v,$id)
1035     unset cmitlisted($v,$id)
1036     set numcommits [incr commitidx($v) -1]
1037     set j [lsearch -exact $children($v,$p) $id]
1038     if {$j >= 0} {
1039         set children($v,$p) [lreplace $children($v,$p) $j $j]
1040     }
1041     modify_arc $v $a $i
1042     if {[info exist currentid] && $id eq $currentid} {
1043         unset currentid
1044         set selectedline {}
1045     }
1046     if {[info exists targetid] && $targetid eq $id} {
1047         set targetid $p
1048     }
1049     setcanvscroll
1050     drawvisible
1051 }
1052
1053 proc real_children {vp} {
1054     global children nullid nullid2
1055
1056     set kids {}
1057     foreach id $children($vp) {
1058         if {$id ne $nullid && $id ne $nullid2} {
1059             lappend kids $id
1060         }
1061     }
1062     return $kids
1063 }
1064
1065 proc first_real_child {vp} {
1066     global children nullid nullid2
1067
1068     foreach id $children($vp) {
1069         if {$id ne $nullid && $id ne $nullid2} {
1070             return $id
1071         }
1072     }
1073     return {}
1074 }
1075
1076 proc last_real_child {vp} {
1077     global children nullid nullid2
1078
1079     set kids $children($vp)
1080     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1081         set id [lindex $kids $i]
1082         if {$id ne $nullid && $id ne $nullid2} {
1083             return $id
1084         }
1085     }
1086     return {}
1087 }
1088
1089 proc vtokcmp {v a b} {
1090     global varctok varcid
1091
1092     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1093                 [lindex $varctok($v) $varcid($v,$b)]]
1094 }
1095
1096 # This assumes that if lim is not given, the caller has checked that
1097 # arc a's token is less than $vtokmod($v)
1098 proc modify_arc {v a {lim {}}} {
1099     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1100
1101     if {$lim ne {}} {
1102         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1103         if {$c > 0} return
1104         if {$c == 0} {
1105             set r [lindex $varcrow($v) $a]
1106             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1107         }
1108     }
1109     set vtokmod($v) [lindex $varctok($v) $a]
1110     set varcmod($v) $a
1111     if {$v == $curview} {
1112         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1113             set a [lindex $vupptr($v) $a]
1114             set lim {}
1115         }
1116         set r 0
1117         if {$a != 0} {
1118             if {$lim eq {}} {
1119                 set lim [llength $varccommits($v,$a)]
1120             }
1121             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1122         }
1123         set vrowmod($v) $r
1124         undolayout $r
1125     }
1126 }
1127
1128 proc update_arcrows {v} {
1129     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1130     global varcid vrownum varcorder varcix varccommits
1131     global vupptr vdownptr vleftptr varctok
1132     global displayorder parentlist curview cached_commitrow
1133
1134     if {$vrowmod($v) == $commitidx($v)} return
1135     if {$v == $curview} {
1136         if {[llength $displayorder] > $vrowmod($v)} {
1137             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1138             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1139         }
1140         unset -nocomplain cached_commitrow
1141     }
1142     set narctot [expr {[llength $varctok($v)] - 1}]
1143     set a $varcmod($v)
1144     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1145         # go up the tree until we find something that has a row number,
1146         # or we get to a seed
1147         set a [lindex $vupptr($v) $a]
1148     }
1149     if {$a == 0} {
1150         set a [lindex $vdownptr($v) 0]
1151         if {$a == 0} return
1152         set vrownum($v) {0}
1153         set varcorder($v) [list $a]
1154         lset varcix($v) $a 0
1155         lset varcrow($v) $a 0
1156         set arcn 0
1157         set row 0
1158     } else {
1159         set arcn [lindex $varcix($v) $a]
1160         if {[llength $vrownum($v)] > $arcn + 1} {
1161             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1162             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1163         }
1164         set row [lindex $varcrow($v) $a]
1165     }
1166     while {1} {
1167         set p $a
1168         incr row [llength $varccommits($v,$a)]
1169         # go down if possible
1170         set b [lindex $vdownptr($v) $a]
1171         if {$b == 0} {
1172             # if not, go left, or go up until we can go left
1173             while {$a != 0} {
1174                 set b [lindex $vleftptr($v) $a]
1175                 if {$b != 0} break
1176                 set a [lindex $vupptr($v) $a]
1177             }
1178             if {$a == 0} break
1179         }
1180         set a $b
1181         incr arcn
1182         lappend vrownum($v) $row
1183         lappend varcorder($v) $a
1184         lset varcix($v) $a $arcn
1185         lset varcrow($v) $a $row
1186     }
1187     set vtokmod($v) [lindex $varctok($v) $p]
1188     set varcmod($v) $p
1189     set vrowmod($v) $row
1190     if {[info exists currentid]} {
1191         set selectedline [rowofcommit $currentid]
1192     }
1193 }
1194
1195 # Test whether view $v contains commit $id
1196 proc commitinview {id v} {
1197     global varcid
1198
1199     return [info exists varcid($v,$id)]
1200 }
1201
1202 # Return the row number for commit $id in the current view
1203 proc rowofcommit {id} {
1204     global varcid varccommits varcrow curview cached_commitrow
1205     global varctok vtokmod
1206
1207     set v $curview
1208     if {![info exists varcid($v,$id)]} {
1209         puts "oops rowofcommit no arc for [shortids $id]"
1210         return {}
1211     }
1212     set a $varcid($v,$id)
1213     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1214         update_arcrows $v
1215     }
1216     if {[info exists cached_commitrow($id)]} {
1217         return $cached_commitrow($id)
1218     }
1219     set i [lsearch -exact $varccommits($v,$a) $id]
1220     if {$i < 0} {
1221         puts "oops didn't find commit [shortids $id] in arc $a"
1222         return {}
1223     }
1224     incr i [lindex $varcrow($v) $a]
1225     set cached_commitrow($id) $i
1226     return $i
1227 }
1228
1229 # Returns 1 if a is on an earlier row than b, otherwise 0
1230 proc comes_before {a b} {
1231     global varcid varctok curview
1232
1233     set v $curview
1234     if {$a eq $b || ![info exists varcid($v,$a)] || \
1235             ![info exists varcid($v,$b)]} {
1236         return 0
1237     }
1238     if {$varcid($v,$a) != $varcid($v,$b)} {
1239         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1240                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1241     }
1242     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1243 }
1244
1245 proc bsearch {l elt} {
1246     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1247         return 0
1248     }
1249     set lo 0
1250     set hi [llength $l]
1251     while {$hi - $lo > 1} {
1252         set mid [expr {int(($lo + $hi) / 2)}]
1253         set t [lindex $l $mid]
1254         if {$elt < $t} {
1255             set hi $mid
1256         } elseif {$elt > $t} {
1257             set lo $mid
1258         } else {
1259             return $mid
1260         }
1261     }
1262     return $lo
1263 }
1264
1265 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1266 proc make_disporder {start end} {
1267     global vrownum curview commitidx displayorder parentlist
1268     global varccommits varcorder parents vrowmod varcrow
1269     global d_valid_start d_valid_end
1270
1271     if {$end > $vrowmod($curview)} {
1272         update_arcrows $curview
1273     }
1274     set ai [bsearch $vrownum($curview) $start]
1275     set start [lindex $vrownum($curview) $ai]
1276     set narc [llength $vrownum($curview)]
1277     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1278         set a [lindex $varcorder($curview) $ai]
1279         set l [llength $displayorder]
1280         set al [llength $varccommits($curview,$a)]
1281         if {$l < $r + $al} {
1282             if {$l < $r} {
1283                 set pad [ntimes [expr {$r - $l}] {}]
1284                 set displayorder [concat $displayorder $pad]
1285                 set parentlist [concat $parentlist $pad]
1286             } elseif {$l > $r} {
1287                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1288                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1289             }
1290             foreach id $varccommits($curview,$a) {
1291                 lappend displayorder $id
1292                 lappend parentlist $parents($curview,$id)
1293             }
1294         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1295             set i $r
1296             foreach id $varccommits($curview,$a) {
1297                 lset displayorder $i $id
1298                 lset parentlist $i $parents($curview,$id)
1299                 incr i
1300             }
1301         }
1302         incr r $al
1303     }
1304 }
1305
1306 proc commitonrow {row} {
1307     global displayorder
1308
1309     set id [lindex $displayorder $row]
1310     if {$id eq {}} {
1311         make_disporder $row [expr {$row + 1}]
1312         set id [lindex $displayorder $row]
1313     }
1314     return $id
1315 }
1316
1317 proc closevarcs {v} {
1318     global varctok varccommits varcid parents children
1319     global cmitlisted commitidx vtokmod curview numcommits
1320
1321     set missing_parents 0
1322     set scripts {}
1323     set narcs [llength $varctok($v)]
1324     for {set a 1} {$a < $narcs} {incr a} {
1325         set id [lindex $varccommits($v,$a) end]
1326         foreach p $parents($v,$id) {
1327             if {[info exists varcid($v,$p)]} continue
1328             # add p as a new commit
1329             incr missing_parents
1330             set cmitlisted($v,$p) 0
1331             set parents($v,$p) {}
1332             if {[llength $children($v,$p)] == 1 &&
1333                 [llength $parents($v,$id)] == 1} {
1334                 set b $a
1335             } else {
1336                 set b [newvarc $v $p]
1337             }
1338             set varcid($v,$p) $b
1339             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1340                 modify_arc $v $b
1341             }
1342             lappend varccommits($v,$b) $p
1343             incr commitidx($v)
1344             if {$v == $curview} {
1345                 set numcommits $commitidx($v)
1346             }
1347             set scripts [check_interest $p $scripts]
1348         }
1349     }
1350     if {$missing_parents > 0} {
1351         foreach s $scripts {
1352             eval $s
1353         }
1354     }
1355 }
1356
1357 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1358 # Assumes we already have an arc for $rwid.
1359 proc rewrite_commit {v id rwid} {
1360     global children parents varcid varctok vtokmod varccommits
1361
1362     foreach ch $children($v,$id) {
1363         # make $rwid be $ch's parent in place of $id
1364         set i [lsearch -exact $parents($v,$ch) $id]
1365         if {$i < 0} {
1366             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1367         }
1368         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1369         # add $ch to $rwid's children and sort the list if necessary
1370         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1371             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1372                                         $children($v,$rwid)]
1373         }
1374         # fix the graph after joining $id to $rwid
1375         set a $varcid($v,$ch)
1376         fix_reversal $rwid $a $v
1377         # parentlist is wrong for the last element of arc $a
1378         # even if displayorder is right, hence the 3rd arg here
1379         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1380     }
1381 }
1382
1383 # Mechanism for registering a command to be executed when we come
1384 # across a particular commit.  To handle the case when only the
1385 # prefix of the commit is known, the commitinterest array is now
1386 # indexed by the first 4 characters of the ID.  Each element is a
1387 # list of id, cmd pairs.
1388 proc interestedin {id cmd} {
1389     global commitinterest
1390
1391     lappend commitinterest([string range $id 0 3]) $id $cmd
1392 }
1393
1394 proc check_interest {id scripts} {
1395     global commitinterest
1396
1397     set prefix [string range $id 0 3]
1398     if {[info exists commitinterest($prefix)]} {
1399         set newlist {}
1400         foreach {i script} $commitinterest($prefix) {
1401             if {[string match "$i*" $id]} {
1402                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1403             } else {
1404                 lappend newlist $i $script
1405             }
1406         }
1407         if {$newlist ne {}} {
1408             set commitinterest($prefix) $newlist
1409         } else {
1410             unset commitinterest($prefix)
1411         }
1412     }
1413     return $scripts
1414 }
1415
1416 proc getcommitlines {fd inst view updating}  {
1417     global cmitlisted leftover
1418     global commitidx commitdata vdatemode
1419     global parents children curview hlview
1420     global idpending ordertok
1421     global varccommits varcid varctok vtokmod vfilelimit vshortids
1422
1423     set stuff [read $fd 500000]
1424     # git log doesn't terminate the last commit with a null...
1425     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1426         set stuff "\0"
1427     }
1428     if {$stuff == {}} {
1429         if {![eof $fd]} {
1430             return 1
1431         }
1432         global commfd viewcomplete viewactive viewname
1433         global viewinstances
1434         unset commfd($inst)
1435         set i [lsearch -exact $viewinstances($view) $inst]
1436         if {$i >= 0} {
1437             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1438         }
1439         # set it blocking so we wait for the process to terminate
1440         fconfigure $fd -blocking 1
1441         if {[catch {close $fd} err]} {
1442             set fv {}
1443             if {$view != $curview} {
1444                 set fv " for the \"$viewname($view)\" view"
1445             }
1446             if {[string range $err 0 4] == "usage"} {
1447                 set err "Gitk: error reading commits$fv:\
1448                         bad arguments to git log."
1449                 if {$viewname($view) eq [mc "Command line"]} {
1450                     append err \
1451                         "  (Note: arguments to gitk are passed to git log\
1452                          to allow selection of commits to be displayed.)"
1453                 }
1454             } else {
1455                 set err "Error reading commits$fv: $err"
1456             }
1457             error_popup $err
1458         }
1459         if {[incr viewactive($view) -1] <= 0} {
1460             set viewcomplete($view) 1
1461             # Check if we have seen any ids listed as parents that haven't
1462             # appeared in the list
1463             closevarcs $view
1464             notbusy $view
1465         }
1466         if {$view == $curview} {
1467             run chewcommits
1468         }
1469         return 0
1470     }
1471     set start 0
1472     set gotsome 0
1473     set scripts {}
1474     while 1 {
1475         set i [string first "\0" $stuff $start]
1476         if {$i < 0} {
1477             append leftover($inst) [string range $stuff $start end]
1478             break
1479         }
1480         if {$start == 0} {
1481             set cmit $leftover($inst)
1482             append cmit [string range $stuff 0 [expr {$i - 1}]]
1483             set leftover($inst) {}
1484         } else {
1485             set cmit [string range $stuff $start [expr {$i - 1}]]
1486         }
1487         set start [expr {$i + 1}]
1488         set j [string first "\n" $cmit]
1489         set ok 0
1490         set listed 1
1491         if {$j >= 0 && [string match "commit *" $cmit]} {
1492             set ids [string range $cmit 7 [expr {$j - 1}]]
1493             if {[string match {[-^<>]*} $ids]} {
1494                 switch -- [string index $ids 0] {
1495                     "-" {set listed 0}
1496                     "^" {set listed 2}
1497                     "<" {set listed 3}
1498                     ">" {set listed 4}
1499                 }
1500                 set ids [string range $ids 1 end]
1501             }
1502             set ok 1
1503             foreach id $ids {
1504                 if {[string length $id] != 40} {
1505                     set ok 0
1506                     break
1507                 }
1508             }
1509         }
1510         if {!$ok} {
1511             set shortcmit $cmit
1512             if {[string length $shortcmit] > 80} {
1513                 set shortcmit "[string range $shortcmit 0 80]..."
1514             }
1515             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1516             exit 1
1517         }
1518         set id [lindex $ids 0]
1519         set vid $view,$id
1520
1521         lappend vshortids($view,[string range $id 0 3]) $id
1522
1523         if {!$listed && $updating && ![info exists varcid($vid)] &&
1524             $vfilelimit($view) ne {}} {
1525             # git log doesn't rewrite parents for unlisted commits
1526             # when doing path limiting, so work around that here
1527             # by working out the rewritten parent with git rev-list
1528             # and if we already know about it, using the rewritten
1529             # parent as a substitute parent for $id's children.
1530             if {![catch {
1531                 set rwid [exec git rev-list --first-parent --max-count=1 \
1532                               $id -- $vfilelimit($view)]
1533             }]} {
1534                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1535                     # use $rwid in place of $id
1536                     rewrite_commit $view $id $rwid
1537                     continue
1538                 }
1539             }
1540         }
1541
1542         set a 0
1543         if {[info exists varcid($vid)]} {
1544             if {$cmitlisted($vid) || !$listed} continue
1545             set a $varcid($vid)
1546         }
1547         if {$listed} {
1548             set olds [lrange $ids 1 end]
1549         } else {
1550             set olds {}
1551         }
1552         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1553         set cmitlisted($vid) $listed
1554         set parents($vid) $olds
1555         if {![info exists children($vid)]} {
1556             set children($vid) {}
1557         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1558             set k [lindex $children($vid) 0]
1559             if {[llength $parents($view,$k)] == 1 &&
1560                 (!$vdatemode($view) ||
1561                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1562                 set a $varcid($view,$k)
1563             }
1564         }
1565         if {$a == 0} {
1566             # new arc
1567             set a [newvarc $view $id]
1568         }
1569         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1570             modify_arc $view $a
1571         }
1572         if {![info exists varcid($vid)]} {
1573             set varcid($vid) $a
1574             lappend varccommits($view,$a) $id
1575             incr commitidx($view)
1576         }
1577
1578         set i 0
1579         foreach p $olds {
1580             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1581                 set vp $view,$p
1582                 if {[llength [lappend children($vp) $id]] > 1 &&
1583                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1584                     set children($vp) [lsort -command [list vtokcmp $view] \
1585                                            $children($vp)]
1586                     unset -nocomplain ordertok
1587                 }
1588                 if {[info exists varcid($view,$p)]} {
1589                     fix_reversal $p $a $view
1590                 }
1591             }
1592             incr i
1593         }
1594
1595         set scripts [check_interest $id $scripts]
1596         set gotsome 1
1597     }
1598     if {$gotsome} {
1599         global numcommits hlview
1600
1601         if {$view == $curview} {
1602             set numcommits $commitidx($view)
1603             run chewcommits
1604         }
1605         if {[info exists hlview] && $view == $hlview} {
1606             # we never actually get here...
1607             run vhighlightmore
1608         }
1609         foreach s $scripts {
1610             eval $s
1611         }
1612     }
1613     return 2
1614 }
1615
1616 proc chewcommits {} {
1617     global curview hlview viewcomplete
1618     global pending_select
1619
1620     layoutmore
1621     if {$viewcomplete($curview)} {
1622         global commitidx varctok
1623         global numcommits startmsecs
1624
1625         if {[info exists pending_select]} {
1626             update
1627             reset_pending_select {}
1628
1629             if {[commitinview $pending_select $curview]} {
1630                 selectline [rowofcommit $pending_select] 1
1631             } else {
1632                 set row [first_real_row]
1633                 selectline $row 1
1634             }
1635         }
1636         if {$commitidx($curview) > 0} {
1637             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1638             #puts "overall $ms ms for $numcommits commits"
1639             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1640         } else {
1641             show_status [mc "No commits selected"]
1642         }
1643         notbusy layout
1644     }
1645     return 0
1646 }
1647
1648 proc do_readcommit {id} {
1649     global tclencoding
1650
1651     # Invoke git-log to handle automatic encoding conversion
1652     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1653     # Read the results using i18n.logoutputencoding
1654     fconfigure $fd -translation lf -eofchar {}
1655     if {$tclencoding != {}} {
1656         fconfigure $fd -encoding $tclencoding
1657     }
1658     set contents [read $fd]
1659     close $fd
1660     # Remove the heading line
1661     regsub {^commit [0-9a-f]+\n} $contents {} contents
1662
1663     return $contents
1664 }
1665
1666 proc readcommit {id} {
1667     if {[catch {set contents [do_readcommit $id]}]} return
1668     parsecommit $id $contents 1
1669 }
1670
1671 proc parsecommit {id contents listed} {
1672     global commitinfo
1673
1674     set inhdr 1
1675     set comment {}
1676     set headline {}
1677     set auname {}
1678     set audate {}
1679     set comname {}
1680     set comdate {}
1681     set hdrend [string first "\n\n" $contents]
1682     if {$hdrend < 0} {
1683         # should never happen...
1684         set hdrend [string length $contents]
1685     }
1686     set header [string range $contents 0 [expr {$hdrend - 1}]]
1687     set comment [string range $contents [expr {$hdrend + 2}] end]
1688     foreach line [split $header "\n"] {
1689         set line [split $line " "]
1690         set tag [lindex $line 0]
1691         if {$tag == "author"} {
1692             set audate [lrange $line end-1 end]
1693             set auname [join [lrange $line 1 end-2] " "]
1694         } elseif {$tag == "committer"} {
1695             set comdate [lrange $line end-1 end]
1696             set comname [join [lrange $line 1 end-2] " "]
1697         }
1698     }
1699     set headline {}
1700     # take the first non-blank line of the comment as the headline
1701     set headline [string trimleft $comment]
1702     set i [string first "\n" $headline]
1703     if {$i >= 0} {
1704         set headline [string range $headline 0 $i]
1705     }
1706     set headline [string trimright $headline]
1707     set i [string first "\r" $headline]
1708     if {$i >= 0} {
1709         set headline [string trimright [string range $headline 0 $i]]
1710     }
1711     if {!$listed} {
1712         # git log indents the comment by 4 spaces;
1713         # if we got this via git cat-file, add the indentation
1714         set newcomment {}
1715         foreach line [split $comment "\n"] {
1716             append newcomment "    "
1717             append newcomment $line
1718             append newcomment "\n"
1719         }
1720         set comment $newcomment
1721     }
1722     set hasnote [string first "\nNotes:\n" $contents]
1723     set diff ""
1724     # If there is diff output shown in the git-log stream, split it
1725     # out.  But get rid of the empty line that always precedes the
1726     # diff.
1727     set i [string first "\n\ndiff" $comment]
1728     if {$i >= 0} {
1729         set diff [string range $comment $i+1 end]
1730         set comment [string range $comment 0 $i-1]
1731     }
1732     set commitinfo($id) [list $headline $auname $audate \
1733                              $comname $comdate $comment $hasnote $diff]
1734 }
1735
1736 proc getcommit {id} {
1737     global commitdata commitinfo
1738
1739     if {[info exists commitdata($id)]} {
1740         parsecommit $id $commitdata($id) 1
1741     } else {
1742         readcommit $id
1743         if {![info exists commitinfo($id)]} {
1744             set commitinfo($id) [list [mc "No commit information available"]]
1745         }
1746     }
1747     return 1
1748 }
1749
1750 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1751 # and are present in the current view.
1752 # This is fairly slow...
1753 proc longid {prefix} {
1754     global varcid curview vshortids
1755
1756     set ids {}
1757     if {[string length $prefix] >= 4} {
1758         set vshortid $curview,[string range $prefix 0 3]
1759         if {[info exists vshortids($vshortid)]} {
1760             foreach id $vshortids($vshortid) {
1761                 if {[string match "$prefix*" $id]} {
1762                     if {[lsearch -exact $ids $id] < 0} {
1763                         lappend ids $id
1764                         if {[llength $ids] >= 2} break
1765                     }
1766                 }
1767             }
1768         }
1769     } else {
1770         foreach match [array names varcid "$curview,$prefix*"] {
1771             lappend ids [lindex [split $match ","] 1]
1772             if {[llength $ids] >= 2} break
1773         }
1774     }
1775     return $ids
1776 }
1777
1778 proc readrefs {} {
1779     global tagids idtags headids idheads tagobjid
1780     global otherrefids idotherrefs mainhead mainheadid
1781     global selecthead selectheadid
1782     global hideremotes
1783
1784     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1785         unset -nocomplain $v
1786     }
1787     set refd [open [list | git show-ref -d] r]
1788     while {[gets $refd line] >= 0} {
1789         if {[string index $line 40] ne " "} continue
1790         set id [string range $line 0 39]
1791         set ref [string range $line 41 end]
1792         if {![string match "refs/*" $ref]} continue
1793         set name [string range $ref 5 end]
1794         if {[string match "remotes/*" $name]} {
1795             if {![string match "*/HEAD" $name] && !$hideremotes} {
1796                 set headids($name) $id
1797                 lappend idheads($id) $name
1798             }
1799         } elseif {[string match "heads/*" $name]} {
1800             set name [string range $name 6 end]
1801             set headids($name) $id
1802             lappend idheads($id) $name
1803         } elseif {[string match "tags/*" $name]} {
1804             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1805             # which is what we want since the former is the commit ID
1806             set name [string range $name 5 end]
1807             if {[string match "*^{}" $name]} {
1808                 set name [string range $name 0 end-3]
1809             } else {
1810                 set tagobjid($name) $id
1811             }
1812             set tagids($name) $id
1813             lappend idtags($id) $name
1814         } else {
1815             set otherrefids($name) $id
1816             lappend idotherrefs($id) $name
1817         }
1818     }
1819     catch {close $refd}
1820     set mainhead {}
1821     set mainheadid {}
1822     catch {
1823         set mainheadid [exec git rev-parse HEAD]
1824         set thehead [exec git symbolic-ref HEAD]
1825         if {[string match "refs/heads/*" $thehead]} {
1826             set mainhead [string range $thehead 11 end]
1827         }
1828     }
1829     set selectheadid {}
1830     if {$selecthead ne {}} {
1831         catch {
1832             set selectheadid [exec git rev-parse --verify $selecthead]
1833         }
1834     }
1835 }
1836
1837 # skip over fake commits
1838 proc first_real_row {} {
1839     global nullid nullid2 numcommits
1840
1841     for {set row 0} {$row < $numcommits} {incr row} {
1842         set id [commitonrow $row]
1843         if {$id ne $nullid && $id ne $nullid2} {
1844             break
1845         }
1846     }
1847     return $row
1848 }
1849
1850 # update things for a head moved to a child of its previous location
1851 proc movehead {id name} {
1852     global headids idheads
1853
1854     removehead $headids($name) $name
1855     set headids($name) $id
1856     lappend idheads($id) $name
1857 }
1858
1859 # update things when a head has been removed
1860 proc removehead {id name} {
1861     global headids idheads
1862
1863     if {$idheads($id) eq $name} {
1864         unset idheads($id)
1865     } else {
1866         set i [lsearch -exact $idheads($id) $name]
1867         if {$i >= 0} {
1868             set idheads($id) [lreplace $idheads($id) $i $i]
1869         }
1870     }
1871     unset headids($name)
1872 }
1873
1874 proc ttk_toplevel {w args} {
1875     global use_ttk
1876     eval [linsert $args 0 ::toplevel $w]
1877     if {$use_ttk} {
1878         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1879     }
1880     return $w
1881 }
1882
1883 proc make_transient {window origin} {
1884     global have_tk85
1885
1886     # In MacOS Tk 8.4 transient appears to work by setting
1887     # overrideredirect, which is utterly useless, since the
1888     # windows get no border, and are not even kept above
1889     # the parent.
1890     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1891
1892     wm transient $window $origin
1893
1894     # Windows fails to place transient windows normally, so
1895     # schedule a callback to center them on the parent.
1896     if {[tk windowingsystem] eq {win32}} {
1897         after idle [list tk::PlaceWindow $window widget $origin]
1898     }
1899 }
1900
1901 proc show_error {w top msg} {
1902     global NS
1903     if {![info exists NS]} {set NS ""}
1904     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1905     message $w.m -text $msg -justify center -aspect 400
1906     pack $w.m -side top -fill x -padx 20 -pady 20
1907     ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1908     pack $w.ok -side bottom -fill x
1909     bind $top <Visibility> "grab $top; focus $top"
1910     bind $top <Key-Return> "destroy $top"
1911     bind $top <Key-space>  "destroy $top"
1912     bind $top <Key-Escape> "destroy $top"
1913     tkwait window $top
1914 }
1915
1916 proc error_popup {msg {owner .}} {
1917     if {[tk windowingsystem] eq "win32"} {
1918         tk_messageBox -icon error -type ok -title [wm title .] \
1919             -parent $owner -message $msg
1920     } else {
1921         set w .error
1922         ttk_toplevel $w
1923         make_transient $w $owner
1924         show_error $w $w $msg
1925     }
1926 }
1927
1928 proc confirm_popup {msg {owner .}} {
1929     global confirm_ok NS
1930     set confirm_ok 0
1931     set w .confirm
1932     ttk_toplevel $w
1933     make_transient $w $owner
1934     message $w.m -text $msg -justify center -aspect 400
1935     pack $w.m -side top -fill x -padx 20 -pady 20
1936     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1937     pack $w.ok -side left -fill x
1938     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1939     pack $w.cancel -side right -fill x
1940     bind $w <Visibility> "grab $w; focus $w"
1941     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1942     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1943     bind $w <Key-Escape> "destroy $w"
1944     tk::PlaceWindow $w widget $owner
1945     tkwait window $w
1946     return $confirm_ok
1947 }
1948
1949 proc setoptions {} {
1950     global use_ttk
1951
1952     if {[tk windowingsystem] ne "win32"} {
1953         option add *Panedwindow.showHandle 1 startupFile
1954         option add *Panedwindow.sashRelief raised startupFile
1955         if {[tk windowingsystem] ne "aqua"} {
1956             option add *Menu.font uifont startupFile
1957         }
1958     } else {
1959         option add *Menu.TearOff 0 startupFile
1960     }
1961     option add *Button.font uifont startupFile
1962     option add *Checkbutton.font uifont startupFile
1963     option add *Radiobutton.font uifont startupFile
1964     option add *Menubutton.font uifont startupFile
1965     option add *Label.font uifont startupFile
1966     option add *Message.font uifont startupFile
1967     option add *Entry.font textfont startupFile
1968     option add *Text.font textfont startupFile
1969     option add *Labelframe.font uifont startupFile
1970     option add *Spinbox.font textfont startupFile
1971     option add *Listbox.font mainfont startupFile
1972 }
1973
1974 proc setttkstyle {} {
1975     eval font configure TkDefaultFont [fontflags mainfont]
1976     eval font configure TkTextFont [fontflags textfont]
1977     eval font configure TkHeadingFont [fontflags mainfont]
1978     eval font configure TkCaptionFont [fontflags mainfont] -weight bold
1979     eval font configure TkTooltipFont [fontflags uifont]
1980     eval font configure TkFixedFont   [fontflags textfont]
1981     eval font configure TkIconFont    [fontflags uifont]
1982     eval font configure TkMenuFont    [fontflags uifont]
1983     eval font configure TkSmallCaptionFont [fontflags uifont]
1984 }
1985
1986 # Make a menu and submenus.
1987 # m is the window name for the menu, items is the list of menu items to add.
1988 # Each item is a list {mc label type description options...}
1989 # mc is ignored; it's so we can put mc there to alert xgettext
1990 # label is the string that appears in the menu
1991 # type is cascade, command or radiobutton (should add checkbutton)
1992 # description depends on type; it's the sublist for cascade, the
1993 # command to invoke for command, or {variable value} for radiobutton
1994 proc makemenu {m items} {
1995     menu $m
1996     if {[tk windowingsystem] eq {aqua}} {
1997         set Meta1 Cmd
1998     } else {
1999         set Meta1 Ctrl
2000     }
2001     foreach i $items {
2002         set name [mc [lindex $i 1]]
2003         set type [lindex $i 2]
2004         set thing [lindex $i 3]
2005         set params [list $type]
2006         if {$name ne {}} {
2007             set u [string first "&" [string map {&& x} $name]]
2008             lappend params -label [string map {&& & & {}} $name]
2009             if {$u >= 0} {
2010                 lappend params -underline $u
2011             }
2012         }
2013         switch -- $type {
2014             "cascade" {
2015                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
2016                 lappend params -menu $m.$submenu
2017             }
2018             "command" {
2019                 lappend params -command $thing
2020             }
2021             "radiobutton" {
2022                 lappend params -variable [lindex $thing 0] \
2023                     -value [lindex $thing 1]
2024             }
2025         }
2026         set tail [lrange $i 4 end]
2027         regsub -all {\yMeta1\y} $tail $Meta1 tail
2028         eval $m add $params $tail
2029         if {$type eq "cascade"} {
2030             makemenu $m.$submenu $thing
2031         }
2032     }
2033 }
2034
2035 # translate string and remove ampersands
2036 proc mca {str} {
2037     return [string map {&& & & {}} [mc $str]]
2038 }
2039
2040 proc cleardropsel {w} {
2041     $w selection clear
2042 }
2043 proc makedroplist {w varname args} {
2044     global use_ttk
2045     if {$use_ttk} {
2046         set width 0
2047         foreach label $args {
2048             set cx [string length $label]
2049             if {$cx > $width} {set width $cx}
2050         }
2051         set gm [ttk::combobox $w -width $width -state readonly\
2052                     -textvariable $varname -values $args \
2053                     -exportselection false]
2054         bind $gm <<ComboboxSelected>> [list $gm selection clear]
2055     } else {
2056         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2057     }
2058     return $gm
2059 }
2060
2061 proc makewindow {} {
2062     global canv canv2 canv3 linespc charspc ctext cflist cscroll
2063     global tabstop
2064     global findtype findtypemenu findloc findstring fstring geometry
2065     global entries sha1entry sha1string sha1but
2066     global diffcontextstring diffcontext
2067     global ignorespace
2068     global maincursor textcursor curtextcursor
2069     global rowctxmenu fakerowmenu mergemax wrapcomment
2070     global highlight_files gdttype
2071     global searchstring sstring
2072     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2073     global uifgcolor uifgdisabledcolor
2074     global filesepbgcolor filesepfgcolor
2075     global mergecolors foundbgcolor currentsearchhitbgcolor
2076     global headctxmenu progresscanv progressitem progresscoords statusw
2077     global fprogitem fprogcoord lastprogupdate progupdatepending
2078     global rprogitem rprogcoord rownumsel numcommits
2079     global have_tk85 use_ttk NS
2080     global git_version
2081     global worddiff
2082
2083     # The "mc" arguments here are purely so that xgettext
2084     # sees the following string as needing to be translated
2085     set file {
2086         mc "&File" cascade {
2087             {mc "&Update" command updatecommits -accelerator F5}
2088             {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2089             {mc "Reread re&ferences" command rereadrefs}
2090             {mc "&List references" command showrefs -accelerator F2}
2091             {xx "" separator}
2092             {mc "Start git &gui" command {exec git gui &}}
2093             {xx "" separator}
2094             {mc "&Quit" command doquit -accelerator Meta1-Q}
2095         }}
2096     set edit {
2097         mc "&Edit" cascade {
2098             {mc "&Preferences" command doprefs}
2099         }}
2100     set view {
2101         mc "&View" cascade {
2102             {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2103             {mc "&Edit view..." command editview -state disabled -accelerator F4}
2104             {mc "&Delete view" command delview -state disabled}
2105             {xx "" separator}
2106             {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2107         }}
2108     if {[tk windowingsystem] ne "aqua"} {
2109         set help {
2110         mc "&Help" cascade {
2111             {mc "&About gitk" command about}
2112             {mc "&Key bindings" command keys}
2113         }}
2114         set bar [list $file $edit $view $help]
2115     } else {
2116         proc ::tk::mac::ShowPreferences {} {doprefs}
2117         proc ::tk::mac::Quit {} {doquit}
2118         lset file end [lreplace [lindex $file end] end-1 end]
2119         set apple {
2120         xx "&Apple" cascade {
2121             {mc "&About gitk" command about}
2122             {xx "" separator}
2123         }}
2124         set help {
2125         mc "&Help" cascade {
2126             {mc "&Key bindings" command keys}
2127         }}
2128         set bar [list $apple $file $view $help]
2129     }
2130     makemenu .bar $bar
2131     . configure -menu .bar
2132
2133     if {$use_ttk} {
2134         # cover the non-themed toplevel with a themed frame.
2135         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2136     }
2137
2138     # the gui has upper and lower half, parts of a paned window.
2139     ${NS}::panedwindow .ctop -orient vertical
2140
2141     # possibly use assumed geometry
2142     if {![info exists geometry(pwsash0)]} {
2143         set geometry(topheight) [expr {15 * $linespc}]
2144         set geometry(topwidth) [expr {80 * $charspc}]
2145         set geometry(botheight) [expr {15 * $linespc}]
2146         set geometry(botwidth) [expr {50 * $charspc}]
2147         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2148         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2149     }
2150
2151     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2152     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2153     ${NS}::frame .tf.histframe
2154     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2155     if {!$use_ttk} {
2156         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2157     }
2158
2159     # create three canvases
2160     set cscroll .tf.histframe.csb
2161     set canv .tf.histframe.pwclist.canv
2162     canvas $canv \
2163         -selectbackground $selectbgcolor \
2164         -background $bgcolor -bd 0 \
2165         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2166     .tf.histframe.pwclist add $canv
2167     set canv2 .tf.histframe.pwclist.canv2
2168     canvas $canv2 \
2169         -selectbackground $selectbgcolor \
2170         -background $bgcolor -bd 0 -yscrollincr $linespc
2171     .tf.histframe.pwclist add $canv2
2172     set canv3 .tf.histframe.pwclist.canv3
2173     canvas $canv3 \
2174         -selectbackground $selectbgcolor \
2175         -background $bgcolor -bd 0 -yscrollincr $linespc
2176     .tf.histframe.pwclist add $canv3
2177     if {$use_ttk} {
2178         bind .tf.histframe.pwclist <Map> {
2179             bind %W <Map> {}
2180             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2181             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2182         }
2183     } else {
2184         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2185         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2186     }
2187
2188     # a scroll bar to rule them
2189     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2190     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2191     pack $cscroll -side right -fill y
2192     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2193     lappend bglist $canv $canv2 $canv3
2194     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2195
2196     # we have two button bars at bottom of top frame. Bar 1
2197     ${NS}::frame .tf.bar
2198     ${NS}::frame .tf.lbar -height 15
2199
2200     set sha1entry .tf.bar.sha1
2201     set entries $sha1entry
2202     set sha1but .tf.bar.sha1label
2203     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2204         -command gotocommit -width 8
2205     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2206     pack .tf.bar.sha1label -side left
2207     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2208     trace add variable sha1string write sha1change
2209     pack $sha1entry -side left -pady 2
2210
2211     set bm_left_data {
2212         #define left_width 16
2213         #define left_height 16
2214         static unsigned char left_bits[] = {
2215         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2216         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2217         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2218     }
2219     set bm_right_data {
2220         #define right_width 16
2221         #define right_height 16
2222         static unsigned char right_bits[] = {
2223         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2224         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2225         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2226     }
2227     image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2228     image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2229     image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2230     image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2231
2232     ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2233     if {$use_ttk} {
2234         .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2235     } else {
2236         .tf.bar.leftbut configure -image bm-left
2237     }
2238     pack .tf.bar.leftbut -side left -fill y
2239     ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2240     if {$use_ttk} {
2241         .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2242     } else {
2243         .tf.bar.rightbut configure -image bm-right
2244     }
2245     pack .tf.bar.rightbut -side left -fill y
2246
2247     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2248     set rownumsel {}
2249     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2250         -relief sunken -anchor e
2251     ${NS}::label .tf.bar.rowlabel2 -text "/"
2252     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2253         -relief sunken -anchor e
2254     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2255         -side left
2256     if {!$use_ttk} {
2257         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2258     }
2259     global selectedline
2260     trace add variable selectedline write selectedline_change
2261
2262     # Status label and progress bar
2263     set statusw .tf.bar.status
2264     ${NS}::label $statusw -width 15 -relief sunken
2265     pack $statusw -side left -padx 5
2266     if {$use_ttk} {
2267         set progresscanv [ttk::progressbar .tf.bar.progress]
2268     } else {
2269         set h [expr {[font metrics uifont -linespace] + 2}]
2270         set progresscanv .tf.bar.progress
2271         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2272         set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
2273         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2274         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2275     }
2276     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2277     set progresscoords {0 0}
2278     set fprogcoord 0
2279     set rprogcoord 0
2280     bind $progresscanv <Configure> adjustprogress
2281     set lastprogupdate [clock clicks -milliseconds]
2282     set progupdatepending 0
2283
2284     # build up the bottom bar of upper window
2285     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2286
2287     set bm_down_data {
2288         #define down_width 16
2289         #define down_height 16
2290         static unsigned char down_bits[] = {
2291         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2292         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2293         0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2294         0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2295     }
2296     image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2297     ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2298     .tf.lbar.fnext configure -image bm-down
2299
2300     set bm_up_data {
2301         #define up_width 16
2302         #define up_height 16
2303         static unsigned char up_bits[] = {
2304         0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2305         0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2306         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2307         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2308     }
2309     image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2310     ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2311     .tf.lbar.fprev configure -image bm-up
2312
2313     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2314
2315     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2316         -side left -fill y
2317     set gdttype [mc "containing:"]
2318     set gm [makedroplist .tf.lbar.gdttype gdttype \
2319                 [mc "containing:"] \
2320                 [mc "touching paths:"] \
2321                 [mc "adding/removing string:"] \
2322                 [mc "changing lines matching:"]]
2323     trace add variable gdttype write gdttype_change
2324     pack .tf.lbar.gdttype -side left -fill y
2325
2326     set findstring {}
2327     set fstring .tf.lbar.findstring
2328     lappend entries $fstring
2329     ${NS}::entry $fstring -width 30 -textvariable findstring
2330     trace add variable findstring write find_change
2331     set findtype [mc "Exact"]
2332     set findtypemenu [makedroplist .tf.lbar.findtype \
2333                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2334     trace add variable findtype write findcom_change
2335     set findloc [mc "All fields"]
2336     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2337         [mc "Comments"] [mc "Author"] [mc "Committer"]
2338     trace add variable findloc write find_change
2339     pack .tf.lbar.findloc -side right
2340     pack .tf.lbar.findtype -side right
2341     pack $fstring -side left -expand 1 -fill x
2342
2343     # Finish putting the upper half of the viewer together
2344     pack .tf.lbar -in .tf -side bottom -fill x
2345     pack .tf.bar -in .tf -side bottom -fill x
2346     pack .tf.histframe -fill both -side top -expand 1
2347     .ctop add .tf
2348     if {!$use_ttk} {
2349         .ctop paneconfigure .tf -height $geometry(topheight)
2350         .ctop paneconfigure .tf -width $geometry(topwidth)
2351     }
2352
2353     # now build up the bottom
2354     ${NS}::panedwindow .pwbottom -orient horizontal
2355
2356     # lower left, a text box over search bar, scroll bar to the right
2357     # if we know window height, then that will set the lower text height, otherwise
2358     # we set lower text height which will drive window height
2359     if {[info exists geometry(main)]} {
2360         ${NS}::frame .bleft -width $geometry(botwidth)
2361     } else {
2362         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2363     }
2364     ${NS}::frame .bleft.top
2365     ${NS}::frame .bleft.mid
2366     ${NS}::frame .bleft.bottom
2367
2368     # gap between sub-widgets
2369     set wgap [font measure uifont "i"]
2370
2371     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2372     pack .bleft.top.search -side left -padx 5
2373     set sstring .bleft.top.sstring
2374     set searchstring ""
2375     ${NS}::entry $sstring -width 20 -textvariable searchstring
2376     lappend entries $sstring
2377     trace add variable searchstring write incrsearch
2378     pack $sstring -side left -expand 1 -fill x
2379     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2380         -command changediffdisp -variable diffelide -value {0 0}
2381     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2382         -command changediffdisp -variable diffelide -value {0 1}
2383     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2384         -command changediffdisp -variable diffelide -value {1 0}
2385
2386     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2387     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
2388     spinbox .bleft.mid.diffcontext -width 5 \
2389         -from 0 -increment 1 -to 10000000 \
2390         -validate all -validatecommand "diffcontextvalidate %P" \
2391         -textvariable diffcontextstring
2392     .bleft.mid.diffcontext set $diffcontext
2393     trace add variable diffcontextstring write diffcontextchange
2394     lappend entries .bleft.mid.diffcontext
2395     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
2396     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2397         -command changeignorespace -variable ignorespace
2398     pack .bleft.mid.ignspace -side left -padx 5
2399
2400     set worddiff [mc "Line diff"]
2401     if {[package vcompare $git_version "1.7.2"] >= 0} {
2402         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2403             [mc "Markup words"] [mc "Color words"]
2404         trace add variable worddiff write changeworddiff
2405         pack .bleft.mid.worddiff -side left -padx 5
2406     }
2407
2408     set ctext .bleft.bottom.ctext
2409     text $ctext -background $bgcolor -foreground $fgcolor \
2410         -state disabled -undo 0 -font textfont \
2411         -yscrollcommand scrolltext -wrap none \
2412         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2413     if {$have_tk85} {
2414         $ctext conf -tabstyle wordprocessor
2415     }
2416     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2417     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2418     pack .bleft.top -side top -fill x
2419     pack .bleft.mid -side top -fill x
2420     grid $ctext .bleft.bottom.sb -sticky nsew
2421     grid .bleft.bottom.sbhorizontal -sticky ew
2422     grid columnconfigure .bleft.bottom 0 -weight 1
2423     grid rowconfigure .bleft.bottom 0 -weight 1
2424     grid rowconfigure .bleft.bottom 1 -weight 0
2425     pack .bleft.bottom -side top -fill both -expand 1
2426     lappend bglist $ctext
2427     lappend fglist $ctext
2428
2429     $ctext tag conf comment -wrap $wrapcomment
2430     $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2431     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2432     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2433     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2434     $ctext tag conf m0 -fore [lindex $mergecolors 0]
2435     $ctext tag conf m1 -fore [lindex $mergecolors 1]
2436     $ctext tag conf m2 -fore [lindex $mergecolors 2]
2437     $ctext tag conf m3 -fore [lindex $mergecolors 3]
2438     $ctext tag conf m4 -fore [lindex $mergecolors 4]
2439     $ctext tag conf m5 -fore [lindex $mergecolors 5]
2440     $ctext tag conf m6 -fore [lindex $mergecolors 6]
2441     $ctext tag conf m7 -fore [lindex $mergecolors 7]
2442     $ctext tag conf m8 -fore [lindex $mergecolors 8]
2443     $ctext tag conf m9 -fore [lindex $mergecolors 9]
2444     $ctext tag conf m10 -fore [lindex $mergecolors 10]
2445     $ctext tag conf m11 -fore [lindex $mergecolors 11]
2446     $ctext tag conf m12 -fore [lindex $mergecolors 12]
2447     $ctext tag conf m13 -fore [lindex $mergecolors 13]
2448     $ctext tag conf m14 -fore [lindex $mergecolors 14]
2449     $ctext tag conf m15 -fore [lindex $mergecolors 15]
2450     $ctext tag conf mmax -fore darkgrey
2451     set mergemax 16
2452     $ctext tag conf mresult -font textfontbold
2453     $ctext tag conf msep -font textfontbold
2454     $ctext tag conf found -back $foundbgcolor
2455     $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2456     $ctext tag conf wwrap -wrap word -lmargin2 1c
2457     $ctext tag conf bold -font textfontbold
2458
2459     .pwbottom add .bleft
2460     if {!$use_ttk} {
2461         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2462     }
2463
2464     # lower right
2465     ${NS}::frame .bright
2466     ${NS}::frame .bright.mode
2467     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2468         -command reselectline -variable cmitmode -value "patch"
2469     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2470         -command reselectline -variable cmitmode -value "tree"
2471     grid .bright.mode.patch .bright.mode.tree -sticky ew
2472     pack .bright.mode -side top -fill x
2473     set cflist .bright.cfiles
2474     set indent [font measure mainfont "nn"]
2475     text $cflist \
2476         -selectbackground $selectbgcolor \
2477         -background $bgcolor -foreground $fgcolor \
2478         -font mainfont \
2479         -tabs [list $indent [expr {2 * $indent}]] \
2480         -yscrollcommand ".bright.sb set" \
2481         -cursor [. cget -cursor] \
2482         -spacing1 1 -spacing3 1
2483     lappend bglist $cflist
2484     lappend fglist $cflist
2485     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2486     pack .bright.sb -side right -fill y
2487     pack $cflist -side left -fill both -expand 1
2488     $cflist tag configure highlight \
2489         -background [$cflist cget -selectbackground]
2490     $cflist tag configure bold -font mainfontbold
2491
2492     .pwbottom add .bright
2493     .ctop add .pwbottom
2494
2495     # restore window width & height if known
2496     if {[info exists geometry(main)]} {
2497         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2498             if {$w > [winfo screenwidth .]} {
2499                 set w [winfo screenwidth .]
2500             }
2501             if {$h > [winfo screenheight .]} {
2502                 set h [winfo screenheight .]
2503             }
2504             wm geometry . "${w}x$h"
2505         }
2506     }
2507
2508     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2509         wm state . $geometry(state)
2510     }
2511
2512     if {[tk windowingsystem] eq {aqua}} {
2513         set M1B M1
2514         set ::BM "3"
2515     } else {
2516         set M1B Control
2517         set ::BM "2"
2518     }
2519
2520     if {$use_ttk} {
2521         bind .ctop <Map> {
2522             bind %W <Map> {}
2523             %W sashpos 0 $::geometry(topheight)
2524         }
2525         bind .pwbottom <Map> {
2526             bind %W <Map> {}
2527             %W sashpos 0 $::geometry(botwidth)
2528         }
2529     }
2530
2531     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2532     pack .ctop -fill both -expand 1
2533     bindall <1> {selcanvline %W %x %y}
2534     #bindall <B1-Motion> {selcanvline %W %x %y}
2535     if {[tk windowingsystem] == "win32"} {
2536         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2537         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2538     } else {
2539         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2540         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2541         bind $ctext <Button> {
2542             if {"%b" eq 6} {
2543                 $ctext xview scroll -5 units
2544             } elseif {"%b" eq 7} {
2545                 $ctext xview scroll 5 units
2546             }
2547         }
2548         if {[tk windowingsystem] eq "aqua"} {
2549             bindall <MouseWheel> {
2550                 set delta [expr {- (%D)}]
2551                 allcanvs yview scroll $delta units
2552             }
2553             bindall <Shift-MouseWheel> {
2554                 set delta [expr {- (%D)}]
2555                 $canv xview scroll $delta units
2556             }
2557         }
2558     }
2559     bindall <$::BM> "canvscan mark %W %x %y"
2560     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2561     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2562     bind . <$M1B-Key-w> doquit
2563     bindkey <Home> selfirstline
2564     bindkey <End> sellastline
2565     bind . <Key-Up> "selnextline -1"
2566     bind . <Key-Down> "selnextline 1"
2567     bind . <Shift-Key-Up> "dofind -1 0"
2568     bind . <Shift-Key-Down> "dofind 1 0"
2569     bindkey <Key-Right> "goforw"
2570     bindkey <Key-Left> "goback"
2571     bind . <Key-Prior> "selnextpage -1"
2572     bind . <Key-Next> "selnextpage 1"
2573     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2574     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2575     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2576     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2577     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2578     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2579     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2580     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2581     bindkey <Key-space> "$ctext yview scroll 1 pages"
2582     bindkey p "selnextline -1"
2583     bindkey n "selnextline 1"
2584     bindkey z "goback"
2585     bindkey x "goforw"
2586     bindkey k "selnextline -1"
2587     bindkey j "selnextline 1"
2588     bindkey h "goback"
2589     bindkey l "goforw"
2590     bindkey b prevfile
2591     bindkey d "$ctext yview scroll 18 units"
2592     bindkey u "$ctext yview scroll -18 units"
2593     bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2594     bindkey / {focus $fstring}
2595     bindkey <Key-KP_Divide> {focus $fstring}
2596     bindkey <Key-Return> {dofind 1 1}
2597     bindkey ? {dofind -1 1}
2598     bindkey f nextfile
2599     bind . <F5> updatecommits
2600     bindmodfunctionkey Shift 5 reloadcommits
2601     bind . <F2> showrefs
2602     bindmodfunctionkey Shift 4 {newview 0}
2603     bind . <F4> edit_or_newview
2604     bind . <$M1B-q> doquit
2605     bind . <$M1B-f> {dofind 1 1}
2606     bind . <$M1B-g> {dofind 1 0}
2607     bind . <$M1B-r> dosearchback
2608     bind . <$M1B-s> dosearch
2609     bind . <$M1B-equal> {incrfont 1}
2610     bind . <$M1B-plus> {incrfont 1}
2611     bind . <$M1B-KP_Add> {incrfont 1}
2612     bind . <$M1B-minus> {incrfont -1}
2613     bind . <$M1B-KP_Subtract> {incrfont -1}
2614     wm protocol . WM_DELETE_WINDOW doquit
2615     bind . <Destroy> {stop_backends}
2616     bind . <Button-1> "click %W"
2617     bind $fstring <Key-Return> {dofind 1 1}
2618     bind $sha1entry <Key-Return> {gotocommit; break}
2619     bind $sha1entry <<PasteSelection>> clearsha1
2620     bind $sha1entry <<Paste>> clearsha1
2621     bind $cflist <1> {sel_flist %W %x %y; break}
2622     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2623     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2624     global ctxbut
2625     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2626     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2627     bind $ctext <Button-1> {focus %W}
2628     bind $ctext <<Selection>> rehighlight_search_results
2629     for {set i 1} {$i < 10} {incr i} {
2630         bind . <$M1B-Key-$i> [list go_to_parent $i]
2631     }
2632
2633     set maincursor [. cget -cursor]
2634     set textcursor [$ctext cget -cursor]
2635     set curtextcursor $textcursor
2636
2637     set rowctxmenu .rowctxmenu
2638     makemenu $rowctxmenu {
2639         {mc "Diff this -> selected" command {diffvssel 0}}
2640         {mc "Diff selected -> this" command {diffvssel 1}}
2641         {mc "Make patch" command mkpatch}
2642         {mc "Create tag" command mktag}
2643         {mc "Copy commit summary" command copysummary}
2644         {mc "Write commit to file" command writecommit}
2645         {mc "Create new branch" command mkbranch}
2646         {mc "Cherry-pick this commit" command cherrypick}
2647         {mc "Reset HEAD branch to here" command resethead}
2648         {mc "Mark this commit" command markhere}
2649         {mc "Return to mark" command gotomark}
2650         {mc "Find descendant of this and mark" command find_common_desc}
2651         {mc "Compare with marked commit" command compare_commits}
2652         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2653         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2654         {mc "Revert this commit" command revert}
2655     }
2656     $rowctxmenu configure -tearoff 0
2657
2658     set fakerowmenu .fakerowmenu
2659     makemenu $fakerowmenu {
2660         {mc "Diff this -> selected" command {diffvssel 0}}
2661         {mc "Diff selected -> this" command {diffvssel 1}}
2662         {mc "Make patch" command mkpatch}
2663         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2664         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2665     }
2666     $fakerowmenu configure -tearoff 0
2667
2668     set headctxmenu .headctxmenu
2669     makemenu $headctxmenu {
2670         {mc "Check out this branch" command cobranch}
2671         {mc "Rename this branch" command mvbranch}
2672         {mc "Remove this branch" command rmbranch}
2673         {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2674     }
2675     $headctxmenu configure -tearoff 0
2676
2677     global flist_menu
2678     set flist_menu .flistctxmenu
2679     makemenu $flist_menu {
2680         {mc "Highlight this too" command {flist_hl 0}}
2681         {mc "Highlight this only" command {flist_hl 1}}
2682         {mc "External diff" command {external_diff}}
2683         {mc "Blame parent commit" command {external_blame 1}}
2684         {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2685     }
2686     $flist_menu configure -tearoff 0
2687
2688     global diff_menu
2689     set diff_menu .diffctxmenu
2690     makemenu $diff_menu {
2691         {mc "Show origin of this line" command show_line_source}
2692         {mc "Run git gui blame on this line" command {external_blame_diff}}
2693     }
2694     $diff_menu configure -tearoff 0
2695 }
2696
2697 # Windows sends all mouse wheel events to the current focused window, not
2698 # the one where the mouse hovers, so bind those events here and redirect
2699 # to the correct window
2700 proc windows_mousewheel_redirector {W X Y D} {
2701     global canv canv2 canv3
2702     set w [winfo containing -displayof $W $X $Y]
2703     if {$w ne ""} {
2704         set u [expr {$D < 0 ? 5 : -5}]
2705         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2706             allcanvs yview scroll $u units
2707         } else {
2708             catch {
2709                 $w yview scroll $u units
2710             }
2711         }
2712     }
2713 }
2714
2715 # Update row number label when selectedline changes
2716 proc selectedline_change {n1 n2 op} {
2717     global selectedline rownumsel
2718
2719     if {$selectedline eq {}} {
2720         set rownumsel {}
2721     } else {
2722         set rownumsel [expr {$selectedline + 1}]
2723     }
2724 }
2725
2726 # mouse-2 makes all windows scan vertically, but only the one
2727 # the cursor is in scans horizontally
2728 proc canvscan {op w x y} {
2729     global canv canv2 canv3
2730     foreach c [list $canv $canv2 $canv3] {
2731         if {$c == $w} {
2732             $c scan $op $x $y
2733         } else {
2734             $c scan $op 0 $y
2735         }
2736     }
2737 }
2738
2739 proc scrollcanv {cscroll f0 f1} {
2740     $cscroll set $f0 $f1
2741     drawvisible
2742     flushhighlights
2743 }
2744
2745 # when we make a key binding for the toplevel, make sure
2746 # it doesn't get triggered when that key is pressed in the
2747 # find string entry widget.
2748 proc bindkey {ev script} {
2749     global entries
2750     bind . $ev $script
2751     set escript [bind Entry $ev]
2752     if {$escript == {}} {
2753         set escript [bind Entry <Key>]
2754     }
2755     foreach e $entries {
2756         bind $e $ev "$escript; break"
2757     }
2758 }
2759
2760 proc bindmodfunctionkey {mod n script} {
2761     bind . <$mod-F$n> $script
2762     catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2763 }
2764
2765 # set the focus back to the toplevel for any click outside
2766 # the entry widgets
2767 proc click {w} {
2768     global ctext entries
2769     foreach e [concat $entries $ctext] {
2770         if {$w == $e} return
2771     }
2772     focus .
2773 }
2774
2775 # Adjust the progress bar for a change in requested extent or canvas size
2776 proc adjustprogress {} {
2777     global progresscanv progressitem progresscoords
2778     global fprogitem fprogcoord lastprogupdate progupdatepending
2779     global rprogitem rprogcoord use_ttk
2780
2781     if {$use_ttk} {
2782         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2783         return
2784     }
2785
2786     set w [expr {[winfo width $progresscanv] - 4}]
2787     set x0 [expr {$w * [lindex $progresscoords 0]}]
2788     set x1 [expr {$w * [lindex $progresscoords 1]}]
2789     set h [winfo height $progresscanv]
2790     $progresscanv coords $progressitem $x0 0 $x1 $h
2791     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2792     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2793     set now [clock clicks -milliseconds]
2794     if {$now >= $lastprogupdate + 100} {
2795         set progupdatepending 0
2796         update
2797     } elseif {!$progupdatepending} {
2798         set progupdatepending 1
2799         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2800     }
2801 }
2802
2803 proc doprogupdate {} {
2804     global lastprogupdate progupdatepending
2805
2806     if {$progupdatepending} {
2807         set progupdatepending 0
2808         set lastprogupdate [clock clicks -milliseconds]
2809         update
2810     }
2811 }
2812
2813 proc config_check_tmp_exists {tries_left} {
2814     global config_file_tmp
2815
2816     if {[file exists $config_file_tmp]} {
2817         incr tries_left -1
2818         if {$tries_left > 0} {
2819             after 100 [list config_check_tmp_exists $tries_left]
2820         } else {
2821             error_popup "There appears to be a stale $config_file_tmp\
2822  file, which will prevent gitk from saving its configuration on exit.\
2823  Please remove it if it is not being used by any existing gitk process."
2824         }
2825     }
2826 }
2827
2828 proc config_init_trace {name} {
2829     global config_variable_changed config_variable_original
2830
2831     upvar #0 $name var
2832     set config_variable_changed($name) 0
2833     set config_variable_original($name) $var
2834 }
2835
2836 proc config_variable_change_cb {name name2 op} {
2837     global config_variable_changed config_variable_original
2838
2839     upvar #0 $name var
2840     if {$op eq "write" &&
2841         (![info exists config_variable_original($name)] ||
2842          $config_variable_original($name) ne $var)} {
2843         set config_variable_changed($name) 1
2844     }
2845 }
2846
2847 proc savestuff {w} {
2848     global stuffsaved
2849     global config_file config_file_tmp
2850     global config_variables config_variable_changed
2851     global viewchanged
2852
2853     upvar #0 viewname current_viewname
2854     upvar #0 viewfiles current_viewfiles
2855     upvar #0 viewargs current_viewargs
2856     upvar #0 viewargscmd current_viewargscmd
2857     upvar #0 viewperm current_viewperm
2858     upvar #0 nextviewnum current_nextviewnum
2859     upvar #0 use_ttk current_use_ttk
2860
2861     if {$stuffsaved} return
2862     if {![winfo viewable .]} return
2863     set remove_tmp 0
2864     if {[catch {
2865         set try_count 0
2866         while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2867             if {[incr try_count] > 50} {
2868                 error "Unable to write config file: $config_file_tmp exists"
2869             }
2870             after 100
2871         }
2872         set remove_tmp 1
2873         if {$::tcl_platform(platform) eq {windows}} {
2874             file attributes $config_file_tmp -hidden true
2875         }
2876         if {[file exists $config_file]} {
2877             source $config_file
2878         }
2879         foreach var_name $config_variables {
2880             upvar #0 $var_name var
2881             upvar 0 $var_name old_var
2882             if {!$config_variable_changed($var_name) && [info exists old_var]} {
2883                 puts $f [list set $var_name $old_var]
2884             } else {
2885                 puts $f [list set $var_name $var]
2886             }
2887         }
2888
2889         puts $f "set geometry(main) [wm geometry .]"
2890         puts $f "set geometry(state) [wm state .]"
2891         puts $f "set geometry(topwidth) [winfo width .tf]"
2892         puts $f "set geometry(topheight) [winfo height .tf]"
2893         if {$current_use_ttk} {
2894             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2895             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2896         } else {
2897             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2898             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2899         }
2900         puts $f "set geometry(botwidth) [winfo width .bleft]"
2901         puts $f "set geometry(botheight) [winfo height .bleft]"
2902
2903         array set view_save {}
2904         array set views {}
2905         if {![info exists permviews]} { set permviews {} }
2906         foreach view $permviews {
2907             set view_save([lindex $view 0]) 1
2908             set views([lindex $view 0]) $view
2909         }
2910         puts -nonewline $f "set permviews {"
2911         for {set v 1} {$v < $current_nextviewnum} {incr v} {
2912             if {$viewchanged($v)} {
2913                 if {$current_viewperm($v)} {
2914                     set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2915                 } else {
2916                     set view_save($current_viewname($v)) 0
2917                 }
2918             }
2919         }
2920         # write old and updated view to their places and append remaining to the end
2921         foreach view $permviews {
2922             set view_name [lindex $view 0]
2923             if {$view_save($view_name)} {
2924                 puts $f "{$views($view_name)}"
2925             }
2926             unset views($view_name)
2927         }
2928         foreach view_name [array names views] {
2929             puts $f "{$views($view_name)}"
2930         }
2931         puts $f "}"
2932         close $f
2933         file rename -force $config_file_tmp $config_file
2934         set remove_tmp 0
2935     } err]} {
2936         puts "Error saving config: $err"
2937     }
2938     if {$remove_tmp} {
2939         file delete -force $config_file_tmp
2940     }
2941     set stuffsaved 1
2942 }
2943
2944 proc resizeclistpanes {win w} {
2945     global oldwidth use_ttk
2946     if {[info exists oldwidth($win)]} {
2947         if {$use_ttk} {
2948             set s0 [$win sashpos 0]
2949             set s1 [$win sashpos 1]
2950         } else {
2951             set s0 [$win sash coord 0]
2952             set s1 [$win sash coord 1]
2953         }
2954         if {$w < 60} {
2955             set sash0 [expr {int($w/2 - 2)}]
2956             set sash1 [expr {int($w*5/6 - 2)}]
2957         } else {
2958             set factor [expr {1.0 * $w / $oldwidth($win)}]
2959             set sash0 [expr {int($factor * [lindex $s0 0])}]
2960             set sash1 [expr {int($factor * [lindex $s1 0])}]
2961             if {$sash0 < 30} {
2962                 set sash0 30
2963             }
2964             if {$sash1 < $sash0 + 20} {
2965                 set sash1 [expr {$sash0 + 20}]
2966             }
2967             if {$sash1 > $w - 10} {
2968                 set sash1 [expr {$w - 10}]
2969                 if {$sash0 > $sash1 - 20} {
2970                     set sash0 [expr {$sash1 - 20}]
2971                 }
2972             }
2973         }
2974         if {$use_ttk} {
2975             $win sashpos 0 $sash0
2976             $win sashpos 1 $sash1
2977         } else {
2978             $win sash place 0 $sash0 [lindex $s0 1]
2979             $win sash place 1 $sash1 [lindex $s1 1]
2980         }
2981     }
2982     set oldwidth($win) $w
2983 }
2984
2985 proc resizecdetpanes {win w} {
2986     global oldwidth use_ttk
2987     if {[info exists oldwidth($win)]} {
2988         if {$use_ttk} {
2989             set s0 [$win sashpos 0]
2990         } else {
2991             set s0 [$win sash coord 0]
2992         }
2993         if {$w < 60} {
2994             set sash0 [expr {int($w*3/4 - 2)}]
2995         } else {
2996             set factor [expr {1.0 * $w / $oldwidth($win)}]
2997             set sash0 [expr {int($factor * [lindex $s0 0])}]
2998             if {$sash0 < 45} {
2999                 set sash0 45
3000             }
3001             if {$sash0 > $w - 15} {
3002                 set sash0 [expr {$w - 15}]
3003             }
3004         }
3005         if {$use_ttk} {
3006             $win sashpos 0 $sash0
3007         } else {
3008             $win sash place 0 $sash0 [lindex $s0 1]
3009         }
3010     }
3011     set oldwidth($win) $w
3012 }
3013
3014 proc allcanvs args {
3015     global canv canv2 canv3
3016     eval $canv $args
3017     eval $canv2 $args
3018     eval $canv3 $args
3019 }
3020
3021 proc bindall {event action} {
3022     global canv canv2 canv3
3023     bind $canv $event $action
3024     bind $canv2 $event $action
3025     bind $canv3 $event $action
3026 }
3027
3028 proc about {} {
3029     global bgcolor NS
3030     set w .about
3031     if {[winfo exists $w]} {
3032         raise $w
3033         return
3034     }
3035     ttk_toplevel $w
3036     wm title $w [mc "About gitk"]
3037     make_transient $w .
3038     message $w.m -text [mc "
3039 Gitk - a commit viewer for git
3040
3041 Copyright \u00a9 2005-2016 Paul Mackerras
3042
3043 Use and redistribute under the terms of the GNU General Public License"] \
3044             -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3045     pack $w.m -side top -fill x -padx 2 -pady 2
3046     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3047     pack $w.ok -side bottom
3048     bind $w <Visibility> "focus $w.ok"
3049     bind $w <Key-Escape> "destroy $w"
3050     bind $w <Key-Return> "destroy $w"
3051     tk::PlaceWindow $w widget .
3052 }
3053
3054 proc keys {} {
3055     global bgcolor NS
3056     set w .keys
3057     if {[winfo exists $w]} {
3058         raise $w
3059         return
3060     }
3061     if {[tk windowingsystem] eq {aqua}} {
3062         set M1T Cmd
3063     } else {
3064         set M1T Ctrl
3065     }
3066     ttk_toplevel $w
3067     wm title $w [mc "Gitk key bindings"]
3068     make_transient $w .
3069     message $w.m -text "
3070 [mc "Gitk key bindings:"]
3071
3072 [mc "<%s-Q>             Quit" $M1T]
3073 [mc "<%s-W>             Close window" $M1T]
3074 [mc "<Home>             Move to first commit"]
3075 [mc "<End>              Move to last commit"]
3076 [mc "<Up>, p, k Move up one commit"]
3077 [mc "<Down>, n, j       Move down one commit"]
3078 [mc "<Left>, z, h       Go back in history list"]
3079 [mc "<Right>, x, l      Go forward in history list"]
3080 [mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3081 [mc "<PageUp>   Move up one page in commit list"]
3082 [mc "<PageDown> Move down one page in commit list"]
3083 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
3084 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3085 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
3086 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
3087 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3088 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3089 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
3090 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3091 [mc "<Delete>, b        Scroll diff view up one page"]
3092 [mc "<Backspace>        Scroll diff view up one page"]
3093 [mc "<Space>            Scroll diff view down one page"]
3094 [mc "u          Scroll diff view up 18 lines"]
3095 [mc "d          Scroll diff view down 18 lines"]
3096 [mc "<%s-F>             Find" $M1T]
3097 [mc "<%s-G>             Move to next find hit" $M1T]
3098 [mc "<Return>   Move to next find hit"]
3099 [mc "g          Go to commit"]
3100 [mc "/          Focus the search box"]
3101 [mc "?          Move to previous find hit"]
3102 [mc "f          Scroll diff view to next file"]
3103 [mc "<%s-S>             Search for next hit in diff view" $M1T]
3104 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
3105 [mc "<%s-KP+>   Increase font size" $M1T]
3106 [mc "<%s-plus>  Increase font size" $M1T]
3107 [mc "<%s-KP->   Decrease font size" $M1T]
3108 [mc "<%s-minus> Decrease font size" $M1T]
3109 [mc "<F5>               Update"]
3110 " \
3111             -justify left -bg $bgcolor -border 2 -relief groove
3112     pack $w.m -side top -fill both -padx 2 -pady 2
3113     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3114     bind $w <Key-Escape> [list destroy $w]
3115     pack $w.ok -side bottom
3116     bind $w <Visibility> "focus $w.ok"
3117     bind $w <Key-Escape> "destroy $w"
3118     bind $w <Key-Return> "destroy $w"
3119 }
3120
3121 # Procedures for manipulating the file list window at the
3122 # bottom right of the overall window.
3123
3124 proc treeview {w l openlevs} {
3125     global treecontents treediropen treeheight treeparent treeindex
3126
3127     set ix 0
3128     set treeindex() 0
3129     set lev 0
3130     set prefix {}
3131     set prefixend -1
3132     set prefendstack {}
3133     set htstack {}
3134     set ht 0
3135     set treecontents() {}
3136     $w conf -state normal
3137     foreach f $l {
3138         while {[string range $f 0 $prefixend] ne $prefix} {
3139             if {$lev <= $openlevs} {
3140                 $w mark set e:$treeindex($prefix) "end -1c"
3141                 $w mark gravity e:$treeindex($prefix) left
3142             }
3143             set treeheight($prefix) $ht
3144             incr ht [lindex $htstack end]
3145             set htstack [lreplace $htstack end end]
3146             set prefixend [lindex $prefendstack end]
3147             set prefendstack [lreplace $prefendstack end end]
3148             set prefix [string range $prefix 0 $prefixend]
3149             incr lev -1
3150         }
3151         set tail [string range $f [expr {$prefixend+1}] end]
3152         while {[set slash [string first "/" $tail]] >= 0} {
3153             lappend htstack $ht
3154             set ht 0
3155             lappend prefendstack $prefixend
3156             incr prefixend [expr {$slash + 1}]
3157             set d [string range $tail 0 $slash]
3158             lappend treecontents($prefix) $d
3159             set oldprefix $prefix
3160             append prefix $d
3161             set treecontents($prefix) {}
3162             set treeindex($prefix) [incr ix]
3163             set treeparent($prefix) $oldprefix
3164             set tail [string range $tail [expr {$slash+1}] end]
3165             if {$lev <= $openlevs} {
3166                 set ht 1
3167                 set treediropen($prefix) [expr {$lev < $openlevs}]
3168                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3169                 $w mark set d:$ix "end -1c"
3170                 $w mark gravity d:$ix left
3171                 set str "\n"
3172                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3173                 $w insert end $str
3174                 $w image create end -align center -image $bm -padx 1 \
3175                     -name a:$ix
3176                 $w insert end $d [highlight_tag $prefix]
3177                 $w mark set s:$ix "end -1c"
3178                 $w mark gravity s:$ix left
3179             }
3180             incr lev
3181         }
3182         if {$tail ne {}} {
3183             if {$lev <= $openlevs} {
3184                 incr ht
3185                 set str "\n"
3186                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3187                 $w insert end $str
3188                 $w insert end $tail [highlight_tag $f]
3189             }
3190             lappend treecontents($prefix) $tail
3191         }
3192     }
3193     while {$htstack ne {}} {
3194         set treeheight($prefix) $ht
3195         incr ht [lindex $htstack end]
3196         set htstack [lreplace $htstack end end]
3197         set prefixend [lindex $prefendstack end]
3198         set prefendstack [lreplace $prefendstack end end]
3199         set prefix [string range $prefix 0 $prefixend]
3200     }
3201     $w conf -state disabled
3202 }
3203
3204 proc linetoelt {l} {
3205     global treeheight treecontents
3206
3207     set y 2
3208     set prefix {}
3209     while {1} {
3210         foreach e $treecontents($prefix) {
3211             if {$y == $l} {
3212                 return "$prefix$e"
3213             }
3214             set n 1
3215             if {[string index $e end] eq "/"} {
3216                 set n $treeheight($prefix$e)
3217                 if {$y + $n > $l} {
3218                     append prefix $e
3219                     incr y
3220                     break
3221                 }
3222             }
3223             incr y $n
3224         }
3225     }
3226 }
3227
3228 proc highlight_tree {y prefix} {
3229     global treeheight treecontents cflist
3230
3231     foreach e $treecontents($prefix) {
3232         set path $prefix$e
3233         if {[highlight_tag $path] ne {}} {
3234             $cflist tag add bold $y.0 "$y.0 lineend"
3235         }
3236         incr y
3237         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3238             set y [highlight_tree $y $path]
3239         }
3240     }
3241     return $y
3242 }
3243
3244 proc treeclosedir {w dir} {
3245     global treediropen treeheight treeparent treeindex
3246
3247     set ix $treeindex($dir)
3248     $w conf -state normal
3249     $w delete s:$ix e:$ix
3250     set treediropen($dir) 0
3251     $w image configure a:$ix -image tri-rt
3252     $w conf -state disabled
3253     set n [expr {1 - $treeheight($dir)}]
3254     while {$dir ne {}} {
3255         incr treeheight($dir) $n
3256         set dir $treeparent($dir)
3257     }
3258 }
3259
3260 proc treeopendir {w dir} {
3261     global treediropen treeheight treeparent treecontents treeindex
3262
3263     set ix $treeindex($dir)
3264     $w conf -state normal
3265     $w image configure a:$ix -image tri-dn
3266     $w mark set e:$ix s:$ix
3267     $w mark gravity e:$ix right
3268     set lev 0
3269     set str "\n"
3270     set n [llength $treecontents($dir)]
3271     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3272         incr lev
3273         append str "\t"
3274         incr treeheight($x) $n
3275     }
3276     foreach e $treecontents($dir) {
3277         set de $dir$e
3278         if {[string index $e end] eq "/"} {
3279             set iy $treeindex($de)
3280             $w mark set d:$iy e:$ix
3281             $w mark gravity d:$iy left
3282             $w insert e:$ix $str
3283             set treediropen($de) 0
3284             $w image create e:$ix -align center -image tri-rt -padx 1 \
3285                 -name a:$iy
3286             $w insert e:$ix $e [highlight_tag $de]
3287             $w mark set s:$iy e:$ix
3288             $w mark gravity s:$iy left
3289             set treeheight($de) 1
3290         } else {
3291             $w insert e:$ix $str
3292             $w insert e:$ix $e [highlight_tag $de]
3293         }
3294     }
3295     $w mark gravity e:$ix right
3296     $w conf -state disabled
3297     set treediropen($dir) 1
3298     set top [lindex [split [$w index @0,0] .] 0]
3299     set ht [$w cget -height]
3300     set l [lindex [split [$w index s:$ix] .] 0]
3301     if {$l < $top} {
3302         $w yview $l.0
3303     } elseif {$l + $n + 1 > $top + $ht} {
3304         set top [expr {$l + $n + 2 - $ht}]
3305         if {$l < $top} {
3306             set top $l
3307         }
3308         $w yview $top.0
3309     }
3310 }
3311
3312 proc treeclick {w x y} {
3313     global treediropen cmitmode ctext cflist cflist_top
3314
3315     if {$cmitmode ne "tree"} return
3316     if {![info exists cflist_top]} return
3317     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3318     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3319     $cflist tag add highlight $l.0 "$l.0 lineend"
3320     set cflist_top $l
3321     if {$l == 1} {
3322         $ctext yview 1.0
3323         return
3324     }
3325     set e [linetoelt $l]
3326     if {[string index $e end] ne "/"} {
3327         showfile $e
3328     } elseif {$treediropen($e)} {
3329         treeclosedir $w $e
3330     } else {
3331         treeopendir $w $e
3332     }
3333 }
3334
3335 proc setfilelist {id} {
3336     global treefilelist cflist jump_to_here
3337
3338     treeview $cflist $treefilelist($id) 0
3339     if {$jump_to_here ne {}} {
3340         set f [lindex $jump_to_here 0]
3341         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3342             showfile $f
3343         }
3344     }
3345 }
3346
3347 image create bitmap tri-rt -background black -foreground blue -data {
3348     #define tri-rt_width 13
3349     #define tri-rt_height 13
3350     static unsigned char tri-rt_bits[] = {
3351        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3352        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3353        0x00, 0x00};
3354 } -maskdata {
3355     #define tri-rt-mask_width 13
3356     #define tri-rt-mask_height 13
3357     static unsigned char tri-rt-mask_bits[] = {
3358        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3359        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3360        0x08, 0x00};
3361 }
3362 image create bitmap tri-dn -background black -foreground blue -data {
3363     #define tri-dn_width 13
3364     #define tri-dn_height 13
3365     static unsigned char tri-dn_bits[] = {
3366        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3367        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3368        0x00, 0x00};
3369 } -maskdata {
3370     #define tri-dn-mask_width 13
3371     #define tri-dn-mask_height 13
3372     static unsigned char tri-dn-mask_bits[] = {
3373        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3374        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3375        0x00, 0x00};
3376 }
3377
3378 image create bitmap reficon-T -background black -foreground yellow -data {
3379     #define tagicon_width 13
3380     #define tagicon_height 9
3381     static unsigned char tagicon_bits[] = {
3382        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3383        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3384 } -maskdata {
3385     #define tagicon-mask_width 13
3386     #define tagicon-mask_height 9
3387     static unsigned char tagicon-mask_bits[] = {
3388        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3389        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3390 }
3391 set rectdata {
3392     #define headicon_width 13
3393     #define headicon_height 9
3394     static unsigned char headicon_bits[] = {
3395        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3396        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3397 }
3398 set rectmask {
3399     #define headicon-mask_width 13
3400     #define headicon-mask_height 9
3401     static unsigned char headicon-mask_bits[] = {
3402        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3403        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3404 }
3405 image create bitmap reficon-H -background black -foreground "#00ff00" \
3406     -data $rectdata -maskdata $rectmask
3407 image create bitmap reficon-o -background black -foreground "#ddddff" \
3408     -data $rectdata -maskdata $rectmask
3409
3410 proc init_flist {first} {
3411     global cflist cflist_top difffilestart
3412
3413     $cflist conf -state normal
3414     $cflist delete 0.0 end
3415     if {$first ne {}} {
3416         $cflist insert end $first
3417         set cflist_top 1
3418         $cflist tag add highlight 1.0 "1.0 lineend"
3419     } else {
3420         unset -nocomplain cflist_top
3421     }
3422     $cflist conf -state disabled
3423     set difffilestart {}
3424 }
3425
3426 proc highlight_tag {f} {
3427     global highlight_paths
3428
3429     foreach p $highlight_paths {
3430         if {[string match $p $f]} {
3431             return "bold"
3432         }
3433     }
3434     return {}
3435 }
3436
3437 proc highlight_filelist {} {
3438     global cmitmode cflist
3439
3440     $cflist conf -state normal
3441     if {$cmitmode ne "tree"} {
3442         set end [lindex [split [$cflist index end] .] 0]
3443         for {set l 2} {$l < $end} {incr l} {
3444             set line [$cflist get $l.0 "$l.0 lineend"]
3445             if {[highlight_tag $line] ne {}} {
3446                 $cflist tag add bold $l.0 "$l.0 lineend"
3447             }
3448         }
3449     } else {
3450         highlight_tree 2 {}
3451     }
3452     $cflist conf -state disabled
3453 }
3454
3455 proc unhighlight_filelist {} {
3456     global cflist
3457
3458     $cflist conf -state normal
3459     $cflist tag remove bold 1.0 end
3460     $cflist conf -state disabled
3461 }
3462
3463 proc add_flist {fl} {
3464     global cflist
3465
3466     $cflist conf -state normal
3467     foreach f $fl {
3468         $cflist insert end "\n"
3469         $cflist insert end $f [highlight_tag $f]
3470     }
3471     $cflist conf -state disabled
3472 }
3473
3474 proc sel_flist {w x y} {
3475     global ctext difffilestart cflist cflist_top cmitmode
3476
3477     if {$cmitmode eq "tree"} return
3478     if {![info exists cflist_top]} return
3479     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3480     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3481     $cflist tag add highlight $l.0 "$l.0 lineend"
3482     set cflist_top $l
3483     if {$l == 1} {
3484         $ctext yview 1.0
3485     } else {
3486         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3487     }
3488     suppress_highlighting_file_for_current_scrollpos
3489 }
3490
3491 proc pop_flist_menu {w X Y x y} {
3492     global ctext cflist cmitmode flist_menu flist_menu_file
3493     global treediffs diffids
3494
3495     stopfinding
3496     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3497     if {$l <= 1} return
3498     if {$cmitmode eq "tree"} {
3499         set e [linetoelt $l]
3500         if {[string index $e end] eq "/"} return
3501     } else {
3502         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3503     }
3504     set flist_menu_file $e
3505     set xdiffstate "normal"
3506     if {$cmitmode eq "tree"} {
3507         set xdiffstate "disabled"
3508     }
3509     # Disable "External diff" item in tree mode
3510     $flist_menu entryconf 2 -state $xdiffstate
3511     tk_popup $flist_menu $X $Y
3512 }
3513
3514 proc find_ctext_fileinfo {line} {
3515     global ctext_file_names ctext_file_lines
3516
3517     set ok [bsearch $ctext_file_lines $line]
3518     set tline [lindex $ctext_file_lines $ok]
3519
3520     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3521         return {}
3522     } else {
3523         return [list [lindex $ctext_file_names $ok] $tline]
3524     }
3525 }
3526
3527 proc pop_diff_menu {w X Y x y} {
3528     global ctext diff_menu flist_menu_file
3529     global diff_menu_txtpos diff_menu_line
3530     global diff_menu_filebase
3531
3532     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3533     set diff_menu_line [lindex $diff_menu_txtpos 0]
3534     # don't pop up the menu on hunk-separator or file-separator lines
3535     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3536         return
3537     }
3538     stopfinding
3539     set f [find_ctext_fileinfo $diff_menu_line]
3540     if {$f eq {}} return
3541     set flist_menu_file [lindex $f 0]
3542     set diff_menu_filebase [lindex $f 1]
3543     tk_popup $diff_menu $X $Y
3544 }
3545
3546 proc flist_hl {only} {
3547     global flist_menu_file findstring gdttype
3548
3549     set x [shellquote $flist_menu_file]
3550     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3551         set findstring $x
3552     } else {
3553         append findstring " " $x
3554     }
3555     set gdttype [mc "touching paths:"]
3556 }
3557
3558 proc gitknewtmpdir {} {
3559     global diffnum gitktmpdir gitdir env
3560
3561     if {![info exists gitktmpdir]} {
3562         if {[info exists env(GITK_TMPDIR)]} {
3563             set tmpdir $env(GITK_TMPDIR)
3564         } elseif {[info exists env(TMPDIR)]} {
3565             set tmpdir $env(TMPDIR)
3566         } else {
3567             set tmpdir $gitdir
3568         }
3569         set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3570         if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3571             set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3572         }
3573         if {[catch {file mkdir $gitktmpdir} err]} {
3574             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3575             unset gitktmpdir
3576             return {}
3577         }
3578         set diffnum 0
3579     }
3580     incr diffnum
3581     set diffdir [file join $gitktmpdir $diffnum]
3582     if {[catch {file mkdir $diffdir} err]} {
3583         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3584         return {}
3585     }
3586     return $diffdir
3587 }
3588
3589 proc save_file_from_commit {filename output what} {
3590     global nullfile
3591
3592     if {[catch {exec git show $filename -- > $output} err]} {
3593         if {[string match "fatal: bad revision *" $err]} {
3594             return $nullfile
3595         }
3596         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3597         return {}
3598     }
3599     return $output
3600 }
3601
3602 proc external_diff_get_one_file {diffid filename diffdir} {
3603     global nullid nullid2 nullfile
3604     global worktree
3605
3606     if {$diffid == $nullid} {
3607         set difffile [file join $worktree $filename]
3608         if {[file exists $difffile]} {
3609             return $difffile
3610         }
3611         return $nullfile
3612     }
3613     if {$diffid == $nullid2} {
3614         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3615         return [save_file_from_commit :$filename $difffile index]
3616     }
3617     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3618     return [save_file_from_commit $diffid:$filename $difffile \
3619                "revision $diffid"]
3620 }
3621
3622 proc external_diff {} {
3623     global nullid nullid2
3624     global flist_menu_file
3625     global diffids
3626     global extdifftool
3627
3628     if {[llength $diffids] == 1} {
3629         # no reference commit given
3630         set diffidto [lindex $diffids 0]
3631         if {$diffidto eq $nullid} {
3632             # diffing working copy with index
3633             set diffidfrom $nullid2
3634         } elseif {$diffidto eq $nullid2} {
3635             # diffing index with HEAD
3636             set diffidfrom "HEAD"
3637         } else {
3638             # use first parent commit
3639             global parentlist selectedline
3640             set diffidfrom [lindex $parentlist $selectedline 0]
3641         }
3642     } else {
3643         set diffidfrom [lindex $diffids 0]
3644         set diffidto [lindex $diffids 1]
3645     }
3646
3647     # make sure that several diffs wont collide
3648     set diffdir [gitknewtmpdir]
3649     if {$diffdir eq {}} return
3650
3651     # gather files to diff
3652     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3653     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3654
3655     if {$difffromfile ne {} && $difftofile ne {}} {
3656         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3657         if {[catch {set fl [open |$cmd r]} err]} {
3658             file delete -force $diffdir
3659             error_popup "$extdifftool: [mc "command failed:"] $err"
3660         } else {
3661             fconfigure $fl -blocking 0
3662             filerun $fl [list delete_at_eof $fl $diffdir]
3663         }
3664     }
3665 }
3666
3667 proc find_hunk_blamespec {base line} {
3668     global ctext
3669
3670     # Find and parse the hunk header
3671     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3672     if {$s_lix eq {}} return
3673
3674     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3675     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3676             s_line old_specs osz osz1 new_line nsz]} {
3677         return
3678     }
3679
3680     # base lines for the parents
3681     set base_lines [list $new_line]
3682     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3683         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3684                 old_spec old_line osz]} {
3685             return
3686         }
3687         lappend base_lines $old_line
3688     }
3689
3690     # Now scan the lines to determine offset within the hunk
3691     set max_parent [expr {[llength $base_lines]-2}]
3692     set dline 0
3693     set s_lno [lindex [split $s_lix "."] 0]
3694
3695     # Determine if the line is removed
3696     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3697     if {[string match {[-+ ]*} $chunk]} {
3698         set removed_idx [string first "-" $chunk]
3699         # Choose a parent index
3700         if {$removed_idx >= 0} {
3701             set parent $removed_idx
3702         } else {
3703             set unchanged_idx [string first " " $chunk]
3704             if {$unchanged_idx >= 0} {
3705                 set parent $unchanged_idx
3706             } else {
3707                 # blame the current commit
3708                 set parent -1
3709             }
3710         }
3711         # then count other lines that belong to it
3712         for {set i $line} {[incr i -1] > $s_lno} {} {
3713             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3714             # Determine if the line is removed
3715             set removed_idx [string first "-" $chunk]
3716             if {$parent >= 0} {
3717                 set code [string index $chunk $parent]
3718                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3719                     incr dline
3720                 }
3721             } else {
3722                 if {$removed_idx < 0} {
3723                     incr dline
3724                 }
3725             }
3726         }
3727         incr parent
3728     } else {
3729         set parent 0
3730     }
3731
3732     incr dline [lindex $base_lines $parent]
3733     return [list $parent $dline]
3734 }
3735
3736 proc external_blame_diff {} {
3737     global currentid cmitmode
3738     global diff_menu_txtpos diff_menu_line
3739     global diff_menu_filebase flist_menu_file
3740
3741     if {$cmitmode eq "tree"} {
3742         set parent_idx 0
3743         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3744     } else {
3745         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3746         if {$hinfo ne {}} {
3747             set parent_idx [lindex $hinfo 0]
3748             set line [lindex $hinfo 1]
3749         } else {
3750             set parent_idx 0
3751             set line 0
3752         }
3753     }
3754
3755     external_blame $parent_idx $line
3756 }
3757
3758 # Find the SHA1 ID of the blob for file $fname in the index
3759 # at stage 0 or 2
3760 proc index_sha1 {fname} {
3761     set f [open [list | git ls-files -s $fname] r]
3762     while {[gets $f line] >= 0} {
3763         set info [lindex [split $line "\t"] 0]
3764         set stage [lindex $info 2]
3765         if {$stage eq "0" || $stage eq "2"} {
3766             close $f
3767             return [lindex $info 1]
3768         }
3769     }
3770     close $f
3771     return {}
3772 }
3773
3774 # Turn an absolute path into one relative to the current directory
3775 proc make_relative {f} {
3776     if {[file pathtype $f] eq "relative"} {
3777         return $f
3778     }
3779     set elts [file split $f]
3780     set here [file split [pwd]]
3781     set ei 0
3782     set hi 0
3783     set res {}
3784     foreach d $here {
3785         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3786             lappend res ".."
3787         } else {
3788             incr ei
3789         }
3790         incr hi
3791     }
3792     set elts [concat $res [lrange $elts $ei end]]
3793     return [eval file join $elts]
3794 }
3795
3796 proc external_blame {parent_idx {line {}}} {
3797     global flist_menu_file cdup
3798     global nullid nullid2
3799     global parentlist selectedline currentid
3800
3801     if {$parent_idx > 0} {
3802         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3803     } else {
3804         set base_commit $currentid
3805     }
3806
3807     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3808         error_popup [mc "No such commit"]
3809         return
3810     }
3811
3812     set cmdline [list git gui blame]
3813     if {$line ne {} && $line > 1} {
3814         lappend cmdline "--line=$line"
3815     }
3816     set f [file join $cdup $flist_menu_file]
3817     # Unfortunately it seems git gui blame doesn't like
3818     # being given an absolute path...
3819     set f [make_relative $f]
3820     lappend cmdline $base_commit $f
3821     if {[catch {eval exec $cmdline &} err]} {
3822         error_popup "[mc "git gui blame: command failed:"] $err"
3823     }
3824 }
3825
3826 proc show_line_source {} {
3827     global cmitmode currentid parents curview blamestuff blameinst
3828     global diff_menu_line diff_menu_filebase flist_menu_file
3829     global nullid nullid2 gitdir cdup
3830
3831     set from_index {}
3832     if {$cmitmode eq "tree"} {
3833         set id $currentid
3834         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3835     } else {
3836         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3837         if {$h eq {}} return
3838         set pi [lindex $h 0]
3839         if {$pi == 0} {
3840             mark_ctext_line $diff_menu_line
3841             return
3842         }
3843         incr pi -1
3844         if {$currentid eq $nullid} {
3845             if {$pi > 0} {
3846                 # must be a merge in progress...
3847                 if {[catch {
3848                     # get the last line from .git/MERGE_HEAD
3849                     set f [open [file join $gitdir MERGE_HEAD] r]
3850                     set id [lindex [split [read $f] "\n"] end-1]
3851                     close $f
3852                 } err]} {
3853                     error_popup [mc "Couldn't read merge head: %s" $err]
3854                     return
3855                 }
3856             } elseif {$parents($curview,$currentid) eq $nullid2} {
3857                 # need to do the blame from the index
3858                 if {[catch {
3859                     set from_index [index_sha1 $flist_menu_file]
3860                 } err]} {
3861                     error_popup [mc "Error reading index: %s" $err]
3862                     return
3863                 }
3864             } else {
3865                 set id $parents($curview,$currentid)
3866             }
3867         } else {
3868             set id [lindex $parents($curview,$currentid) $pi]
3869         }
3870         set line [lindex $h 1]
3871     }
3872     set blameargs {}
3873     if {$from_index ne {}} {
3874         lappend blameargs | git cat-file blob $from_index
3875     }
3876     lappend blameargs | git blame -p -L$line,+1
3877     if {$from_index ne {}} {
3878         lappend blameargs --contents -
3879     } else {
3880         lappend blameargs $id
3881     }
3882     lappend blameargs -- [file join $cdup $flist_menu_file]
3883     if {[catch {
3884         set f [open $blameargs r]
3885     } err]} {
3886         error_popup [mc "Couldn't start git blame: %s" $err]
3887         return
3888     }
3889     nowbusy blaming [mc "Searching"]
3890     fconfigure $f -blocking 0
3891     set i [reg_instance $f]
3892     set blamestuff($i) {}
3893     set blameinst $i
3894     filerun $f [list read_line_source $f $i]
3895 }
3896
3897 proc stopblaming {} {
3898     global blameinst
3899
3900     if {[info exists blameinst]} {
3901         stop_instance $blameinst
3902         unset blameinst
3903         notbusy blaming
3904     }
3905 }
3906
3907 proc read_line_source {fd inst} {
3908     global blamestuff curview commfd blameinst nullid nullid2
3909
3910     while {[gets $fd line] >= 0} {
3911         lappend blamestuff($inst) $line
3912     }
3913     if {![eof $fd]} {
3914         return 1
3915     }
3916     unset commfd($inst)
3917     unset blameinst
3918     notbusy blaming
3919     fconfigure $fd -blocking 1
3920     if {[catch {close $fd} err]} {
3921         error_popup [mc "Error running git blame: %s" $err]
3922         return 0
3923     }
3924
3925     set fname {}
3926     set line [split [lindex $blamestuff($inst) 0] " "]
3927     set id [lindex $line 0]
3928     set lnum [lindex $line 1]
3929     if {[string length $id] == 40 && [string is xdigit $id] &&
3930         [string is digit -strict $lnum]} {
3931         # look for "filename" line
3932         foreach l $blamestuff($inst) {
3933             if {[string match "filename *" $l]} {
3934                 set fname [string range $l 9 end]
3935                 break
3936             }
3937         }
3938     }
3939     if {$fname ne {}} {
3940         # all looks good, select it
3941         if {$id eq $nullid} {
3942             # blame uses all-zeroes to mean not committed,
3943             # which would mean a change in the index
3944             set id $nullid2
3945         }
3946         if {[commitinview $id $curview]} {
3947             selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3948         } else {
3949             error_popup [mc "That line comes from commit %s, \
3950                              which is not in this view" [shortids $id]]
3951         }
3952     } else {
3953         puts "oops couldn't parse git blame output"
3954     }
3955     return 0
3956 }
3957
3958 # delete $dir when we see eof on $f (presumably because the child has exited)
3959 proc delete_at_eof {f dir} {
3960     while {[gets $f line] >= 0} {}
3961     if {[eof $f]} {
3962         if {[catch {close $f} err]} {
3963             error_popup "[mc "External diff viewer failed:"] $err"
3964         }
3965         file delete -force $dir
3966         return 0
3967     }
3968     return 1
3969 }
3970
3971 # Functions for adding and removing shell-type quoting
3972
3973 proc shellquote {str} {
3974     if {![string match "*\['\"\\ \t]*" $str]} {
3975         return $str
3976     }
3977     if {![string match "*\['\"\\]*" $str]} {
3978         return "\"$str\""
3979     }
3980     if {![string match "*'*" $str]} {
3981         return "'$str'"
3982     }
3983     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3984 }
3985
3986 proc shellarglist {l} {
3987     set str {}
3988     foreach a $l {
3989         if {$str ne {}} {
3990             append str " "
3991         }
3992         append str [shellquote $a]
3993     }
3994     return $str
3995 }
3996
3997 proc shelldequote {str} {
3998     set ret {}
3999     set used -1
4000     while {1} {
4001         incr used
4002         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4003             append ret [string range $str $used end]
4004             set used [string length $str]
4005             break
4006         }
4007         set first [lindex $first 0]
4008         set ch [string index $str $first]
4009         if {$first > $used} {
4010             append ret [string range $str $used [expr {$first - 1}]]
4011             set used $first
4012         }
4013         if {$ch eq " " || $ch eq "\t"} break
4014         incr used
4015         if {$ch eq "'"} {
4016             set first [string first "'" $str $used]
4017             if {$first < 0} {
4018                 error "unmatched single-quote"
4019             }
4020             append ret [string range $str $used [expr {$first - 1}]]
4021             set used $first
4022             continue
4023         }
4024         if {$ch eq "\\"} {
4025             if {$used >= [string length $str]} {
4026                 error "trailing backslash"
4027             }
4028             append ret [string index $str $used]
4029             continue
4030         }
4031         # here ch == "\""
4032         while {1} {
4033             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4034                 error "unmatched double-quote"
4035             }
4036             set first [lindex $first 0]
4037             set ch [string index $str $first]
4038             if {$first > $used} {
4039                 append ret [string range $str $used [expr {$first - 1}]]
4040                 set used $first
4041             }
4042             if {$ch eq "\""} break
4043             incr used
4044             append ret [string index $str $used]
4045             incr used
4046         }
4047     }
4048     return [list $used $ret]
4049 }
4050
4051 proc shellsplit {str} {
4052     set l {}
4053     while {1} {
4054         set str [string trimleft $str]
4055         if {$str eq {}} break
4056         set dq [shelldequote $str]
4057         set n [lindex $dq 0]
4058         set word [lindex $dq 1]
4059         set str [string range $str $n end]
4060         lappend l $word
4061     }
4062     return $l
4063 }
4064
4065 proc set_window_title {} {
4066     global appname curview viewname vrevs
4067     set rev [mc "All files"]
4068     if {$curview ne 0} {
4069         if {$viewname($curview) eq [mc "Command line"]} {
4070             set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4071         } else {
4072             set rev $viewname($curview)
4073         }
4074     }
4075     wm title . "[reponame]: $rev - $appname"
4076 }
4077
4078 # Code to implement multiple views
4079
4080 proc newview {ishighlight} {
4081     global nextviewnum newviewname newishighlight
4082     global revtreeargs viewargscmd newviewopts curview
4083
4084     set newishighlight $ishighlight
4085     set top .gitkview
4086     if {[winfo exists $top]} {
4087         raise $top
4088         return
4089     }
4090     decode_view_opts $nextviewnum $revtreeargs
4091     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4092     set newviewopts($nextviewnum,perm) 0
4093     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4094     vieweditor $top $nextviewnum [mc "Gitk view definition"]
4095 }
4096
4097 set known_view_options {
4098     {perm      b    .  {}               {mc "Remember this view"}}
4099     {reflabel  l    +  {}               {mc "References (space separated list):"}}
4100     {refs      t15  .. {}               {mc "Branches & tags:"}}
4101     {allrefs   b    *. "--all"          {mc "All refs"}}
4102     {branches  b    .  "--branches"     {mc "All (local) branches"}}
4103     {tags      b    .  "--tags"         {mc "All tags"}}
4104     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4105     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4106     {author    t15  .. "--author=*"     {mc "Author:"}}
4107     {committer t15  .  "--committer=*"  {mc "Committer:"}}
4108     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4109     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4110     {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4111     {changes_l l    +  {}               {mc "Changes to Files:"}}
4112     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4113     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4114     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4115     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4116     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4117     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4118     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4119     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4120     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4121     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4122     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4123     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4124     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4125     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4126     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4127     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4128     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4129     }
4130
4131 # Convert $newviewopts($n, ...) into args for git log.
4132 proc encode_view_opts {n} {
4133     global known_view_options newviewopts
4134
4135     set rargs [list]
4136     foreach opt $known_view_options {
4137         set patterns [lindex $opt 3]
4138         if {$patterns eq {}} continue
4139         set pattern [lindex $patterns 0]
4140
4141         if {[lindex $opt 1] eq "b"} {
4142             set val $newviewopts($n,[lindex $opt 0])
4143             if {$val} {
4144                 lappend rargs $pattern
4145             }
4146         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4147             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4148             set val $newviewopts($n,$button_id)
4149             if {$val eq $value} {
4150                 lappend rargs $pattern
4151             }
4152         } else {
4153             set val $newviewopts($n,[lindex $opt 0])
4154             set val [string trim $val]
4155             if {$val ne {}} {
4156                 set pfix [string range $pattern 0 end-1]
4157                 lappend rargs $pfix$val
4158             }
4159         }
4160     }
4161     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4162     return [concat $rargs [shellsplit $newviewopts($n,args)]]
4163 }
4164
4165 # Fill $newviewopts($n, ...) based on args for git log.
4166 proc decode_view_opts {n view_args} {
4167     global known_view_options newviewopts
4168
4169     foreach opt $known_view_options {
4170         set id [lindex $opt 0]
4171         if {[lindex $opt 1] eq "b"} {
4172             # Checkboxes
4173             set val 0
4174         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4175             # Radiobuttons
4176             regexp {^(.*_)} $id uselessvar id
4177             set val 0
4178         } else {
4179             # Text fields
4180             set val {}
4181         }
4182         set newviewopts($n,$id) $val
4183     }
4184     set oargs [list]
4185     set refargs [list]
4186     foreach arg $view_args {
4187         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4188             && ![info exists found(limit)]} {
4189             set newviewopts($n,limit) $cnt
4190             set found(limit) 1
4191             continue
4192         }
4193         catch { unset val }
4194         foreach opt $known_view_options {
4195             set id [lindex $opt 0]
4196             if {[info exists found($id)]} continue
4197             foreach pattern [lindex $opt 3] {
4198                 if {![string match $pattern $arg]} continue
4199                 if {[lindex $opt 1] eq "b"} {
4200                     # Check buttons
4201                     set val 1
4202                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4203                     # Radio buttons
4204                     regexp {^(.*_)} $id uselessvar id
4205                     set val $num
4206                 } else {
4207                     # Text input fields
4208                     set size [string length $pattern]
4209                     set val [string range $arg [expr {$size-1}] end]
4210                 }
4211                 set newviewopts($n,$id) $val
4212                 set found($id) 1
4213                 break
4214             }
4215             if {[info exists val]} break
4216         }
4217         if {[info exists val]} continue
4218         if {[regexp {^-} $arg]} {
4219             lappend oargs $arg
4220         } else {
4221             lappend refargs $arg
4222         }
4223     }
4224     set newviewopts($n,refs) [shellarglist $refargs]
4225     set newviewopts($n,args) [shellarglist $oargs]
4226 }
4227
4228 proc edit_or_newview {} {
4229     global curview
4230
4231     if {$curview > 0} {
4232         editview
4233     } else {
4234         newview 0
4235     }
4236 }
4237
4238 proc editview {} {
4239     global curview
4240     global viewname viewperm newviewname newviewopts
4241     global viewargs viewargscmd
4242
4243     set top .gitkvedit-$curview
4244     if {[winfo exists $top]} {
4245         raise $top
4246         return
4247     }
4248     decode_view_opts $curview $viewargs($curview)
4249     set newviewname($curview)      $viewname($curview)
4250     set newviewopts($curview,perm) $viewperm($curview)
4251     set newviewopts($curview,cmd)  $viewargscmd($curview)
4252     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4253 }
4254
4255 proc vieweditor {top n title} {
4256     global newviewname newviewopts viewfiles bgcolor
4257     global known_view_options NS
4258
4259     ttk_toplevel $top
4260     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4261     make_transient $top .
4262
4263     # View name
4264     ${NS}::frame $top.nfr
4265     ${NS}::label $top.nl -text [mc "View Name"]
4266     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4267     pack $top.nfr -in $top -fill x -pady 5 -padx 3
4268     pack $top.nl -in $top.nfr -side left -padx {0 5}
4269     pack $top.name -in $top.nfr -side left -padx {0 25}
4270
4271     # View options
4272     set cframe $top.nfr
4273     set cexpand 0
4274     set cnt 0
4275     foreach opt $known_view_options {
4276         set id [lindex $opt 0]
4277         set type [lindex $opt 1]
4278         set flags [lindex $opt 2]
4279         set title [eval [lindex $opt 4]]
4280         set lxpad 0
4281
4282         if {$flags eq "+" || $flags eq "*"} {
4283             set cframe $top.fr$cnt
4284             incr cnt
4285             ${NS}::frame $cframe
4286             pack $cframe -in $top -fill x -pady 3 -padx 3
4287             set cexpand [expr {$flags eq "*"}]
4288         } elseif {$flags eq ".." || $flags eq "*."} {
4289             set cframe $top.fr$cnt
4290             incr cnt
4291             ${NS}::frame $cframe
4292             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4293             set cexpand [expr {$flags eq "*."}]
4294         } else {
4295             set lxpad 5
4296         }
4297
4298         if {$type eq "l"} {
4299             ${NS}::label $cframe.l_$id -text $title
4300             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4301         } elseif {$type eq "b"} {
4302             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4303             pack $cframe.c_$id -in $cframe -side left \
4304                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4305         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4306             regexp {^(.*_)} $id uselessvar button_id
4307             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4308             pack $cframe.c_$id -in $cframe -side left \
4309                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4310         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4311             ${NS}::label $cframe.l_$id -text $title
4312             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4313                 -textvariable newviewopts($n,$id)
4314             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4315             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4316         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4317             ${NS}::label $cframe.l_$id -text $title
4318             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4319                 -textvariable newviewopts($n,$id)
4320             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4321             pack $cframe.e_$id -in $cframe -side top -fill x
4322         } elseif {$type eq "path"} {
4323             ${NS}::label $top.l -text $title
4324             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4325             text $top.t -width 40 -height 5 -background $bgcolor
4326             if {[info exists viewfiles($n)]} {
4327                 foreach f $viewfiles($n) {
4328                     $top.t insert end $f
4329                     $top.t insert end "\n"
4330                 }
4331                 $top.t delete {end - 1c} end
4332                 $top.t mark set insert 0.0
4333             }
4334             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4335         }
4336     }
4337
4338     ${NS}::frame $top.buts
4339     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4340     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4341     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4342     bind $top <Control-Return> [list newviewok $top $n]
4343     bind $top <F5> [list newviewok $top $n 1]
4344     bind $top <Escape> [list destroy $top]
4345     grid $top.buts.ok $top.buts.apply $top.buts.can
4346     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4347     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4348     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4349     pack $top.buts -in $top -side top -fill x
4350     focus $top.t
4351 }
4352
4353 proc doviewmenu {m first cmd op argv} {
4354     set nmenu [$m index end]
4355     for {set i $first} {$i <= $nmenu} {incr i} {
4356         if {[$m entrycget $i -command] eq $cmd} {
4357             eval $m $op $i $argv
4358             break
4359         }
4360     }
4361 }
4362
4363 proc allviewmenus {n op args} {
4364     # global viewhlmenu
4365
4366     doviewmenu .bar.view 5 [list showview $n] $op $args
4367     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4368 }
4369
4370 proc newviewok {top n {apply 0}} {
4371     global nextviewnum newviewperm newviewname newishighlight
4372     global viewname viewfiles viewperm viewchanged selectedview curview
4373     global viewargs viewargscmd newviewopts viewhlmenu
4374
4375     if {[catch {
4376         set newargs [encode_view_opts $n]
4377     } err]} {
4378         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4379         return
4380     }
4381     set files {}
4382     foreach f [split [$top.t get 0.0 end] "\n"] {
4383         set ft [string trim $f]
4384         if {$ft ne {}} {
4385             lappend files $ft
4386         }
4387     }
4388     if {![info exists viewfiles($n)]} {
4389         # creating a new view
4390         incr nextviewnum
4391         set viewname($n) $newviewname($n)
4392         set viewperm($n) $newviewopts($n,perm)
4393         set viewchanged($n) 1
4394         set viewfiles($n) $files
4395         set viewargs($n) $newargs
4396         set viewargscmd($n) $newviewopts($n,cmd)
4397         addviewmenu $n
4398         if {!$newishighlight} {
4399             run showview $n
4400         } else {
4401             run addvhighlight $n
4402         }
4403     } else {
4404         # editing an existing view
4405         set viewperm($n) $newviewopts($n,perm)
4406         set viewchanged($n) 1
4407         if {$newviewname($n) ne $viewname($n)} {
4408             set viewname($n) $newviewname($n)
4409             doviewmenu .bar.view 5 [list showview $n] \
4410                 entryconf [list -label $viewname($n)]
4411             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4412                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4413         }
4414         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4415                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4416             set viewfiles($n) $files
4417             set viewargs($n) $newargs
4418             set viewargscmd($n) $newviewopts($n,cmd)
4419             if {$curview == $n} {
4420                 run reloadcommits
4421             }
4422         }
4423     }
4424     if {$apply} return
4425     catch {destroy $top}
4426 }
4427
4428 proc delview {} {
4429     global curview viewperm hlview selectedhlview viewchanged
4430
4431     if {$curview == 0} return
4432     if {[info exists hlview] && $hlview == $curview} {
4433         set selectedhlview [mc "None"]
4434         unset hlview
4435     }
4436     allviewmenus $curview delete
4437     set viewperm($curview) 0
4438     set viewchanged($curview) 1
4439     showview 0
4440 }
4441
4442 proc addviewmenu {n} {
4443     global viewname viewhlmenu
4444
4445     .bar.view add radiobutton -label $viewname($n) \
4446         -command [list showview $n] -variable selectedview -value $n
4447     #$viewhlmenu add radiobutton -label $viewname($n) \
4448     #   -command [list addvhighlight $n] -variable selectedhlview
4449 }
4450
4451 proc showview {n} {
4452     global curview cached_commitrow ordertok
4453     global displayorder parentlist rowidlist rowisopt rowfinal
4454     global colormap rowtextx nextcolor canvxmax
4455     global numcommits viewcomplete
4456     global selectedline currentid canv canvy0
4457     global treediffs
4458     global pending_select mainheadid
4459     global commitidx
4460     global selectedview
4461     global hlview selectedhlview commitinterest
4462
4463     if {$n == $curview} return
4464     set selid {}
4465     set ymax [lindex [$canv cget -scrollregion] 3]
4466     set span [$canv yview]
4467     set ytop [expr {[lindex $span 0] * $ymax}]
4468     set ybot [expr {[lindex $span 1] * $ymax}]
4469     set yscreen [expr {($ybot - $ytop) / 2}]
4470     if {$selectedline ne {}} {
4471         set selid $currentid
4472         set y [yc $selectedline]
4473         if {$ytop < $y && $y < $ybot} {
4474             set yscreen [expr {$y - $ytop}]
4475         }
4476     } elseif {[info exists pending_select]} {
4477         set selid $pending_select
4478         unset pending_select
4479     }
4480     unselectline
4481     normalline
4482     unset -nocomplain treediffs
4483     clear_display
4484     if {[info exists hlview] && $hlview == $n} {
4485         unset hlview
4486         set selectedhlview [mc "None"]
4487     }
4488     unset -nocomplain commitinterest
4489     unset -nocomplain cached_commitrow
4490     unset -nocomplain ordertok
4491
4492     set curview $n
4493     set selectedview $n
4494     .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4495     .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4496
4497     run refill_reflist
4498     if {![info exists viewcomplete($n)]} {
4499         getcommits $selid
4500         return
4501     }
4502
4503     set displayorder {}
4504     set parentlist {}
4505     set rowidlist {}
4506     set rowisopt {}
4507     set rowfinal {}
4508     set numcommits $commitidx($n)
4509
4510     unset -nocomplain colormap
4511     unset -nocomplain rowtextx
4512     set nextcolor 0
4513     set canvxmax [$canv cget -width]
4514     set curview $n
4515     set row 0
4516     setcanvscroll
4517     set yf 0
4518     set row {}
4519     if {$selid ne {} && [commitinview $selid $n]} {
4520         set row [rowofcommit $selid]
4521         # try to get the selected row in the same position on the screen
4522         set ymax [lindex [$canv cget -scrollregion] 3]
4523         set ytop [expr {[yc $row] - $yscreen}]
4524         if {$ytop < 0} {
4525             set ytop 0
4526         }
4527         set yf [expr {$ytop * 1.0 / $ymax}]
4528     }
4529     allcanvs yview moveto $yf
4530     drawvisible
4531     if {$row ne {}} {
4532         selectline $row 0
4533     } elseif {!$viewcomplete($n)} {
4534         reset_pending_select $selid
4535     } else {
4536         reset_pending_select {}
4537
4538         if {[commitinview $pending_select $curview]} {
4539             selectline [rowofcommit $pending_select] 1
4540         } else {
4541             set row [first_real_row]
4542             if {$row < $numcommits} {
4543                 selectline $row 0
4544             }
4545         }
4546     }
4547     if {!$viewcomplete($n)} {
4548         if {$numcommits == 0} {
4549             show_status [mc "Reading commits..."]
4550         }
4551     } elseif {$numcommits == 0} {
4552         show_status [mc "No commits selected"]
4553     }
4554     set_window_title
4555 }
4556
4557 # Stuff relating to the highlighting facility
4558
4559 proc ishighlighted {id} {
4560     global vhighlights fhighlights nhighlights rhighlights
4561
4562     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4563         return $nhighlights($id)
4564     }
4565     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4566         return $vhighlights($id)
4567     }
4568     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4569         return $fhighlights($id)
4570     }
4571     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4572         return $rhighlights($id)
4573     }
4574     return 0
4575 }
4576
4577 proc bolden {id font} {
4578     global canv linehtag currentid boldids need_redisplay markedid
4579
4580     # need_redisplay = 1 means the display is stale and about to be redrawn
4581     if {$need_redisplay} return
4582     lappend boldids $id
4583     $canv itemconf $linehtag($id) -font $font
4584     if {[info exists currentid] && $id eq $currentid} {
4585         $canv delete secsel
4586         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4587                    -outline {{}} -tags secsel \
4588                    -fill [$canv cget -selectbackground]]
4589         $canv lower $t
4590     }
4591     if {[info exists markedid] && $id eq $markedid} {
4592         make_idmark $id
4593     }
4594 }
4595
4596 proc bolden_name {id font} {
4597     global canv2 linentag currentid boldnameids need_redisplay
4598
4599     if {$need_redisplay} return
4600     lappend boldnameids $id
4601     $canv2 itemconf $linentag($id) -font $font
4602     if {[info exists currentid] && $id eq $currentid} {
4603         $canv2 delete secsel
4604         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4605                    -outline {{}} -tags secsel \
4606                    -fill [$canv2 cget -selectbackground]]
4607         $canv2 lower $t
4608     }
4609 }
4610
4611 proc unbolden {} {
4612     global boldids
4613
4614     set stillbold {}
4615     foreach id $boldids {
4616         if {![ishighlighted $id]} {
4617             bolden $id mainfont
4618         } else {
4619             lappend stillbold $id
4620         }
4621     }
4622     set boldids $stillbold
4623 }
4624
4625 proc addvhighlight {n} {
4626     global hlview viewcomplete curview vhl_done commitidx
4627
4628     if {[info exists hlview]} {
4629         delvhighlight
4630     }
4631     set hlview $n
4632     if {$n != $curview && ![info exists viewcomplete($n)]} {
4633         start_rev_list $n
4634     }
4635     set vhl_done $commitidx($hlview)
4636     if {$vhl_done > 0} {
4637         drawvisible
4638     }
4639 }
4640
4641 proc delvhighlight {} {
4642     global hlview vhighlights
4643
4644     if {![info exists hlview]} return
4645     unset hlview
4646     unset -nocomplain vhighlights
4647     unbolden
4648 }
4649
4650 proc vhighlightmore {} {
4651     global hlview vhl_done commitidx vhighlights curview
4652
4653     set max $commitidx($hlview)
4654     set vr [visiblerows]
4655     set r0 [lindex $vr 0]
4656     set r1 [lindex $vr 1]
4657     for {set i $vhl_done} {$i < $max} {incr i} {
4658         set id [commitonrow $i $hlview]
4659         if {[commitinview $id $curview]} {
4660             set row [rowofcommit $id]
4661             if {$r0 <= $row && $row <= $r1} {
4662                 if {![highlighted $row]} {
4663                     bolden $id mainfontbold
4664                 }
4665                 set vhighlights($id) 1
4666             }
4667         }
4668     }
4669     set vhl_done $max
4670     return 0
4671 }
4672
4673 proc askvhighlight {row id} {
4674     global hlview vhighlights iddrawn
4675
4676     if {[commitinview $id $hlview]} {
4677         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4678             bolden $id mainfontbold
4679         }
4680         set vhighlights($id) 1
4681     } else {
4682         set vhighlights($id) 0
4683     }
4684 }
4685
4686 proc hfiles_change {} {
4687     global highlight_files filehighlight fhighlights fh_serial
4688     global highlight_paths
4689
4690     if {[info exists filehighlight]} {
4691         # delete previous highlights
4692         catch {close $filehighlight}
4693         unset filehighlight
4694         unset -nocomplain fhighlights
4695         unbolden
4696         unhighlight_filelist
4697     }
4698     set highlight_paths {}
4699     after cancel do_file_hl $fh_serial
4700     incr fh_serial
4701     if {$highlight_files ne {}} {
4702         after 300 do_file_hl $fh_serial
4703     }
4704 }
4705
4706 proc gdttype_change {name ix op} {
4707     global gdttype highlight_files findstring findpattern
4708
4709     stopfinding
4710     if {$findstring ne {}} {
4711         if {$gdttype eq [mc "containing:"]} {
4712             if {$highlight_files ne {}} {
4713                 set highlight_files {}
4714                 hfiles_change
4715             }
4716             findcom_change
4717         } else {
4718             if {$findpattern ne {}} {
4719                 set findpattern {}
4720                 findcom_change
4721             }
4722             set highlight_files $findstring
4723             hfiles_change
4724         }
4725         drawvisible
4726     }
4727     # enable/disable findtype/findloc menus too
4728 }
4729
4730 proc find_change {name ix op} {
4731     global gdttype findstring highlight_files
4732
4733     stopfinding
4734     if {$gdttype eq [mc "containing:"]} {
4735         findcom_change
4736     } else {
4737         if {$highlight_files ne $findstring} {
4738             set highlight_files $findstring
4739             hfiles_change
4740         }
4741     }
4742     drawvisible
4743 }
4744
4745 proc findcom_change args {
4746     global nhighlights boldnameids
4747     global findpattern findtype findstring gdttype
4748
4749     stopfinding
4750     # delete previous highlights, if any
4751     foreach id $boldnameids {
4752         bolden_name $id mainfont
4753     }
4754     set boldnameids {}
4755     unset -nocomplain nhighlights
4756     unbolden
4757     unmarkmatches
4758     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4759         set findpattern {}
4760     } elseif {$findtype eq [mc "Regexp"]} {
4761         set findpattern $findstring
4762     } else {
4763         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4764                    $findstring]
4765         set findpattern "*$e*"
4766     }
4767 }
4768
4769 proc makepatterns {l} {
4770     set ret {}
4771     foreach e $l {
4772         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4773         if {[string index $ee end] eq "/"} {
4774             lappend ret "$ee*"
4775         } else {
4776             lappend ret $ee
4777             lappend ret "$ee/*"
4778         }
4779     }
4780     return $ret
4781 }
4782
4783 proc do_file_hl {serial} {
4784     global highlight_files filehighlight highlight_paths gdttype fhl_list
4785     global cdup findtype
4786
4787     if {$gdttype eq [mc "touching paths:"]} {
4788         # If "exact" match then convert backslashes to forward slashes.
4789         # Most useful to support Windows-flavoured file paths.
4790         if {$findtype eq [mc "Exact"]} {
4791             set highlight_files [string map {"\\" "/"} $highlight_files]
4792         }
4793         if {[catch {set paths [shellsplit $highlight_files]}]} return
4794         set highlight_paths [makepatterns $paths]
4795         highlight_filelist
4796         set relative_paths {}
4797         foreach path $paths {
4798             lappend relative_paths [file join $cdup $path]
4799         }
4800         set gdtargs [concat -- $relative_paths]
4801     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4802         set gdtargs [list "-S$highlight_files"]
4803     } elseif {$gdttype eq [mc "changing lines matching:"]} {
4804         set gdtargs [list "-G$highlight_files"]
4805     } else {
4806         # must be "containing:", i.e. we're searching commit info
4807         return
4808     }
4809     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4810     set filehighlight [open $cmd r+]
4811     fconfigure $filehighlight -blocking 0
4812     filerun $filehighlight readfhighlight
4813     set fhl_list {}
4814     drawvisible
4815     flushhighlights
4816 }
4817
4818 proc flushhighlights {} {
4819     global filehighlight fhl_list
4820
4821     if {[info exists filehighlight]} {
4822         lappend fhl_list {}
4823         puts $filehighlight ""
4824         flush $filehighlight
4825     }
4826 }
4827
4828 proc askfilehighlight {row id} {
4829     global filehighlight fhighlights fhl_list
4830
4831     lappend fhl_list $id
4832     set fhighlights($id) -1
4833     puts $filehighlight $id
4834 }
4835
4836 proc readfhighlight {} {
4837     global filehighlight fhighlights curview iddrawn
4838     global fhl_list find_dirn
4839
4840     if {![info exists filehighlight]} {
4841         return 0
4842     }
4843     set nr 0
4844     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4845         set line [string trim $line]
4846         set i [lsearch -exact $fhl_list $line]
4847         if {$i < 0} continue
4848         for {set j 0} {$j < $i} {incr j} {
4849             set id [lindex $fhl_list $j]
4850             set fhighlights($id) 0
4851         }
4852         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4853         if {$line eq {}} continue
4854         if {![commitinview $line $curview]} continue
4855         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4856             bolden $line mainfontbold
4857         }
4858         set fhighlights($line) 1
4859     }
4860     if {[eof $filehighlight]} {
4861         # strange...
4862         puts "oops, git diff-tree died"
4863         catch {close $filehighlight}
4864         unset filehighlight
4865         return 0
4866     }
4867     if {[info exists find_dirn]} {
4868         run findmore
4869     }
4870     return 1
4871 }
4872
4873 proc doesmatch {f} {
4874     global findtype findpattern
4875
4876     if {$findtype eq [mc "Regexp"]} {
4877         return [regexp $findpattern $f]
4878     } elseif {$findtype eq [mc "IgnCase"]} {
4879         return [string match -nocase $findpattern $f]
4880     } else {
4881         return [string match $findpattern $f]
4882     }
4883 }
4884
4885 proc askfindhighlight {row id} {
4886     global nhighlights commitinfo iddrawn
4887     global findloc
4888     global markingmatches
4889
4890     if {![info exists commitinfo($id)]} {
4891         getcommit $id
4892     }
4893     set info $commitinfo($id)
4894     set isbold 0
4895     set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4896     foreach f $info ty $fldtypes {
4897         if {$ty eq ""} continue
4898         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4899             [doesmatch $f]} {
4900             if {$ty eq [mc "Author"]} {
4901                 set isbold 2
4902                 break
4903             }
4904             set isbold 1
4905         }
4906     }
4907     if {$isbold && [info exists iddrawn($id)]} {
4908         if {![ishighlighted $id]} {
4909             bolden $id mainfontbold
4910             if {$isbold > 1} {
4911                 bolden_name $id mainfontbold
4912             }
4913         }
4914         if {$markingmatches} {
4915             markrowmatches $row $id
4916         }
4917     }
4918     set nhighlights($id) $isbold
4919 }
4920
4921 proc markrowmatches {row id} {
4922     global canv canv2 linehtag linentag commitinfo findloc
4923
4924     set headline [lindex $commitinfo($id) 0]
4925     set author [lindex $commitinfo($id) 1]
4926     $canv delete match$row
4927     $canv2 delete match$row
4928     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4929         set m [findmatches $headline]
4930         if {$m ne {}} {
4931             markmatches $canv $row $headline $linehtag($id) $m \
4932                 [$canv itemcget $linehtag($id) -font] $row
4933         }
4934     }
4935     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4936         set m [findmatches $author]
4937         if {$m ne {}} {
4938             markmatches $canv2 $row $author $linentag($id) $m \
4939                 [$canv2 itemcget $linentag($id) -font] $row
4940         }
4941     }
4942 }
4943
4944 proc vrel_change {name ix op} {
4945     global highlight_related
4946
4947     rhighlight_none
4948     if {$highlight_related ne [mc "None"]} {
4949         run drawvisible
4950     }
4951 }
4952
4953 # prepare for testing whether commits are descendents or ancestors of a
4954 proc rhighlight_sel {a} {
4955     global descendent desc_todo ancestor anc_todo
4956     global highlight_related
4957
4958     unset -nocomplain descendent
4959     set desc_todo [list $a]
4960     unset -nocomplain ancestor
4961     set anc_todo [list $a]
4962     if {$highlight_related ne [mc "None"]} {
4963         rhighlight_none
4964         run drawvisible
4965     }
4966 }
4967
4968 proc rhighlight_none {} {
4969     global rhighlights
4970
4971     unset -nocomplain rhighlights
4972     unbolden
4973 }
4974
4975 proc is_descendent {a} {
4976     global curview children descendent desc_todo
4977
4978     set v $curview
4979     set la [rowofcommit $a]
4980     set todo $desc_todo
4981     set leftover {}
4982     set done 0
4983     for {set i 0} {$i < [llength $todo]} {incr i} {
4984         set do [lindex $todo $i]
4985         if {[rowofcommit $do] < $la} {
4986             lappend leftover $do
4987             continue
4988         }
4989         foreach nk $children($v,$do) {
4990             if {![info exists descendent($nk)]} {
4991                 set descendent($nk) 1
4992                 lappend todo $nk
4993                 if {$nk eq $a} {
4994                     set done 1
4995                 }
4996             }
4997         }
4998         if {$done} {
4999             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5000             return
5001         }
5002     }
5003     set descendent($a) 0
5004     set desc_todo $leftover
5005 }
5006
5007 proc is_ancestor {a} {
5008     global curview parents ancestor anc_todo
5009
5010     set v $curview
5011     set la [rowofcommit $a]
5012     set todo $anc_todo
5013     set leftover {}
5014     set done 0
5015     for {set i 0} {$i < [llength $todo]} {incr i} {
5016         set do [lindex $todo $i]
5017         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5018             lappend leftover $do
5019             continue
5020         }
5021         foreach np $parents($v,$do) {
5022             if {![info exists ancestor($np)]} {
5023                 set ancestor($np) 1
5024                 lappend todo $np
5025                 if {$np eq $a} {
5026                     set done 1
5027                 }
5028             }
5029         }
5030         if {$done} {
5031             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5032             return
5033         }
5034     }
5035     set ancestor($a) 0
5036     set anc_todo $leftover
5037 }
5038
5039 proc askrelhighlight {row id} {
5040     global descendent highlight_related iddrawn rhighlights
5041     global selectedline ancestor
5042
5043     if {$selectedline eq {}} return
5044     set isbold 0
5045     if {$highlight_related eq [mc "Descendant"] ||
5046         $highlight_related eq [mc "Not descendant"]} {
5047         if {![info exists descendent($id)]} {
5048             is_descendent $id
5049         }
5050         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5051             set isbold 1
5052         }
5053     } elseif {$highlight_related eq [mc "Ancestor"] ||
5054               $highlight_related eq [mc "Not ancestor"]} {
5055         if {![info exists ancestor($id)]} {
5056             is_ancestor $id
5057         }
5058         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5059             set isbold 1
5060         }
5061     }
5062     if {[info exists iddrawn($id)]} {
5063         if {$isbold && ![ishighlighted $id]} {
5064             bolden $id mainfontbold
5065         }
5066     }
5067     set rhighlights($id) $isbold
5068 }
5069
5070 # Graph layout functions
5071
5072 proc shortids {ids} {
5073     set res {}
5074     foreach id $ids {
5075         if {[llength $id] > 1} {
5076             lappend res [shortids $id]
5077         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5078             lappend res [string range $id 0 7]
5079         } else {
5080             lappend res $id
5081         }
5082     }
5083     return $res
5084 }
5085
5086 proc ntimes {n o} {
5087     set ret {}
5088     set o [list $o]
5089     for {set mask 1} {$mask <= $n} {incr mask $mask} {
5090         if {($n & $mask) != 0} {
5091             set ret [concat $ret $o]
5092         }
5093         set o [concat $o $o]
5094     }
5095     return $ret
5096 }
5097
5098 proc ordertoken {id} {
5099     global ordertok curview varcid varcstart varctok curview parents children
5100     global nullid nullid2
5101
5102     if {[info exists ordertok($id)]} {
5103         return $ordertok($id)
5104     }
5105     set origid $id
5106     set todo {}
5107     while {1} {
5108         if {[info exists varcid($curview,$id)]} {
5109             set a $varcid($curview,$id)
5110             set p [lindex $varcstart($curview) $a]
5111         } else {
5112             set p [lindex $children($curview,$id) 0]
5113         }
5114         if {[info exists ordertok($p)]} {
5115             set tok $ordertok($p)
5116             break
5117         }
5118         set id [first_real_child $curview,$p]
5119         if {$id eq {}} {
5120             # it's a root
5121             set tok [lindex $varctok($curview) $varcid($curview,$p)]
5122             break
5123         }
5124         if {[llength $parents($curview,$id)] == 1} {
5125             lappend todo [list $p {}]
5126         } else {
5127             set j [lsearch -exact $parents($curview,$id) $p]
5128             if {$j < 0} {
5129                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5130             }
5131             lappend todo [list $p [strrep $j]]
5132         }
5133     }
5134     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5135         set p [lindex $todo $i 0]
5136         append tok [lindex $todo $i 1]
5137         set ordertok($p) $tok
5138     }
5139     set ordertok($origid) $tok
5140     return $tok
5141 }
5142
5143 # Work out where id should go in idlist so that order-token
5144 # values increase from left to right
5145 proc idcol {idlist id {i 0}} {
5146     set t [ordertoken $id]
5147     if {$i < 0} {
5148         set i 0
5149     }
5150     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5151         if {$i > [llength $idlist]} {
5152             set i [llength $idlist]
5153         }
5154         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5155         incr i
5156     } else {
5157         if {$t > [ordertoken [lindex $idlist $i]]} {
5158             while {[incr i] < [llength $idlist] &&
5159                    $t >= [ordertoken [lindex $idlist $i]]} {}
5160         }
5161     }
5162     return $i
5163 }
5164
5165 proc initlayout {} {
5166     global rowidlist rowisopt rowfinal displayorder parentlist
5167     global numcommits canvxmax canv
5168     global nextcolor
5169     global colormap rowtextx
5170
5171     set numcommits 0
5172     set displayorder {}
5173     set parentlist {}
5174     set nextcolor 0
5175     set rowidlist {}
5176     set rowisopt {}
5177     set rowfinal {}
5178     set canvxmax [$canv cget -width]
5179     unset -nocomplain colormap
5180     unset -nocomplain rowtextx
5181     setcanvscroll
5182 }
5183
5184 proc setcanvscroll {} {
5185     global canv canv2 canv3 numcommits linespc canvxmax canvy0
5186     global lastscrollset lastscrollrows
5187
5188     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5189     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5190     $canv2 conf -scrollregion [list 0 0 0 $ymax]
5191     $canv3 conf -scrollregion [list 0 0 0 $ymax]
5192     set lastscrollset [clock clicks -milliseconds]
5193     set lastscrollrows $numcommits
5194 }
5195
5196 proc visiblerows {} {
5197     global canv numcommits linespc
5198
5199     set ymax [lindex [$canv cget -scrollregion] 3]
5200     if {$ymax eq {} || $ymax == 0} return
5201     set f [$canv yview]
5202     set y0 [expr {int([lindex $f 0] * $ymax)}]
5203     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5204     if {$r0 < 0} {
5205         set r0 0
5206     }
5207     set y1 [expr {int([lindex $f 1] * $ymax)}]
5208     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5209     if {$r1 >= $numcommits} {
5210         set r1 [expr {$numcommits - 1}]
5211     }
5212     return [list $r0 $r1]
5213 }
5214
5215 proc layoutmore {} {
5216     global commitidx viewcomplete curview
5217     global numcommits pending_select curview
5218     global lastscrollset lastscrollrows
5219
5220     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5221         [clock clicks -milliseconds] - $lastscrollset > 500} {
5222         setcanvscroll
5223     }
5224     if {[info exists pending_select] &&
5225         [commitinview $pending_select $curview]} {
5226         update
5227         selectline [rowofcommit $pending_select] 1
5228     }
5229     drawvisible
5230 }
5231
5232 # With path limiting, we mightn't get the actual HEAD commit,
5233 # so ask git rev-list what is the first ancestor of HEAD that
5234 # touches a file in the path limit.
5235 proc get_viewmainhead {view} {
5236     global viewmainheadid vfilelimit viewinstances mainheadid
5237
5238     catch {
5239         set rfd [open [concat | git rev-list -1 $mainheadid \
5240                            -- $vfilelimit($view)] r]
5241         set j [reg_instance $rfd]
5242         lappend viewinstances($view) $j
5243         fconfigure $rfd -blocking 0
5244         filerun $rfd [list getviewhead $rfd $j $view]
5245         set viewmainheadid($curview) {}
5246     }
5247 }
5248
5249 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5250 proc getviewhead {fd inst view} {
5251     global viewmainheadid commfd curview viewinstances showlocalchanges
5252
5253     set id {}
5254     if {[gets $fd line] < 0} {
5255         if {![eof $fd]} {
5256             return 1
5257         }
5258     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5259         set id $line
5260     }
5261     set viewmainheadid($view) $id
5262     close $fd
5263     unset commfd($inst)
5264     set i [lsearch -exact $viewinstances($view) $inst]
5265     if {$i >= 0} {
5266         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5267     }
5268     if {$showlocalchanges && $id ne {} && $view == $curview} {
5269         doshowlocalchanges
5270     }
5271     return 0
5272 }
5273
5274 proc doshowlocalchanges {} {
5275     global curview viewmainheadid
5276
5277     if {$viewmainheadid($curview) eq {}} return
5278     if {[commitinview $viewmainheadid($curview) $curview]} {
5279         dodiffindex
5280     } else {
5281         interestedin $viewmainheadid($curview) dodiffindex
5282     }
5283 }
5284
5285 proc dohidelocalchanges {} {
5286     global nullid nullid2 lserial curview
5287
5288     if {[commitinview $nullid $curview]} {
5289         removefakerow $nullid
5290     }
5291     if {[commitinview $nullid2 $curview]} {
5292         removefakerow $nullid2
5293     }
5294     incr lserial
5295 }
5296
5297 # spawn off a process to do git diff-index --cached HEAD
5298 proc dodiffindex {} {
5299     global lserial showlocalchanges vfilelimit curview
5300     global hasworktree git_version
5301
5302     if {!$showlocalchanges || !$hasworktree} return
5303     incr lserial
5304     if {[package vcompare $git_version "1.7.2"] >= 0} {
5305         set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5306     } else {
5307         set cmd "|git diff-index --cached HEAD"
5308     }
5309     if {$vfilelimit($curview) ne {}} {
5310         set cmd [concat $cmd -- $vfilelimit($curview)]
5311     }
5312     set fd [open $cmd r]
5313     fconfigure $fd -blocking 0
5314     set i [reg_instance $fd]
5315     filerun $fd [list readdiffindex $fd $lserial $i]
5316 }
5317
5318 proc readdiffindex {fd serial inst} {
5319     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5320     global vfilelimit
5321
5322     set isdiff 1
5323     if {[gets $fd line] < 0} {
5324         if {![eof $fd]} {
5325             return 1
5326         }
5327         set isdiff 0
5328     }
5329     # we only need to see one line and we don't really care what it says...
5330     stop_instance $inst
5331
5332     if {$serial != $lserial} {
5333         return 0
5334     }
5335
5336     # now see if there are any local changes not checked in to the index
5337     set cmd "|git diff-files"
5338     if {$vfilelimit($curview) ne {}} {
5339         set cmd [concat $cmd -- $vfilelimit($curview)]
5340     }
5341     set fd [open $cmd r]
5342     fconfigure $fd -blocking 0
5343     set i [reg_instance $fd]
5344     filerun $fd [list readdifffiles $fd $serial $i]
5345
5346     if {$isdiff && ![commitinview $nullid2 $curview]} {
5347         # add the line for the changes in the index to the graph
5348         set hl [mc "Local changes checked in to index but not committed"]
5349         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5350         set commitdata($nullid2) "\n    $hl\n"
5351         if {[commitinview $nullid $curview]} {
5352             removefakerow $nullid
5353         }
5354         insertfakerow $nullid2 $viewmainheadid($curview)
5355     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5356         if {[commitinview $nullid $curview]} {
5357             removefakerow $nullid
5358         }
5359         removefakerow $nullid2
5360     }
5361     return 0
5362 }
5363
5364 proc readdifffiles {fd serial inst} {
5365     global viewmainheadid nullid nullid2 curview
5366     global commitinfo commitdata lserial
5367
5368     set isdiff 1
5369     if {[gets $fd line] < 0} {
5370         if {![eof $fd]} {
5371             return 1
5372         }
5373         set isdiff 0
5374     }
5375     # we only need to see one line and we don't really care what it says...
5376     stop_instance $inst
5377
5378     if {$serial != $lserial} {
5379         return 0
5380     }
5381
5382     if {$isdiff && ![commitinview $nullid $curview]} {
5383         # add the line for the local diff to the graph
5384         set hl [mc "Local uncommitted changes, not checked in to index"]
5385         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5386         set commitdata($nullid) "\n    $hl\n"
5387         if {[commitinview $nullid2 $curview]} {
5388             set p $nullid2
5389         } else {
5390             set p $viewmainheadid($curview)
5391         }
5392         insertfakerow $nullid $p
5393     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5394         removefakerow $nullid
5395     }
5396     return 0
5397 }
5398
5399 proc nextuse {id row} {
5400     global curview children
5401
5402     if {[info exists children($curview,$id)]} {
5403         foreach kid $children($curview,$id) {
5404             if {![commitinview $kid $curview]} {
5405                 return -1
5406             }
5407             if {[rowofcommit $kid] > $row} {
5408                 return [rowofcommit $kid]
5409             }
5410         }
5411     }
5412     if {[commitinview $id $curview]} {
5413         return [rowofcommit $id]
5414     }
5415     return -1
5416 }
5417
5418 proc prevuse {id row} {
5419     global curview children
5420
5421     set ret -1
5422     if {[info exists children($curview,$id)]} {
5423         foreach kid $children($curview,$id) {
5424             if {![commitinview $kid $curview]} break
5425             if {[rowofcommit $kid] < $row} {
5426                 set ret [rowofcommit $kid]
5427             }
5428         }
5429     }
5430     return $ret
5431 }
5432
5433 proc make_idlist {row} {
5434     global displayorder parentlist uparrowlen downarrowlen mingaplen
5435     global commitidx curview children
5436
5437     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5438     if {$r < 0} {
5439         set r 0
5440     }
5441     set ra [expr {$row - $downarrowlen}]
5442     if {$ra < 0} {
5443         set ra 0
5444     }
5445     set rb [expr {$row + $uparrowlen}]
5446     if {$rb > $commitidx($curview)} {
5447         set rb $commitidx($curview)
5448     }
5449     make_disporder $r [expr {$rb + 1}]
5450     set ids {}
5451     for {} {$r < $ra} {incr r} {
5452         set nextid [lindex $displayorder [expr {$r + 1}]]
5453         foreach p [lindex $parentlist $r] {
5454             if {$p eq $nextid} continue
5455             set rn [nextuse $p $r]
5456             if {$rn >= $row &&
5457                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5458                 lappend ids [list [ordertoken $p] $p]
5459             }
5460         }
5461     }
5462     for {} {$r < $row} {incr r} {
5463         set nextid [lindex $displayorder [expr {$r + 1}]]
5464         foreach p [lindex $parentlist $r] {
5465             if {$p eq $nextid} continue
5466             set rn [nextuse $p $r]
5467             if {$rn < 0 || $rn >= $row} {
5468                 lappend ids [list [ordertoken $p] $p]
5469             }
5470         }
5471     }
5472     set id [lindex $displayorder $row]
5473     lappend ids [list [ordertoken $id] $id]
5474     while {$r < $rb} {
5475         foreach p [lindex $parentlist $r] {
5476             set firstkid [lindex $children($curview,$p) 0]
5477             if {[rowofcommit $firstkid] < $row} {
5478                 lappend ids [list [ordertoken $p] $p]
5479             }
5480         }
5481         incr r
5482         set id [lindex $displayorder $r]
5483         if {$id ne {}} {
5484             set firstkid [lindex $children($curview,$id) 0]
5485             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5486                 lappend ids [list [ordertoken $id] $id]
5487             }
5488         }
5489     }
5490     set idlist {}
5491     foreach idx [lsort -unique $ids] {
5492         lappend idlist [lindex $idx 1]
5493     }
5494     return $idlist
5495 }
5496
5497 proc rowsequal {a b} {
5498     while {[set i [lsearch -exact $a {}]] >= 0} {
5499         set a [lreplace $a $i $i]
5500     }
5501     while {[set i [lsearch -exact $b {}]] >= 0} {
5502         set b [lreplace $b $i $i]
5503     }
5504     return [expr {$a eq $b}]
5505 }
5506
5507 proc makeupline {id row rend col} {
5508     global rowidlist uparrowlen downarrowlen mingaplen
5509
5510     for {set r $rend} {1} {set r $rstart} {
5511         set rstart [prevuse $id $r]
5512         if {$rstart < 0} return
5513         if {$rstart < $row} break
5514     }
5515     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5516         set rstart [expr {$rend - $uparrowlen - 1}]
5517     }
5518     for {set r $rstart} {[incr r] <= $row} {} {
5519         set idlist [lindex $rowidlist $r]
5520         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5521             set col [idcol $idlist $id $col]
5522             lset rowidlist $r [linsert $idlist $col $id]
5523             changedrow $r
5524         }
5525     }
5526 }
5527
5528 proc layoutrows {row endrow} {
5529     global rowidlist rowisopt rowfinal displayorder
5530     global uparrowlen downarrowlen maxwidth mingaplen
5531     global children parentlist
5532     global commitidx viewcomplete curview
5533
5534     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5535     set idlist {}
5536     if {$row > 0} {
5537         set rm1 [expr {$row - 1}]
5538         foreach id [lindex $rowidlist $rm1] {
5539             if {$id ne {}} {
5540                 lappend idlist $id
5541             }
5542         }
5543         set final [lindex $rowfinal $rm1]
5544     }
5545     for {} {$row < $endrow} {incr row} {
5546         set rm1 [expr {$row - 1}]
5547         if {$rm1 < 0 || $idlist eq {}} {
5548             set idlist [make_idlist $row]
5549             set final 1
5550         } else {
5551             set id [lindex $displayorder $rm1]
5552             set col [lsearch -exact $idlist $id]
5553             set idlist [lreplace $idlist $col $col]
5554             foreach p [lindex $parentlist $rm1] {
5555                 if {[lsearch -exact $idlist $p] < 0} {
5556                     set col [idcol $idlist $p $col]
5557                     set idlist [linsert $idlist $col $p]
5558                     # if not the first child, we have to insert a line going up
5559                     if {$id ne [lindex $children($curview,$p) 0]} {
5560                         makeupline $p $rm1 $row $col
5561                     }
5562                 }
5563             }
5564             set id [lindex $displayorder $row]
5565             if {$row > $downarrowlen} {
5566                 set termrow [expr {$row - $downarrowlen - 1}]
5567                 foreach p [lindex $parentlist $termrow] {
5568                     set i [lsearch -exact $idlist $p]
5569                     if {$i < 0} continue
5570                     set nr [nextuse $p $termrow]
5571                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5572                         set idlist [lreplace $idlist $i $i]
5573                     }
5574                 }
5575             }
5576             set col [lsearch -exact $idlist $id]
5577             if {$col < 0} {
5578                 set col [idcol $idlist $id]
5579                 set idlist [linsert $idlist $col $id]
5580                 if {$children($curview,$id) ne {}} {
5581                     makeupline $id $rm1 $row $col
5582                 }
5583             }
5584             set r [expr {$row + $uparrowlen - 1}]
5585             if {$r < $commitidx($curview)} {
5586                 set x $col
5587                 foreach p [lindex $parentlist $r] {
5588                     if {[lsearch -exact $idlist $p] >= 0} continue
5589                     set fk [lindex $children($curview,$p) 0]
5590                     if {[rowofcommit $fk] < $row} {
5591                         set x [idcol $idlist $p $x]
5592                         set idlist [linsert $idlist $x $p]
5593                     }
5594                 }
5595                 if {[incr r] < $commitidx($curview)} {
5596                     set p [lindex $displayorder $r]
5597                     if {[lsearch -exact $idlist $p] < 0} {
5598                         set fk [lindex $children($curview,$p) 0]
5599                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5600                             set x [idcol $idlist $p $x]
5601                             set idlist [linsert $idlist $x $p]
5602                         }
5603                     }
5604                 }
5605             }
5606         }
5607         if {$final && !$viewcomplete($curview) &&
5608             $row + $uparrowlen + $mingaplen + $downarrowlen
5609                 >= $commitidx($curview)} {
5610             set final 0
5611         }
5612         set l [llength $rowidlist]
5613         if {$row == $l} {
5614             lappend rowidlist $idlist
5615             lappend rowisopt 0
5616             lappend rowfinal $final
5617         } elseif {$row < $l} {
5618             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5619                 lset rowidlist $row $idlist
5620                 changedrow $row
5621             }
5622             lset rowfinal $row $final
5623         } else {
5624             set pad [ntimes [expr {$row - $l}] {}]
5625             set rowidlist [concat $rowidlist $pad]
5626             lappend rowidlist $idlist
5627             set rowfinal [concat $rowfinal $pad]
5628             lappend rowfinal $final
5629             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5630         }
5631     }
5632     return $row
5633 }
5634
5635 proc changedrow {row} {
5636     global displayorder iddrawn rowisopt need_redisplay
5637
5638     set l [llength $rowisopt]
5639     if {$row < $l} {
5640         lset rowisopt $row 0
5641         if {$row + 1 < $l} {
5642             lset rowisopt [expr {$row + 1}] 0
5643             if {$row + 2 < $l} {
5644                 lset rowisopt [expr {$row + 2}] 0
5645             }
5646         }
5647     }
5648     set id [lindex $displayorder $row]
5649     if {[info exists iddrawn($id)]} {
5650         set need_redisplay 1
5651     }
5652 }
5653
5654 proc insert_pad {row col npad} {
5655     global rowidlist
5656
5657     set pad [ntimes $npad {}]
5658     set idlist [lindex $rowidlist $row]
5659     set bef [lrange $idlist 0 [expr {$col - 1}]]
5660     set aft [lrange $idlist $col end]
5661     set i [lsearch -exact $aft {}]
5662     if {$i > 0} {
5663         set aft [lreplace $aft $i $i]
5664     }
5665     lset rowidlist $row [concat $bef $pad $aft]
5666     changedrow $row
5667 }
5668
5669 proc optimize_rows {row col endrow} {
5670     global rowidlist rowisopt displayorder curview children
5671
5672     if {$row < 1} {
5673         set row 1
5674     }
5675     for {} {$row < $endrow} {incr row; set col 0} {
5676         if {[lindex $rowisopt $row]} continue
5677         set haspad 0
5678         set y0 [expr {$row - 1}]
5679         set ym [expr {$row - 2}]
5680         set idlist [lindex $rowidlist $row]
5681         set previdlist [lindex $rowidlist $y0]
5682         if {$idlist eq {} || $previdlist eq {}} continue
5683         if {$ym >= 0} {
5684             set pprevidlist [lindex $rowidlist $ym]
5685             if {$pprevidlist eq {}} continue
5686         } else {
5687             set pprevidlist {}
5688         }
5689         set x0 -1
5690         set xm -1
5691         for {} {$col < [llength $idlist]} {incr col} {
5692             set id [lindex $idlist $col]
5693             if {[lindex $previdlist $col] eq $id} continue
5694             if {$id eq {}} {
5695                 set haspad 1
5696                 continue
5697             }
5698             set x0 [lsearch -exact $previdlist $id]
5699             if {$x0 < 0} continue
5700             set z [expr {$x0 - $col}]
5701             set isarrow 0
5702             set z0 {}
5703             if {$ym >= 0} {
5704                 set xm [lsearch -exact $pprevidlist $id]
5705                 if {$xm >= 0} {
5706                     set z0 [expr {$xm - $x0}]
5707                 }
5708             }
5709             if {$z0 eq {}} {
5710                 # if row y0 is the first child of $id then it's not an arrow
5711                 if {[lindex $children($curview,$id) 0] ne
5712                     [lindex $displayorder $y0]} {
5713                     set isarrow 1
5714                 }
5715             }
5716             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5717                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5718                 set isarrow 1
5719             }
5720             # Looking at lines from this row to the previous row,
5721             # make them go straight up if they end in an arrow on
5722             # the previous row; otherwise make them go straight up
5723             # or at 45 degrees.
5724             if {$z < -1 || ($z < 0 && $isarrow)} {
5725                 # Line currently goes left too much;
5726                 # insert pads in the previous row, then optimize it
5727                 set npad [expr {-1 - $z + $isarrow}]
5728                 insert_pad $y0 $x0 $npad
5729                 if {$y0 > 0} {
5730                     optimize_rows $y0 $x0 $row
5731                 }
5732                 set previdlist [lindex $rowidlist $y0]
5733                 set x0 [lsearch -exact $previdlist $id]
5734                 set z [expr {$x0 - $col}]
5735                 if {$z0 ne {}} {
5736                     set pprevidlist [lindex $rowidlist $ym]
5737                     set xm [lsearch -exact $pprevidlist $id]
5738                     set z0 [expr {$xm - $x0}]
5739                 }
5740             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5741                 # Line currently goes right too much;
5742                 # insert pads in this line
5743                 set npad [expr {$z - 1 + $isarrow}]
5744                 insert_pad $row $col $npad
5745                 set idlist [lindex $rowidlist $row]
5746                 incr col $npad
5747                 set z [expr {$x0 - $col}]
5748                 set haspad 1
5749             }
5750             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5751                 # this line links to its first child on row $row-2
5752                 set id [lindex $displayorder $ym]
5753                 set xc [lsearch -exact $pprevidlist $id]
5754                 if {$xc >= 0} {
5755                     set z0 [expr {$xc - $x0}]
5756                 }
5757             }
5758             # avoid lines jigging left then immediately right
5759             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5760                 insert_pad $y0 $x0 1
5761                 incr x0
5762                 optimize_rows $y0 $x0 $row
5763                 set previdlist [lindex $rowidlist $y0]
5764             }
5765         }
5766         if {!$haspad} {
5767             # Find the first column that doesn't have a line going right
5768             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5769                 set id [lindex $idlist $col]
5770                 if {$id eq {}} break
5771                 set x0 [lsearch -exact $previdlist $id]
5772                 if {$x0 < 0} {
5773                     # check if this is the link to the first child
5774                     set kid [lindex $displayorder $y0]
5775                     if {[lindex $children($curview,$id) 0] eq $kid} {
5776                         # it is, work out offset to child
5777                         set x0 [lsearch -exact $previdlist $kid]
5778                     }
5779                 }
5780                 if {$x0 <= $col} break
5781             }
5782             # Insert a pad at that column as long as it has a line and
5783             # isn't the last column
5784             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5785                 set idlist [linsert $idlist $col {}]
5786                 lset rowidlist $row $idlist
5787                 changedrow $row
5788             }
5789         }
5790     }
5791 }
5792
5793 proc xc {row col} {
5794     global canvx0 linespc
5795     return [expr {$canvx0 + $col * $linespc}]
5796 }
5797
5798 proc yc {row} {
5799     global canvy0 linespc
5800     return [expr {$canvy0 + $row * $linespc}]
5801 }
5802
5803 proc linewidth {id} {
5804     global thickerline lthickness
5805
5806     set wid $lthickness
5807     if {[info exists thickerline] && $id eq $thickerline} {
5808         set wid [expr {2 * $lthickness}]
5809     }
5810     return $wid
5811 }
5812
5813 proc rowranges {id} {
5814     global curview children uparrowlen downarrowlen
5815     global rowidlist
5816
5817     set kids $children($curview,$id)
5818     if {$kids eq {}} {
5819         return {}
5820     }
5821     set ret {}
5822     lappend kids $id
5823     foreach child $kids {
5824         if {![commitinview $child $curview]} break
5825         set row [rowofcommit $child]
5826         if {![info exists prev]} {
5827             lappend ret [expr {$row + 1}]
5828         } else {
5829             if {$row <= $prevrow} {
5830                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5831             }
5832             # see if the line extends the whole way from prevrow to row
5833             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5834                 [lsearch -exact [lindex $rowidlist \
5835                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5836                 # it doesn't, see where it ends
5837                 set r [expr {$prevrow + $downarrowlen}]
5838                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5839                     while {[incr r -1] > $prevrow &&
5840                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5841                 } else {
5842                     while {[incr r] <= $row &&
5843                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5844                     incr r -1
5845                 }
5846                 lappend ret $r
5847                 # see where it starts up again
5848                 set r [expr {$row - $uparrowlen}]
5849                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5850                     while {[incr r] < $row &&
5851                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5852                 } else {
5853                     while {[incr r -1] >= $prevrow &&
5854                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5855                     incr r
5856                 }
5857                 lappend ret $r
5858             }
5859         }
5860         if {$child eq $id} {
5861             lappend ret $row
5862         }
5863         set prev $child
5864         set prevrow $row
5865     }
5866     return $ret
5867 }
5868
5869 proc drawlineseg {id row endrow arrowlow} {
5870     global rowidlist displayorder iddrawn linesegs
5871     global canv colormap linespc curview maxlinelen parentlist
5872
5873     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5874     set le [expr {$row + 1}]
5875     set arrowhigh 1
5876     while {1} {
5877         set c [lsearch -exact [lindex $rowidlist $le] $id]
5878         if {$c < 0} {
5879             incr le -1
5880             break
5881         }
5882         lappend cols $c
5883         set x [lindex $displayorder $le]
5884         if {$x eq $id} {
5885             set arrowhigh 0
5886             break
5887         }
5888         if {[info exists iddrawn($x)] || $le == $endrow} {
5889             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5890             if {$c >= 0} {
5891                 lappend cols $c
5892                 set arrowhigh 0
5893             }
5894             break
5895         }
5896         incr le
5897     }
5898     if {$le <= $row} {
5899         return $row
5900     }
5901
5902     set lines {}
5903     set i 0
5904     set joinhigh 0
5905     if {[info exists linesegs($id)]} {
5906         set lines $linesegs($id)
5907         foreach li $lines {
5908             set r0 [lindex $li 0]
5909             if {$r0 > $row} {
5910                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5911                     set joinhigh 1
5912                 }
5913                 break
5914             }
5915             incr i
5916         }
5917     }
5918     set joinlow 0
5919     if {$i > 0} {
5920         set li [lindex $lines [expr {$i-1}]]
5921         set r1 [lindex $li 1]
5922         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5923             set joinlow 1
5924         }
5925     }
5926
5927     set x [lindex $cols [expr {$le - $row}]]
5928     set xp [lindex $cols [expr {$le - 1 - $row}]]
5929     set dir [expr {$xp - $x}]
5930     if {$joinhigh} {
5931         set ith [lindex $lines $i 2]
5932         set coords [$canv coords $ith]
5933         set ah [$canv itemcget $ith -arrow]
5934         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5935         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5936         if {$x2 ne {} && $x - $x2 == $dir} {
5937             set coords [lrange $coords 0 end-2]
5938         }
5939     } else {
5940         set coords [list [xc $le $x] [yc $le]]
5941     }
5942     if {$joinlow} {
5943         set itl [lindex $lines [expr {$i-1}] 2]
5944         set al [$canv itemcget $itl -arrow]
5945         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5946     } elseif {$arrowlow} {
5947         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5948             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5949             set arrowlow 0
5950         }
5951     }
5952     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5953     for {set y $le} {[incr y -1] > $row} {} {
5954         set x $xp
5955         set xp [lindex $cols [expr {$y - 1 - $row}]]
5956         set ndir [expr {$xp - $x}]
5957         if {$dir != $ndir || $xp < 0} {
5958             lappend coords [xc $y $x] [yc $y]
5959         }
5960         set dir $ndir
5961     }
5962     if {!$joinlow} {
5963         if {$xp < 0} {
5964             # join parent line to first child
5965             set ch [lindex $displayorder $row]
5966             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5967             if {$xc < 0} {
5968                 puts "oops: drawlineseg: child $ch not on row $row"
5969             } elseif {$xc != $x} {
5970                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5971                     set d [expr {int(0.5 * $linespc)}]
5972                     set x1 [xc $row $x]
5973                     if {$xc < $x} {
5974                         set x2 [expr {$x1 - $d}]
5975                     } else {
5976                         set x2 [expr {$x1 + $d}]
5977                     }
5978                     set y2 [yc $row]
5979                     set y1 [expr {$y2 + $d}]
5980                     lappend coords $x1 $y1 $x2 $y2
5981                 } elseif {$xc < $x - 1} {
5982                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5983                 } elseif {$xc > $x + 1} {
5984                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5985                 }
5986                 set x $xc
5987             }
5988             lappend coords [xc $row $x] [yc $row]
5989         } else {
5990             set xn [xc $row $xp]
5991             set yn [yc $row]
5992             lappend coords $xn $yn
5993         }
5994         if {!$joinhigh} {
5995             assigncolor $id
5996             set t [$canv create line $coords -width [linewidth $id] \
5997                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5998             $canv lower $t
5999             bindline $t $id
6000             set lines [linsert $lines $i [list $row $le $t]]
6001         } else {
6002             $canv coords $ith $coords
6003             if {$arrow ne $ah} {
6004                 $canv itemconf $ith -arrow $arrow
6005             }
6006             lset lines $i 0 $row
6007         }
6008     } else {
6009         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6010         set ndir [expr {$xo - $xp}]
6011         set clow [$canv coords $itl]
6012         if {$dir == $ndir} {
6013             set clow [lrange $clow 2 end]
6014         }
6015         set coords [concat $coords $clow]
6016         if {!$joinhigh} {
6017             lset lines [expr {$i-1}] 1 $le
6018         } else {
6019             # coalesce two pieces
6020             $canv delete $ith
6021             set b [lindex $lines [expr {$i-1}] 0]
6022             set e [lindex $lines $i 1]
6023             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6024         }
6025         $canv coords $itl $coords
6026         if {$arrow ne $al} {
6027             $canv itemconf $itl -arrow $arrow
6028         }
6029     }
6030
6031     set linesegs($id) $lines
6032     return $le
6033 }
6034
6035 proc drawparentlinks {id row} {
6036     global rowidlist canv colormap curview parentlist
6037     global idpos linespc
6038
6039     set rowids [lindex $rowidlist $row]
6040     set col [lsearch -exact $rowids $id]
6041     if {$col < 0} return
6042     set olds [lindex $parentlist $row]
6043     set row2 [expr {$row + 1}]
6044     set x [xc $row $col]
6045     set y [yc $row]
6046     set y2 [yc $row2]
6047     set d [expr {int(0.5 * $linespc)}]
6048     set ymid [expr {$y + $d}]
6049     set ids [lindex $rowidlist $row2]
6050     # rmx = right-most X coord used
6051     set rmx 0
6052     foreach p $olds {
6053         set i [lsearch -exact $ids $p]
6054         if {$i < 0} {
6055             puts "oops, parent $p of $id not in list"
6056             continue
6057         }
6058         set x2 [xc $row2 $i]
6059         if {$x2 > $rmx} {
6060             set rmx $x2
6061         }
6062         set j [lsearch -exact $rowids $p]
6063         if {$j < 0} {
6064             # drawlineseg will do this one for us
6065             continue
6066         }
6067         assigncolor $p
6068         # should handle duplicated parents here...
6069         set coords [list $x $y]
6070         if {$i != $col} {
6071             # if attaching to a vertical segment, draw a smaller
6072             # slant for visual distinctness
6073             if {$i == $j} {
6074                 if {$i < $col} {
6075                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6076                 } else {
6077                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6078                 }
6079             } elseif {$i < $col && $i < $j} {
6080                 # segment slants towards us already
6081                 lappend coords [xc $row $j] $y
6082             } else {
6083                 if {$i < $col - 1} {
6084                     lappend coords [expr {$x2 + $linespc}] $y
6085                 } elseif {$i > $col + 1} {
6086                     lappend coords [expr {$x2 - $linespc}] $y
6087                 }
6088                 lappend coords $x2 $y2
6089             }
6090         } else {
6091             lappend coords $x2 $y2
6092         }
6093         set t [$canv create line $coords -width [linewidth $p] \
6094                    -fill $colormap($p) -tags lines.$p]
6095         $canv lower $t
6096         bindline $t $p
6097     }
6098     if {$rmx > [lindex $idpos($id) 1]} {
6099         lset idpos($id) 1 $rmx
6100         redrawtags $id
6101     }
6102 }
6103
6104 proc drawlines {id} {
6105     global canv
6106
6107     $canv itemconf lines.$id -width [linewidth $id]
6108 }
6109
6110 proc drawcmittext {id row col} {
6111     global linespc canv canv2 canv3 fgcolor curview
6112     global cmitlisted commitinfo rowidlist parentlist
6113     global rowtextx idpos idtags idheads idotherrefs
6114     global linehtag linentag linedtag selectedline
6115     global canvxmax boldids boldnameids fgcolor markedid
6116     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6117     global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6118     global circleoutlinecolor
6119
6120     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6121     set listed $cmitlisted($curview,$id)
6122     if {$id eq $nullid} {
6123         set ofill $workingfilescirclecolor
6124     } elseif {$id eq $nullid2} {
6125         set ofill $indexcirclecolor
6126     } elseif {$id eq $mainheadid} {
6127         set ofill $mainheadcirclecolor
6128     } else {
6129         set ofill [lindex $circlecolors $listed]
6130     }
6131     set x [xc $row $col]
6132     set y [yc $row]
6133     set orad [expr {$linespc / 3}]
6134     if {$listed <= 2} {
6135         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6136                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6137                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6138     } elseif {$listed == 3} {
6139         # triangle pointing left for left-side commits
6140         set t [$canv create polygon \
6141                    [expr {$x - $orad}] $y \
6142                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6143                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6144                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6145     } else {
6146         # triangle pointing right for right-side commits
6147         set t [$canv create polygon \
6148                    [expr {$x + $orad - 1}] $y \
6149                    [expr {$x - $orad}] [expr {$y - $orad}] \
6150                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6151                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6152     }
6153     set circleitem($row) $t
6154     $canv raise $t
6155     $canv bind $t <1> {selcanvline {} %x %y}
6156     set rmx [llength [lindex $rowidlist $row]]
6157     set olds [lindex $parentlist $row]
6158     if {$olds ne {}} {
6159         set nextids [lindex $rowidlist [expr {$row + 1}]]
6160         foreach p $olds {
6161             set i [lsearch -exact $nextids $p]
6162             if {$i > $rmx} {
6163                 set rmx $i
6164             }
6165         }
6166     }
6167     set xt [xc $row $rmx]
6168     set rowtextx($row) $xt
6169     set idpos($id) [list $x $xt $y]
6170     if {[info exists idtags($id)] || [info exists idheads($id)]
6171         || [info exists idotherrefs($id)]} {
6172         set xt [drawtags $id $x $xt $y]
6173     }
6174     if {[lindex $commitinfo($id) 6] > 0} {
6175         set xt [drawnotesign $xt $y]
6176     }
6177     set headline [lindex $commitinfo($id) 0]
6178     set name [lindex $commitinfo($id) 1]
6179     set date [lindex $commitinfo($id) 2]
6180     set date [formatdate $date]
6181     set font mainfont
6182     set nfont mainfont
6183     set isbold [ishighlighted $id]
6184     if {$isbold > 0} {
6185         lappend boldids $id
6186         set font mainfontbold
6187         if {$isbold > 1} {
6188             lappend boldnameids $id
6189             set nfont mainfontbold
6190         }
6191     }
6192     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6193                            -text $headline -font $font -tags text]
6194     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6195     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6196                            -text $name -font $nfont -tags text]
6197     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6198                            -text $date -font mainfont -tags text]
6199     if {$selectedline == $row} {
6200         make_secsel $id
6201     }
6202     if {[info exists markedid] && $markedid eq $id} {
6203         make_idmark $id
6204     }
6205     set xr [expr {$xt + [font measure $font $headline]}]
6206     if {$xr > $canvxmax} {
6207         set canvxmax $xr
6208         setcanvscroll
6209     }
6210 }
6211
6212 proc drawcmitrow {row} {
6213     global displayorder rowidlist nrows_drawn
6214     global iddrawn markingmatches
6215     global commitinfo numcommits
6216     global filehighlight fhighlights findpattern nhighlights
6217     global hlview vhighlights
6218     global highlight_related rhighlights
6219
6220     if {$row >= $numcommits} return
6221
6222     set id [lindex $displayorder $row]
6223     if {[info exists hlview] && ![info exists vhighlights($id)]} {
6224         askvhighlight $row $id
6225     }
6226     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6227         askfilehighlight $row $id
6228     }
6229     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6230         askfindhighlight $row $id
6231     }
6232     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6233         askrelhighlight $row $id
6234     }
6235     if {![info exists iddrawn($id)]} {
6236         set col [lsearch -exact [lindex $rowidlist $row] $id]
6237         if {$col < 0} {
6238             puts "oops, row $row id $id not in list"
6239             return
6240         }
6241         if {![info exists commitinfo($id)]} {
6242             getcommit $id
6243         }
6244         assigncolor $id
6245         drawcmittext $id $row $col
6246         set iddrawn($id) 1
6247         incr nrows_drawn
6248     }
6249     if {$markingmatches} {
6250         markrowmatches $row $id
6251     }
6252 }
6253
6254 proc drawcommits {row {endrow {}}} {
6255     global numcommits iddrawn displayorder curview need_redisplay
6256     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6257
6258     if {$row < 0} {
6259         set row 0
6260     }
6261     if {$endrow eq {}} {
6262         set endrow $row
6263     }
6264     if {$endrow >= $numcommits} {
6265         set endrow [expr {$numcommits - 1}]
6266     }
6267
6268     set rl1 [expr {$row - $downarrowlen - 3}]
6269     if {$rl1 < 0} {
6270         set rl1 0
6271     }
6272     set ro1 [expr {$row - 3}]
6273     if {$ro1 < 0} {
6274         set ro1 0
6275     }
6276     set r2 [expr {$endrow + $uparrowlen + 3}]
6277     if {$r2 > $numcommits} {
6278         set r2 $numcommits
6279     }
6280     for {set r $rl1} {$r < $r2} {incr r} {
6281         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6282             if {$rl1 < $r} {
6283                 layoutrows $rl1 $r
6284             }
6285             set rl1 [expr {$r + 1}]
6286         }
6287     }
6288     if {$rl1 < $r} {
6289         layoutrows $rl1 $r
6290     }
6291     optimize_rows $ro1 0 $r2
6292     if {$need_redisplay || $nrows_drawn > 2000} {
6293         clear_display
6294     }
6295
6296     # make the lines join to already-drawn rows either side
6297     set r [expr {$row - 1}]
6298     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6299         set r $row
6300     }
6301     set er [expr {$endrow + 1}]
6302     if {$er >= $numcommits ||
6303         ![info exists iddrawn([lindex $displayorder $er])]} {
6304         set er $endrow
6305     }
6306     for {} {$r <= $er} {incr r} {
6307         set id [lindex $displayorder $r]
6308         set wasdrawn [info exists iddrawn($id)]
6309         drawcmitrow $r
6310         if {$r == $er} break
6311         set nextid [lindex $displayorder [expr {$r + 1}]]
6312         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6313         drawparentlinks $id $r
6314
6315         set rowids [lindex $rowidlist $r]
6316         foreach lid $rowids {
6317             if {$lid eq {}} continue
6318             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6319             if {$lid eq $id} {
6320                 # see if this is the first child of any of its parents
6321                 foreach p [lindex $parentlist $r] {
6322                     if {[lsearch -exact $rowids $p] < 0} {
6323                         # make this line extend up to the child
6324                         set lineend($p) [drawlineseg $p $r $er 0]
6325                     }
6326                 }
6327             } else {
6328                 set lineend($lid) [drawlineseg $lid $r $er 1]
6329             }
6330         }
6331     }
6332 }
6333
6334 proc undolayout {row} {
6335     global uparrowlen mingaplen downarrowlen
6336     global rowidlist rowisopt rowfinal need_redisplay
6337
6338     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6339     if {$r < 0} {
6340         set r 0
6341     }
6342     if {[llength $rowidlist] > $r} {
6343         incr r -1
6344         set rowidlist [lrange $rowidlist 0 $r]
6345         set rowfinal [lrange $rowfinal 0 $r]
6346         set rowisopt [lrange $rowisopt 0 $r]
6347         set need_redisplay 1
6348         run drawvisible
6349     }
6350 }
6351
6352 proc drawvisible {} {
6353     global canv linespc curview vrowmod selectedline targetrow targetid
6354     global need_redisplay cscroll numcommits
6355
6356     set fs [$canv yview]
6357     set ymax [lindex [$canv cget -scrollregion] 3]
6358     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6359     set f0 [lindex $fs 0]
6360     set f1 [lindex $fs 1]
6361     set y0 [expr {int($f0 * $ymax)}]
6362     set y1 [expr {int($f1 * $ymax)}]
6363
6364     if {[info exists targetid]} {
6365         if {[commitinview $targetid $curview]} {
6366             set r [rowofcommit $targetid]
6367             if {$r != $targetrow} {
6368                 # Fix up the scrollregion and change the scrolling position
6369                 # now that our target row has moved.
6370                 set diff [expr {($r - $targetrow) * $linespc}]
6371                 set targetrow $r
6372                 setcanvscroll
6373                 set ymax [lindex [$canv cget -scrollregion] 3]
6374                 incr y0 $diff
6375                 incr y1 $diff
6376                 set f0 [expr {$y0 / $ymax}]
6377                 set f1 [expr {$y1 / $ymax}]
6378                 allcanvs yview moveto $f0
6379                 $cscroll set $f0 $f1
6380                 set need_redisplay 1
6381             }
6382         } else {
6383             unset targetid
6384         }
6385     }
6386
6387     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6388     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6389     if {$endrow >= $vrowmod($curview)} {
6390         update_arcrows $curview
6391     }
6392     if {$selectedline ne {} &&
6393         $row <= $selectedline && $selectedline <= $endrow} {
6394         set targetrow $selectedline
6395     } elseif {[info exists targetid]} {
6396         set targetrow [expr {int(($row + $endrow) / 2)}]
6397     }
6398     if {[info exists targetrow]} {
6399         if {$targetrow >= $numcommits} {
6400             set targetrow [expr {$numcommits - 1}]
6401         }
6402         set targetid [commitonrow $targetrow]
6403     }
6404     drawcommits $row $endrow
6405 }
6406
6407 proc clear_display {} {
6408     global iddrawn linesegs need_redisplay nrows_drawn
6409     global vhighlights fhighlights nhighlights rhighlights
6410     global linehtag linentag linedtag boldids boldnameids
6411
6412     allcanvs delete all
6413     unset -nocomplain iddrawn
6414     unset -nocomplain linesegs
6415     unset -nocomplain linehtag
6416     unset -nocomplain linentag
6417     unset -nocomplain linedtag
6418     set boldids {}
6419     set boldnameids {}
6420     unset -nocomplain vhighlights
6421     unset -nocomplain fhighlights
6422     unset -nocomplain nhighlights
6423     unset -nocomplain rhighlights
6424     set need_redisplay 0
6425     set nrows_drawn 0
6426 }
6427
6428 proc findcrossings {id} {
6429     global rowidlist parentlist numcommits displayorder
6430
6431     set cross {}
6432     set ccross {}
6433     foreach {s e} [rowranges $id] {
6434         if {$e >= $numcommits} {
6435             set e [expr {$numcommits - 1}]
6436         }
6437         if {$e <= $s} continue
6438         for {set row $e} {[incr row -1] >= $s} {} {
6439             set x [lsearch -exact [lindex $rowidlist $row] $id]
6440             if {$x < 0} break
6441             set olds [lindex $parentlist $row]
6442             set kid [lindex $displayorder $row]
6443             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6444             if {$kidx < 0} continue
6445             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6446             foreach p $olds {
6447                 set px [lsearch -exact $nextrow $p]
6448                 if {$px < 0} continue
6449                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6450                     if {[lsearch -exact $ccross $p] >= 0} continue
6451                     if {$x == $px + ($kidx < $px? -1: 1)} {
6452                         lappend ccross $p
6453                     } elseif {[lsearch -exact $cross $p] < 0} {
6454                         lappend cross $p
6455                     }
6456                 }
6457             }
6458         }
6459     }
6460     return [concat $ccross {{}} $cross]
6461 }
6462
6463 proc assigncolor {id} {
6464     global colormap colors nextcolor
6465     global parents children children curview
6466
6467     if {[info exists colormap($id)]} return
6468     set ncolors [llength $colors]
6469     if {[info exists children($curview,$id)]} {
6470         set kids $children($curview,$id)
6471     } else {
6472         set kids {}
6473     }
6474     if {[llength $kids] == 1} {
6475         set child [lindex $kids 0]
6476         if {[info exists colormap($child)]
6477             && [llength $parents($curview,$child)] == 1} {
6478             set colormap($id) $colormap($child)
6479             return
6480         }
6481     }
6482     set badcolors {}
6483     set origbad {}
6484     foreach x [findcrossings $id] {
6485         if {$x eq {}} {
6486             # delimiter between corner crossings and other crossings
6487             if {[llength $badcolors] >= $ncolors - 1} break
6488             set origbad $badcolors
6489         }
6490         if {[info exists colormap($x)]
6491             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6492             lappend badcolors $colormap($x)
6493         }
6494     }
6495     if {[llength $badcolors] >= $ncolors} {
6496         set badcolors $origbad
6497     }
6498     set origbad $badcolors
6499     if {[llength $badcolors] < $ncolors - 1} {
6500         foreach child $kids {
6501             if {[info exists colormap($child)]
6502                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6503                 lappend badcolors $colormap($child)
6504             }
6505             foreach p $parents($curview,$child) {
6506                 if {[info exists colormap($p)]
6507                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6508                     lappend badcolors $colormap($p)
6509                 }
6510             }
6511         }
6512         if {[llength $badcolors] >= $ncolors} {
6513             set badcolors $origbad
6514         }
6515     }
6516     for {set i 0} {$i <= $ncolors} {incr i} {
6517         set c [lindex $colors $nextcolor]
6518         if {[incr nextcolor] >= $ncolors} {
6519             set nextcolor 0
6520         }
6521         if {[lsearch -exact $badcolors $c]} break
6522     }
6523     set colormap($id) $c
6524 }
6525
6526 proc bindline {t id} {
6527     global canv
6528
6529     $canv bind $t <Enter> "lineenter %x %y $id"
6530     $canv bind $t <Motion> "linemotion %x %y $id"
6531     $canv bind $t <Leave> "lineleave $id"
6532     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6533 }
6534
6535 proc graph_pane_width {} {
6536     global use_ttk
6537
6538     if {$use_ttk} {
6539         set g [.tf.histframe.pwclist sashpos 0]
6540     } else {
6541         set g [.tf.histframe.pwclist sash coord 0]
6542     }
6543     return [lindex $g 0]
6544 }
6545
6546 proc totalwidth {l font extra} {
6547     set tot 0
6548     foreach str $l {
6549         set tot [expr {$tot + [font measure $font $str] + $extra}]
6550     }
6551     return $tot
6552 }
6553
6554 proc drawtags {id x xt y1} {
6555     global idtags idheads idotherrefs mainhead
6556     global linespc lthickness
6557     global canv rowtextx curview fgcolor bgcolor ctxbut
6558     global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6559     global tagbgcolor tagfgcolor tagoutlinecolor
6560     global reflinecolor
6561
6562     set marks {}
6563     set ntags 0
6564     set nheads 0
6565     set singletag 0
6566     set maxtags 3
6567     set maxtagpct 25
6568     set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6569     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6570     set extra [expr {$delta + $lthickness + $linespc}]
6571
6572     if {[info exists idtags($id)]} {
6573         set marks $idtags($id)
6574         set ntags [llength $marks]
6575         if {$ntags > $maxtags ||
6576             [totalwidth $marks mainfont $extra] > $maxwidth} {
6577             # show just a single "n tags..." tag
6578             set singletag 1
6579             if {$ntags == 1} {
6580                 set marks [list "tag..."]
6581             } else {
6582                 set marks [list [format "%d tags..." $ntags]]
6583             }
6584             set ntags 1
6585         }
6586     }
6587     if {[info exists idheads($id)]} {
6588         set marks [concat $marks $idheads($id)]
6589         set nheads [llength $idheads($id)]
6590     }
6591     if {[info exists idotherrefs($id)]} {
6592         set marks [concat $marks $idotherrefs($id)]
6593     }
6594     if {$marks eq {}} {
6595         return $xt
6596     }
6597
6598     set yt [expr {$y1 - 0.5 * $linespc}]
6599     set yb [expr {$yt + $linespc - 1}]
6600     set xvals {}
6601     set wvals {}
6602     set i -1
6603     foreach tag $marks {
6604         incr i
6605         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6606             set wid [font measure mainfontbold $tag]
6607         } else {
6608             set wid [font measure mainfont $tag]
6609         }
6610         lappend xvals $xt
6611         lappend wvals $wid
6612         set xt [expr {$xt + $wid + $extra}]
6613     }
6614     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6615                -width $lthickness -fill $reflinecolor -tags tag.$id]
6616     $canv lower $t
6617     foreach tag $marks x $xvals wid $wvals {
6618         set tag_quoted [string map {% %%} $tag]
6619         set xl [expr {$x + $delta}]
6620         set xr [expr {$x + $delta + $wid + $lthickness}]
6621         set font mainfont
6622         if {[incr ntags -1] >= 0} {
6623             # draw a tag
6624             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6625                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6626                        -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6627                        -tags tag.$id]
6628             if {$singletag} {
6629                 set tagclick [list showtags $id 1]
6630             } else {
6631                 set tagclick [list showtag $tag_quoted 1]
6632             }
6633             $canv bind $t <1> $tagclick
6634             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6635         } else {
6636             # draw a head or other ref
6637             if {[incr nheads -1] >= 0} {
6638                 set col $headbgcolor
6639                 if {$tag eq $mainhead} {
6640                     set font mainfontbold
6641                 }
6642             } else {
6643                 set col "#ddddff"
6644             }
6645             set xl [expr {$xl - $delta/2}]
6646             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6647                 -width 1 -outline black -fill $col -tags tag.$id
6648             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6649                 set rwid [font measure mainfont $remoteprefix]
6650                 set xi [expr {$x + 1}]
6651                 set yti [expr {$yt + 1}]
6652                 set xri [expr {$x + $rwid}]
6653                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6654                         -width 0 -fill $remotebgcolor -tags tag.$id
6655             }
6656         }
6657         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6658                    -font $font -tags [list tag.$id text]]
6659         if {$ntags >= 0} {
6660             $canv bind $t <1> $tagclick
6661         } elseif {$nheads >= 0} {
6662             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6663         }
6664     }
6665     return $xt
6666 }
6667
6668 proc drawnotesign {xt y} {
6669     global linespc canv fgcolor
6670
6671     set orad [expr {$linespc / 3}]
6672     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6673                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6674                -fill yellow -outline $fgcolor -width 1 -tags circle]
6675     set xt [expr {$xt + $orad * 3}]
6676     return $xt
6677 }
6678
6679 proc xcoord {i level ln} {
6680     global canvx0 xspc1 xspc2
6681
6682     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6683     if {$i > 0 && $i == $level} {
6684         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6685     } elseif {$i > $level} {
6686         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6687     }
6688     return $x
6689 }
6690
6691 proc show_status {msg} {
6692     global canv fgcolor
6693
6694     clear_display
6695     set_window_title
6696     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6697         -tags text -fill $fgcolor
6698 }
6699
6700 # Don't change the text pane cursor if it is currently the hand cursor,
6701 # showing that we are over a sha1 ID link.
6702 proc settextcursor {c} {
6703     global ctext curtextcursor
6704
6705     if {[$ctext cget -cursor] == $curtextcursor} {
6706         $ctext config -cursor $c
6707     }
6708     set curtextcursor $c
6709 }
6710
6711 proc nowbusy {what {name {}}} {
6712     global isbusy busyname statusw
6713
6714     if {[array names isbusy] eq {}} {
6715         . config -cursor watch
6716         settextcursor watch
6717     }
6718     set isbusy($what) 1
6719     set busyname($what) $name
6720     if {$name ne {}} {
6721         $statusw conf -text $name
6722     }
6723 }
6724
6725 proc notbusy {what} {
6726     global isbusy maincursor textcursor busyname statusw
6727
6728     catch {
6729         unset isbusy($what)
6730         if {$busyname($what) ne {} &&
6731             [$statusw cget -text] eq $busyname($what)} {
6732             $statusw conf -text {}
6733         }
6734     }
6735     if {[array names isbusy] eq {}} {
6736         . config -cursor $maincursor
6737         settextcursor $textcursor
6738     }
6739 }
6740
6741 proc findmatches {f} {
6742     global findtype findstring
6743     if {$findtype == [mc "Regexp"]} {
6744         set matches [regexp -indices -all -inline $findstring $f]
6745     } else {
6746         set fs $findstring
6747         if {$findtype == [mc "IgnCase"]} {
6748             set f [string tolower $f]
6749             set fs [string tolower $fs]
6750         }
6751         set matches {}
6752         set i 0
6753         set l [string length $fs]
6754         while {[set j [string first $fs $f $i]] >= 0} {
6755             lappend matches [list $j [expr {$j+$l-1}]]
6756             set i [expr {$j + $l}]
6757         }
6758     }
6759     return $matches
6760 }
6761
6762 proc dofind {{dirn 1} {wrap 1}} {
6763     global findstring findstartline findcurline selectedline numcommits
6764     global gdttype filehighlight fh_serial find_dirn findallowwrap
6765
6766     if {[info exists find_dirn]} {
6767         if {$find_dirn == $dirn} return
6768         stopfinding
6769     }
6770     focus .
6771     if {$findstring eq {} || $numcommits == 0} return
6772     if {$selectedline eq {}} {
6773         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6774     } else {
6775         set findstartline $selectedline
6776     }
6777     set findcurline $findstartline
6778     nowbusy finding [mc "Searching"]
6779     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6780         after cancel do_file_hl $fh_serial
6781         do_file_hl $fh_serial
6782     }
6783     set find_dirn $dirn
6784     set findallowwrap $wrap
6785     run findmore
6786 }
6787
6788 proc stopfinding {} {
6789     global find_dirn findcurline fprogcoord
6790
6791     if {[info exists find_dirn]} {
6792         unset find_dirn
6793         unset findcurline
6794         notbusy finding
6795         set fprogcoord 0
6796         adjustprogress
6797     }
6798     stopblaming
6799 }
6800
6801 proc findmore {} {
6802     global commitdata commitinfo numcommits findpattern findloc
6803     global findstartline findcurline findallowwrap
6804     global find_dirn gdttype fhighlights fprogcoord
6805     global curview varcorder vrownum varccommits vrowmod
6806
6807     if {![info exists find_dirn]} {
6808         return 0
6809     }
6810     set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6811     set l $findcurline
6812     set moretodo 0
6813     if {$find_dirn > 0} {
6814         incr l
6815         if {$l >= $numcommits} {
6816             set l 0
6817         }
6818         if {$l <= $findstartline} {
6819             set lim [expr {$findstartline + 1}]
6820         } else {
6821             set lim $numcommits
6822             set moretodo $findallowwrap
6823         }
6824     } else {
6825         if {$l == 0} {
6826             set l $numcommits
6827         }
6828         incr l -1
6829         if {$l >= $findstartline} {
6830             set lim [expr {$findstartline - 1}]
6831         } else {
6832             set lim -1
6833             set moretodo $findallowwrap
6834         }
6835     }
6836     set n [expr {($lim - $l) * $find_dirn}]
6837     if {$n > 500} {
6838         set n 500
6839         set moretodo 1
6840     }
6841     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6842         update_arcrows $curview
6843     }
6844     set found 0
6845     set domore 1
6846     set ai [bsearch $vrownum($curview) $l]
6847     set a [lindex $varcorder($curview) $ai]
6848     set arow [lindex $vrownum($curview) $ai]
6849     set ids [lindex $varccommits($curview,$a)]
6850     set arowend [expr {$arow + [llength $ids]}]
6851     if {$gdttype eq [mc "containing:"]} {
6852         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6853             if {$l < $arow || $l >= $arowend} {
6854                 incr ai $find_dirn
6855                 set a [lindex $varcorder($curview) $ai]
6856                 set arow [lindex $vrownum($curview) $ai]
6857                 set ids [lindex $varccommits($curview,$a)]
6858                 set arowend [expr {$arow + [llength $ids]}]
6859             }
6860             set id [lindex $ids [expr {$l - $arow}]]
6861             # shouldn't happen unless git log doesn't give all the commits...
6862             if {![info exists commitdata($id)] ||
6863                 ![doesmatch $commitdata($id)]} {
6864                 continue
6865             }
6866             if {![info exists commitinfo($id)]} {
6867                 getcommit $id
6868             }
6869             set info $commitinfo($id)
6870             foreach f $info ty $fldtypes {
6871                 if {$ty eq ""} continue
6872                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6873                     [doesmatch $f]} {
6874                     set found 1
6875                     break
6876                 }
6877             }
6878             if {$found} break
6879         }
6880     } else {
6881         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6882             if {$l < $arow || $l >= $arowend} {
6883                 incr ai $find_dirn
6884                 set a [lindex $varcorder($curview) $ai]
6885                 set arow [lindex $vrownum($curview) $ai]
6886                 set ids [lindex $varccommits($curview,$a)]
6887                 set arowend [expr {$arow + [llength $ids]}]
6888             }
6889             set id [lindex $ids [expr {$l - $arow}]]
6890             if {![info exists fhighlights($id)]} {
6891                 # this sets fhighlights($id) to -1
6892                 askfilehighlight $l $id
6893             }
6894             if {$fhighlights($id) > 0} {
6895                 set found $domore
6896                 break
6897             }
6898             if {$fhighlights($id) < 0} {
6899                 if {$domore} {
6900                     set domore 0
6901                     set findcurline [expr {$l - $find_dirn}]
6902                 }
6903             }
6904         }
6905     }
6906     if {$found || ($domore && !$moretodo)} {
6907         unset findcurline
6908         unset find_dirn
6909         notbusy finding
6910         set fprogcoord 0
6911         adjustprogress
6912         if {$found} {
6913             findselectline $l
6914         } else {
6915             bell
6916         }
6917         return 0
6918     }
6919     if {!$domore} {
6920         flushhighlights
6921     } else {
6922         set findcurline [expr {$l - $find_dirn}]
6923     }
6924     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6925     if {$n < 0} {
6926         incr n $numcommits
6927     }
6928     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6929     adjustprogress
6930     return $domore
6931 }
6932
6933 proc findselectline {l} {
6934     global findloc commentend ctext findcurline markingmatches gdttype
6935
6936     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6937     set findcurline $l
6938     selectline $l 1
6939     if {$markingmatches &&
6940         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6941         # highlight the matches in the comments
6942         set f [$ctext get 1.0 $commentend]
6943         set matches [findmatches $f]
6944         foreach match $matches {
6945             set start [lindex $match 0]
6946             set end [expr {[lindex $match 1] + 1}]
6947             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6948         }
6949     }
6950     drawvisible
6951 }
6952
6953 # mark the bits of a headline or author that match a find string
6954 proc markmatches {canv l str tag matches font row} {
6955     global selectedline
6956
6957     set bbox [$canv bbox $tag]
6958     set x0 [lindex $bbox 0]
6959     set y0 [lindex $bbox 1]
6960     set y1 [lindex $bbox 3]
6961     foreach match $matches {
6962         set start [lindex $match 0]
6963         set end [lindex $match 1]
6964         if {$start > $end} continue
6965         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6966         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6967         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6968                    [expr {$x0+$xlen+2}] $y1 \
6969                    -outline {} -tags [list match$l matches] -fill yellow]
6970         $canv lower $t
6971         if {$row == $selectedline} {
6972             $canv raise $t secsel
6973         }
6974     }
6975 }
6976
6977 proc unmarkmatches {} {
6978     global markingmatches
6979
6980     allcanvs delete matches
6981     set markingmatches 0
6982     stopfinding
6983 }
6984
6985 proc selcanvline {w x y} {
6986     global canv canvy0 ctext linespc
6987     global rowtextx
6988     set ymax [lindex [$canv cget -scrollregion] 3]
6989     if {$ymax == {}} return
6990     set yfrac [lindex [$canv yview] 0]
6991     set y [expr {$y + $yfrac * $ymax}]
6992     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6993     if {$l < 0} {
6994         set l 0
6995     }
6996     if {$w eq $canv} {
6997         set xmax [lindex [$canv cget -scrollregion] 2]
6998         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6999         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
7000     }
7001     unmarkmatches
7002     selectline $l 1
7003 }
7004
7005 proc commit_descriptor {p} {
7006     global commitinfo
7007     if {![info exists commitinfo($p)]} {
7008         getcommit $p
7009     }
7010     set l "..."
7011     if {[llength $commitinfo($p)] > 1} {
7012         set l [lindex $commitinfo($p) 0]
7013     }
7014     return "$p ($l)\n"
7015 }
7016
7017 # append some text to the ctext widget, and make any SHA1 ID
7018 # that we know about be a clickable link.
7019 proc appendwithlinks {text tags} {
7020     global ctext linknum curview
7021
7022     set start [$ctext index "end - 1c"]
7023     $ctext insert end $text $tags
7024     set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7025     foreach l $links {
7026         set s [lindex $l 0]
7027         set e [lindex $l 1]
7028         set linkid [string range $text $s $e]
7029         incr e
7030         $ctext tag delete link$linknum
7031         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7032         setlink $linkid link$linknum
7033         incr linknum
7034     }
7035 }
7036
7037 proc setlink {id lk} {
7038     global curview ctext pendinglinks
7039     global linkfgcolor
7040
7041     if {[string range $id 0 1] eq "-g"} {
7042       set id [string range $id 2 end]
7043     }
7044
7045     set known 0
7046     if {[string length $id] < 40} {
7047         set matches [longid $id]
7048         if {[llength $matches] > 0} {
7049             if {[llength $matches] > 1} return
7050             set known 1
7051             set id [lindex $matches 0]
7052         }
7053     } else {
7054         set known [commitinview $id $curview]
7055     }
7056     if {$known} {
7057         $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7058         $ctext tag bind $lk <1> [list selbyid $id]
7059         $ctext tag bind $lk <Enter> {linkcursor %W 1}
7060         $ctext tag bind $lk <Leave> {linkcursor %W -1}
7061     } else {
7062         lappend pendinglinks($id) $lk
7063         interestedin $id {makelink %P}
7064     }
7065 }
7066
7067 proc appendshortlink {id {pre {}} {post {}}} {
7068     global ctext linknum
7069
7070     $ctext insert end $pre
7071     $ctext tag delete link$linknum
7072     $ctext insert end [string range $id 0 7] link$linknum
7073     $ctext insert end $post
7074     setlink $id link$linknum
7075     incr linknum
7076 }
7077
7078 proc makelink {id} {
7079     global pendinglinks
7080
7081     if {![info exists pendinglinks($id)]} return
7082     foreach lk $pendinglinks($id) {
7083         setlink $id $lk
7084     }
7085     unset pendinglinks($id)
7086 }
7087
7088 proc linkcursor {w inc} {
7089     global linkentercount curtextcursor
7090
7091     if {[incr linkentercount $inc] > 0} {
7092         $w configure -cursor hand2
7093     } else {
7094         $w configure -cursor $curtextcursor
7095         if {$linkentercount < 0} {
7096             set linkentercount 0
7097         }
7098     }
7099 }
7100
7101 proc viewnextline {dir} {
7102     global canv linespc
7103
7104     $canv delete hover
7105     set ymax [lindex [$canv cget -scrollregion] 3]
7106     set wnow [$canv yview]
7107     set wtop [expr {[lindex $wnow 0] * $ymax}]
7108     set newtop [expr {$wtop + $dir * $linespc}]
7109     if {$newtop < 0} {
7110         set newtop 0
7111     } elseif {$newtop > $ymax} {
7112         set newtop $ymax
7113     }
7114     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7115 }
7116
7117 # add a list of tag or branch names at position pos
7118 # returns the number of names inserted
7119 proc appendrefs {pos ids var} {
7120     global ctext linknum curview $var maxrefs visiblerefs mainheadid
7121
7122     if {[catch {$ctext index $pos}]} {
7123         return 0
7124     }
7125     $ctext conf -state normal
7126     $ctext delete $pos "$pos lineend"
7127     set tags {}
7128     foreach id $ids {
7129         foreach tag [set $var\($id\)] {
7130             lappend tags [list $tag $id]
7131         }
7132     }
7133
7134     set sep {}
7135     set tags [lsort -index 0 -decreasing $tags]
7136     set nutags 0
7137
7138     if {[llength $tags] > $maxrefs} {
7139         # If we are displaying heads, and there are too many,
7140         # see if there are some important heads to display.
7141         # Currently that are the current head and heads listed in $visiblerefs option
7142         set itags {}
7143         if {$var eq "idheads"} {
7144             set utags {}
7145             foreach ti $tags {
7146                 set hname [lindex $ti 0]
7147                 set id [lindex $ti 1]
7148                 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7149                     [llength $itags] < $maxrefs} {
7150                     lappend itags $ti
7151                 } else {
7152                     lappend utags $ti
7153                 }
7154             }
7155             set tags $utags
7156         }
7157         if {$itags ne {}} {
7158             set str [mc "and many more"]
7159             set sep " "
7160         } else {
7161             set str [mc "many"]
7162         }
7163         $ctext insert $pos "$str ([llength $tags])"
7164         set nutags [llength $tags]
7165         set tags $itags
7166     }
7167
7168     foreach ti $tags {
7169         set id [lindex $ti 1]
7170         set lk link$linknum
7171         incr linknum
7172         $ctext tag delete $lk
7173         $ctext insert $pos $sep
7174         $ctext insert $pos [lindex $ti 0] $lk
7175         setlink $id $lk
7176         set sep ", "
7177     }
7178     $ctext tag add wwrap "$pos linestart" "$pos lineend"
7179     $ctext conf -state disabled
7180     return [expr {[llength $tags] + $nutags}]
7181 }
7182
7183 # called when we have finished computing the nearby tags
7184 proc dispneartags {delay} {
7185     global selectedline currentid showneartags tagphase
7186
7187     if {$selectedline eq {} || !$showneartags} return
7188     after cancel dispnexttag
7189     if {$delay} {
7190         after 200 dispnexttag
7191         set tagphase -1
7192     } else {
7193         after idle dispnexttag
7194         set tagphase 0
7195     }
7196 }
7197
7198 proc dispnexttag {} {
7199     global selectedline currentid showneartags tagphase ctext
7200
7201     if {$selectedline eq {} || !$showneartags} return
7202     switch -- $tagphase {
7203         0 {
7204             set dtags [desctags $currentid]
7205             if {$dtags ne {}} {
7206                 appendrefs precedes $dtags idtags
7207             }
7208         }
7209         1 {
7210             set atags [anctags $currentid]
7211             if {$atags ne {}} {
7212                 appendrefs follows $atags idtags
7213             }
7214         }
7215         2 {
7216             set dheads [descheads $currentid]
7217             if {$dheads ne {}} {
7218                 if {[appendrefs branch $dheads idheads] > 1
7219                     && [$ctext get "branch -3c"] eq "h"} {
7220                     # turn "Branch" into "Branches"
7221                     $ctext conf -state normal
7222                     $ctext insert "branch -2c" "es"
7223                     $ctext conf -state disabled
7224                 }
7225             }
7226         }
7227     }
7228     if {[incr tagphase] <= 2} {
7229         after idle dispnexttag
7230     }
7231 }
7232
7233 proc make_secsel {id} {
7234     global linehtag linentag linedtag canv canv2 canv3
7235
7236     if {![info exists linehtag($id)]} return
7237     $canv delete secsel
7238     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7239                -tags secsel -fill [$canv cget -selectbackground]]
7240     $canv lower $t
7241     $canv2 delete secsel
7242     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7243                -tags secsel -fill [$canv2 cget -selectbackground]]
7244     $canv2 lower $t
7245     $canv3 delete secsel
7246     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7247                -tags secsel -fill [$canv3 cget -selectbackground]]
7248     $canv3 lower $t
7249 }
7250
7251 proc make_idmark {id} {
7252     global linehtag canv fgcolor
7253
7254     if {![info exists linehtag($id)]} return
7255     $canv delete markid
7256     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7257                -tags markid -outline $fgcolor]
7258     $canv raise $t
7259 }
7260
7261 proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7262     global canv ctext commitinfo selectedline
7263     global canvy0 linespc parents children curview
7264     global currentid sha1entry
7265     global commentend idtags linknum
7266     global mergemax numcommits pending_select
7267     global cmitmode showneartags allcommits
7268     global targetrow targetid lastscrollrows
7269     global autoselect autosellen jump_to_here
7270     global vinlinediff
7271
7272     unset -nocomplain pending_select
7273     $canv delete hover
7274     normalline
7275     unsel_reflist
7276     stopfinding
7277     if {$l < 0 || $l >= $numcommits} return
7278     set id [commitonrow $l]
7279     set targetid $id
7280     set targetrow $l
7281     set selectedline $l
7282     set currentid $id
7283     if {$lastscrollrows < $numcommits} {
7284         setcanvscroll
7285     }
7286
7287     if {$cmitmode ne "patch" && $switch_to_patch} {
7288         set cmitmode "patch"
7289     }
7290
7291     set y [expr {$canvy0 + $l * $linespc}]
7292     set ymax [lindex [$canv cget -scrollregion] 3]
7293     set ytop [expr {$y - $linespc - 1}]
7294     set ybot [expr {$y + $linespc + 1}]
7295     set wnow [$canv yview]
7296     set wtop [expr {[lindex $wnow 0] * $ymax}]
7297     set wbot [expr {[lindex $wnow 1] * $ymax}]
7298     set wh [expr {$wbot - $wtop}]
7299     set newtop $wtop
7300     if {$ytop < $wtop} {
7301         if {$ybot < $wtop} {
7302             set newtop [expr {$y - $wh / 2.0}]
7303         } else {
7304             set newtop $ytop
7305             if {$newtop > $wtop - $linespc} {
7306                 set newtop [expr {$wtop - $linespc}]
7307             }
7308         }
7309     } elseif {$ybot > $wbot} {
7310         if {$ytop > $wbot} {
7311             set newtop [expr {$y - $wh / 2.0}]
7312         } else {
7313             set newtop [expr {$ybot - $wh}]
7314             if {$newtop < $wtop + $linespc} {
7315                 set newtop [expr {$wtop + $linespc}]
7316             }
7317         }
7318     }
7319     if {$newtop != $wtop} {
7320         if {$newtop < 0} {
7321             set newtop 0
7322         }
7323         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7324         drawvisible
7325     }
7326
7327     make_secsel $id
7328
7329     if {$isnew} {
7330         addtohistory [list selbyid $id 0] savecmitpos
7331     }
7332
7333     $sha1entry delete 0 end
7334     $sha1entry insert 0 $id
7335     if {$autoselect} {
7336         $sha1entry selection range 0 $autosellen
7337     }
7338     rhighlight_sel $id
7339
7340     $ctext conf -state normal
7341     clear_ctext
7342     set linknum 0
7343     if {![info exists commitinfo($id)]} {
7344         getcommit $id
7345     }
7346     set info $commitinfo($id)
7347     set date [formatdate [lindex $info 2]]
7348     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7349     set date [formatdate [lindex $info 4]]
7350     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7351     if {[info exists idtags($id)]} {
7352         $ctext insert end [mc "Tags:"]
7353         foreach tag $idtags($id) {
7354             $ctext insert end " $tag"
7355         }
7356         $ctext insert end "\n"
7357     }
7358
7359     set headers {}
7360     set olds $parents($curview,$id)
7361     if {[llength $olds] > 1} {
7362         set np 0
7363         foreach p $olds {
7364             if {$np >= $mergemax} {
7365                 set tag mmax
7366             } else {
7367                 set tag m$np
7368             }
7369             $ctext insert end "[mc "Parent"]: " $tag
7370             appendwithlinks [commit_descriptor $p] {}
7371             incr np
7372         }
7373     } else {
7374         foreach p $olds {
7375             append headers "[mc "Parent"]: [commit_descriptor $p]"
7376         }
7377     }
7378
7379     foreach c $children($curview,$id) {
7380         append headers "[mc "Child"]:  [commit_descriptor $c]"
7381     }
7382
7383     # make anything that looks like a SHA1 ID be a clickable link
7384     appendwithlinks $headers {}
7385     if {$showneartags} {
7386         if {![info exists allcommits]} {
7387             getallcommits
7388         }
7389         $ctext insert end "[mc "Branch"]: "
7390         $ctext mark set branch "end -1c"
7391         $ctext mark gravity branch left
7392         $ctext insert end "\n[mc "Follows"]: "
7393         $ctext mark set follows "end -1c"
7394         $ctext mark gravity follows left
7395         $ctext insert end "\n[mc "Precedes"]: "
7396         $ctext mark set precedes "end -1c"
7397         $ctext mark gravity precedes left
7398         $ctext insert end "\n"
7399         dispneartags 1
7400     }
7401     $ctext insert end "\n"
7402     set comment [lindex $info 5]
7403     if {[string first "\r" $comment] >= 0} {
7404         set comment [string map {"\r" "\n    "} $comment]
7405     }
7406     appendwithlinks $comment {comment}
7407
7408     $ctext tag remove found 1.0 end
7409     $ctext conf -state disabled
7410     set commentend [$ctext index "end - 1c"]
7411
7412     set jump_to_here $desired_loc
7413     init_flist [mc "Comments"]
7414     if {$cmitmode eq "tree"} {
7415         gettree $id
7416     } elseif {$vinlinediff($curview) == 1} {
7417         showinlinediff $id
7418     } elseif {[llength $olds] <= 1} {
7419         startdiff $id
7420     } else {
7421         mergediff $id
7422     }
7423 }
7424
7425 proc selfirstline {} {
7426     unmarkmatches
7427     selectline 0 1
7428 }
7429
7430 proc sellastline {} {
7431     global numcommits
7432     unmarkmatches
7433     set l [expr {$numcommits - 1}]
7434     selectline $l 1
7435 }
7436
7437 proc selnextline {dir} {
7438     global selectedline
7439     focus .
7440     if {$selectedline eq {}} return
7441     set l [expr {$selectedline + $dir}]
7442     unmarkmatches
7443     selectline $l 1
7444 }
7445
7446 proc selnextpage {dir} {
7447     global canv linespc selectedline numcommits
7448
7449     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7450     if {$lpp < 1} {
7451         set lpp 1
7452     }
7453     allcanvs yview scroll [expr {$dir * $lpp}] units
7454     drawvisible
7455     if {$selectedline eq {}} return
7456     set l [expr {$selectedline + $dir * $lpp}]
7457     if {$l < 0} {
7458         set l 0
7459     } elseif {$l >= $numcommits} {
7460         set l [expr $numcommits - 1]
7461     }
7462     unmarkmatches
7463     selectline $l 1
7464 }
7465
7466 proc unselectline {} {
7467     global selectedline currentid
7468
7469     set selectedline {}
7470     unset -nocomplain currentid
7471     allcanvs delete secsel
7472     rhighlight_none
7473 }
7474
7475 proc reselectline {} {
7476     global selectedline
7477
7478     if {$selectedline ne {}} {
7479         selectline $selectedline 0
7480     }
7481 }
7482
7483 proc addtohistory {cmd {saveproc {}}} {
7484     global history historyindex curview
7485
7486     unset_posvars
7487     save_position
7488     set elt [list $curview $cmd $saveproc {}]
7489     if {$historyindex > 0
7490         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7491         return
7492     }
7493
7494     if {$historyindex < [llength $history]} {
7495         set history [lreplace $history $historyindex end $elt]
7496     } else {
7497         lappend history $elt
7498     }
7499     incr historyindex
7500     if {$historyindex > 1} {
7501         .tf.bar.leftbut conf -state normal
7502     } else {
7503         .tf.bar.leftbut conf -state disabled
7504     }
7505     .tf.bar.rightbut conf -state disabled
7506 }
7507
7508 # save the scrolling position of the diff display pane
7509 proc save_position {} {
7510     global historyindex history
7511
7512     if {$historyindex < 1} return
7513     set hi [expr {$historyindex - 1}]
7514     set fn [lindex $history $hi 2]
7515     if {$fn ne {}} {
7516         lset history $hi 3 [eval $fn]
7517     }
7518 }
7519
7520 proc unset_posvars {} {
7521     global last_posvars
7522
7523     if {[info exists last_posvars]} {
7524         foreach {var val} $last_posvars {
7525             global $var
7526             unset -nocomplain $var
7527         }
7528         unset last_posvars
7529     }
7530 }
7531
7532 proc godo {elt} {
7533     global curview last_posvars
7534
7535     set view [lindex $elt 0]
7536     set cmd [lindex $elt 1]
7537     set pv [lindex $elt 3]
7538     if {$curview != $view} {
7539         showview $view
7540     }
7541     unset_posvars
7542     foreach {var val} $pv {
7543         global $var
7544         set $var $val
7545     }
7546     set last_posvars $pv
7547     eval $cmd
7548 }
7549
7550 proc goback {} {
7551     global history historyindex
7552     focus .
7553
7554     if {$historyindex > 1} {
7555         save_position
7556         incr historyindex -1
7557         godo [lindex $history [expr {$historyindex - 1}]]
7558         .tf.bar.rightbut conf -state normal
7559     }
7560     if {$historyindex <= 1} {
7561         .tf.bar.leftbut conf -state disabled
7562     }
7563 }
7564
7565 proc goforw {} {
7566     global history historyindex
7567     focus .
7568
7569     if {$historyindex < [llength $history]} {
7570         save_position
7571         set cmd [lindex $history $historyindex]
7572         incr historyindex
7573         godo $cmd
7574         .tf.bar.leftbut conf -state normal
7575     }
7576     if {$historyindex >= [llength $history]} {
7577         .tf.bar.rightbut conf -state disabled
7578     }
7579 }
7580
7581 proc go_to_parent {i} {
7582     global parents curview targetid
7583     set ps $parents($curview,$targetid)
7584     if {[llength $ps] >= $i} {
7585         selbyid [lindex $ps [expr $i - 1]]
7586     }
7587 }
7588
7589 proc gettree {id} {
7590     global treefilelist treeidlist diffids diffmergeid treepending
7591     global nullid nullid2
7592
7593     set diffids $id
7594     unset -nocomplain diffmergeid
7595     if {![info exists treefilelist($id)]} {
7596         if {![info exists treepending]} {
7597             if {$id eq $nullid} {
7598                 set cmd [list | git ls-files]
7599             } elseif {$id eq $nullid2} {
7600                 set cmd [list | git ls-files --stage -t]
7601             } else {
7602                 set cmd [list | git ls-tree -r $id]
7603             }
7604             if {[catch {set gtf [open $cmd r]}]} {
7605                 return
7606             }
7607             set treepending $id
7608             set treefilelist($id) {}
7609             set treeidlist($id) {}
7610             fconfigure $gtf -blocking 0 -encoding binary
7611             filerun $gtf [list gettreeline $gtf $id]
7612         }
7613     } else {
7614         setfilelist $id
7615     }
7616 }
7617
7618 proc gettreeline {gtf id} {
7619     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7620
7621     set nl 0
7622     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7623         if {$diffids eq $nullid} {
7624             set fname $line
7625         } else {
7626             set i [string first "\t" $line]
7627             if {$i < 0} continue
7628             set fname [string range $line [expr {$i+1}] end]
7629             set line [string range $line 0 [expr {$i-1}]]
7630             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7631             set sha1 [lindex $line 2]
7632             lappend treeidlist($id) $sha1
7633         }
7634         if {[string index $fname 0] eq "\""} {
7635             set fname [lindex $fname 0]
7636         }
7637         set fname [encoding convertfrom $fname]
7638         lappend treefilelist($id) $fname
7639     }
7640     if {![eof $gtf]} {
7641         return [expr {$nl >= 1000? 2: 1}]
7642     }
7643     close $gtf
7644     unset treepending
7645     if {$cmitmode ne "tree"} {
7646         if {![info exists diffmergeid]} {
7647             gettreediffs $diffids
7648         }
7649     } elseif {$id ne $diffids} {
7650         gettree $diffids
7651     } else {
7652         setfilelist $id
7653     }
7654     return 0
7655 }
7656
7657 proc showfile {f} {
7658     global treefilelist treeidlist diffids nullid nullid2
7659     global ctext_file_names ctext_file_lines
7660     global ctext commentend
7661
7662     set i [lsearch -exact $treefilelist($diffids) $f]
7663     if {$i < 0} {
7664         puts "oops, $f not in list for id $diffids"
7665         return
7666     }
7667     if {$diffids eq $nullid} {
7668         if {[catch {set bf [open $f r]} err]} {
7669             puts "oops, can't read $f: $err"
7670             return
7671         }
7672     } else {
7673         set blob [lindex $treeidlist($diffids) $i]
7674         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7675             puts "oops, error reading blob $blob: $err"
7676             return
7677         }
7678     }
7679     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7680     filerun $bf [list getblobline $bf $diffids]
7681     $ctext config -state normal
7682     clear_ctext $commentend
7683     lappend ctext_file_names $f
7684     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7685     $ctext insert end "\n"
7686     $ctext insert end "$f\n" filesep
7687     $ctext config -state disabled
7688     $ctext yview $commentend
7689     settabs 0
7690 }
7691
7692 proc getblobline {bf id} {
7693     global diffids cmitmode ctext
7694
7695     if {$id ne $diffids || $cmitmode ne "tree"} {
7696         catch {close $bf}
7697         return 0
7698     }
7699     $ctext config -state normal
7700     set nl 0
7701     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7702         $ctext insert end "$line\n"
7703     }
7704     if {[eof $bf]} {
7705         global jump_to_here ctext_file_names commentend
7706
7707         # delete last newline
7708         $ctext delete "end - 2c" "end - 1c"
7709         close $bf
7710         if {$jump_to_here ne {} &&
7711             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7712             set lnum [expr {[lindex $jump_to_here 1] +
7713                             [lindex [split $commentend .] 0]}]
7714             mark_ctext_line $lnum
7715         }
7716         $ctext config -state disabled
7717         return 0
7718     }
7719     $ctext config -state disabled
7720     return [expr {$nl >= 1000? 2: 1}]
7721 }
7722
7723 proc mark_ctext_line {lnum} {
7724     global ctext markbgcolor
7725
7726     $ctext tag delete omark
7727     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7728     $ctext tag conf omark -background $markbgcolor
7729     $ctext see $lnum.0
7730 }
7731
7732 proc mergediff {id} {
7733     global diffmergeid
7734     global diffids treediffs
7735     global parents curview
7736
7737     set diffmergeid $id
7738     set diffids $id
7739     set treediffs($id) {}
7740     set np [llength $parents($curview,$id)]
7741     settabs $np
7742     getblobdiffs $id
7743 }
7744
7745 proc startdiff {ids} {
7746     global treediffs diffids treepending diffmergeid nullid nullid2
7747
7748     settabs 1
7749     set diffids $ids
7750     unset -nocomplain diffmergeid
7751     if {![info exists treediffs($ids)] ||
7752         [lsearch -exact $ids $nullid] >= 0 ||
7753         [lsearch -exact $ids $nullid2] >= 0} {
7754         if {![info exists treepending]} {
7755             gettreediffs $ids
7756         }
7757     } else {
7758         addtocflist $ids
7759     }
7760 }
7761
7762 proc showinlinediff {ids} {
7763     global commitinfo commitdata ctext
7764     global treediffs
7765
7766     set info $commitinfo($ids)
7767     set diff [lindex $info 7]
7768     set difflines [split $diff "\n"]
7769
7770     initblobdiffvars
7771     set treediff {}
7772
7773     set inhdr 0
7774     foreach line $difflines {
7775         if {![string compare -length 5 "diff " $line]} {
7776             set inhdr 1
7777         } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7778             # offset also accounts for the b/ prefix
7779             lappend treediff [string range $line 6 end]
7780             set inhdr 0
7781         }
7782     }
7783
7784     set treediffs($ids) $treediff
7785     add_flist $treediff
7786
7787     $ctext conf -state normal
7788     foreach line $difflines {
7789         parseblobdiffline $ids $line
7790     }
7791     maybe_scroll_ctext 1
7792     $ctext conf -state disabled
7793 }
7794
7795 # If the filename (name) is under any of the passed filter paths
7796 # then return true to include the file in the listing.
7797 proc path_filter {filter name} {
7798     set worktree [gitworktree]
7799     foreach p $filter {
7800         set fq_p [file normalize $p]
7801         set fq_n [file normalize [file join $worktree $name]]
7802         if {[string match [file normalize $fq_p]* $fq_n]} {
7803             return 1
7804         }
7805     }
7806     return 0
7807 }
7808
7809 proc addtocflist {ids} {
7810     global treediffs
7811
7812     add_flist $treediffs($ids)
7813     getblobdiffs $ids
7814 }
7815
7816 proc diffcmd {ids flags} {
7817     global log_showroot nullid nullid2 git_version
7818
7819     set i [lsearch -exact $ids $nullid]
7820     set j [lsearch -exact $ids $nullid2]
7821     if {$i >= 0} {
7822         if {[llength $ids] > 1 && $j < 0} {
7823             # comparing working directory with some specific revision
7824             set cmd [concat | git diff-index $flags]
7825             if {$i == 0} {
7826                 lappend cmd -R [lindex $ids 1]
7827             } else {
7828                 lappend cmd [lindex $ids 0]
7829             }
7830         } else {
7831             # comparing working directory with index
7832             set cmd [concat | git diff-files $flags]
7833             if {$j == 1} {
7834                 lappend cmd -R
7835             }
7836         }
7837     } elseif {$j >= 0} {
7838         if {[package vcompare $git_version "1.7.2"] >= 0} {
7839             set flags "$flags --ignore-submodules=dirty"
7840         }
7841         set cmd [concat | git diff-index --cached $flags]
7842         if {[llength $ids] > 1} {
7843             # comparing index with specific revision
7844             if {$j == 0} {
7845                 lappend cmd -R [lindex $ids 1]
7846             } else {
7847                 lappend cmd [lindex $ids 0]
7848             }
7849         } else {
7850             # comparing index with HEAD
7851             lappend cmd HEAD
7852         }
7853     } else {
7854         if {$log_showroot} {
7855             lappend flags --root
7856         }
7857         set cmd [concat | git diff-tree -r $flags $ids]
7858     }
7859     return $cmd
7860 }
7861
7862 proc gettreediffs {ids} {
7863     global treediff treepending limitdiffs vfilelimit curview
7864
7865     set cmd [diffcmd $ids {--no-commit-id}]
7866     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7867             set cmd [concat $cmd -- $vfilelimit($curview)]
7868     }
7869     if {[catch {set gdtf [open $cmd r]}]} return
7870
7871     set treepending $ids
7872     set treediff {}
7873     fconfigure $gdtf -blocking 0 -encoding binary
7874     filerun $gdtf [list gettreediffline $gdtf $ids]
7875 }
7876
7877 proc gettreediffline {gdtf ids} {
7878     global treediff treediffs treepending diffids diffmergeid
7879     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7880
7881     set nr 0
7882     set sublist {}
7883     set max 1000
7884     if {$perfile_attrs} {
7885         # cache_gitattr is slow, and even slower on win32 where we
7886         # have to invoke it for only about 30 paths at a time
7887         set max 500
7888         if {[tk windowingsystem] == "win32"} {
7889             set max 120
7890         }
7891     }
7892     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7893         set i [string first "\t" $line]
7894         if {$i >= 0} {
7895             set file [string range $line [expr {$i+1}] end]
7896             if {[string index $file 0] eq "\""} {
7897                 set file [lindex $file 0]
7898             }
7899             set file [encoding convertfrom $file]
7900             if {$file ne [lindex $treediff end]} {
7901                 lappend treediff $file
7902                 lappend sublist $file
7903             }
7904         }
7905     }
7906     if {$perfile_attrs} {
7907         cache_gitattr encoding $sublist
7908     }
7909     if {![eof $gdtf]} {
7910         return [expr {$nr >= $max? 2: 1}]
7911     }
7912     close $gdtf
7913     set treediffs($ids) $treediff
7914     unset treepending
7915     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7916         gettree $diffids
7917     } elseif {$ids != $diffids} {
7918         if {![info exists diffmergeid]} {
7919             gettreediffs $diffids
7920         }
7921     } else {
7922         addtocflist $ids
7923     }
7924     return 0
7925 }
7926
7927 # empty string or positive integer
7928 proc diffcontextvalidate {v} {
7929     return [regexp {^(|[1-9][0-9]*)$} $v]
7930 }
7931
7932 proc diffcontextchange {n1 n2 op} {
7933     global diffcontextstring diffcontext
7934
7935     if {[string is integer -strict $diffcontextstring]} {
7936         if {$diffcontextstring >= 0} {
7937             set diffcontext $diffcontextstring
7938             reselectline
7939         }
7940     }
7941 }
7942
7943 proc changeignorespace {} {
7944     reselectline
7945 }
7946
7947 proc changeworddiff {name ix op} {
7948     reselectline
7949 }
7950
7951 proc initblobdiffvars {} {
7952     global diffencoding targetline diffnparents
7953     global diffinhdr currdiffsubmod diffseehere
7954     set targetline {}
7955     set diffnparents 0
7956     set diffinhdr 0
7957     set diffencoding [get_path_encoding {}]
7958     set currdiffsubmod ""
7959     set diffseehere -1
7960 }
7961
7962 proc getblobdiffs {ids} {
7963     global blobdifffd diffids env
7964     global treediffs
7965     global diffcontext
7966     global ignorespace
7967     global worddiff
7968     global limitdiffs vfilelimit curview
7969     global git_version
7970
7971     set textconv {}
7972     if {[package vcompare $git_version "1.6.1"] >= 0} {
7973         set textconv "--textconv"
7974     }
7975     set submodule {}
7976     if {[package vcompare $git_version "1.6.6"] >= 0} {
7977         set submodule "--submodule"
7978     }
7979     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7980     if {$ignorespace} {
7981         append cmd " -w"
7982     }
7983     if {$worddiff ne [mc "Line diff"]} {
7984         append cmd " --word-diff=porcelain"
7985     }
7986     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7987         set cmd [concat $cmd -- $vfilelimit($curview)]
7988     }
7989     if {[catch {set bdf [open $cmd r]} err]} {
7990         error_popup [mc "Error getting diffs: %s" $err]
7991         return
7992     }
7993     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7994     set blobdifffd($ids) $bdf
7995     initblobdiffvars
7996     filerun $bdf [list getblobdiffline $bdf $diffids]
7997 }
7998
7999 proc savecmitpos {} {
8000     global ctext cmitmode
8001
8002     if {$cmitmode eq "tree"} {
8003         return {}
8004     }
8005     return [list target_scrollpos [$ctext index @0,0]]
8006 }
8007
8008 proc savectextpos {} {
8009     global ctext
8010
8011     return [list target_scrollpos [$ctext index @0,0]]
8012 }
8013
8014 proc maybe_scroll_ctext {ateof} {
8015     global ctext target_scrollpos
8016
8017     if {![info exists target_scrollpos]} return
8018     if {!$ateof} {
8019         set nlines [expr {[winfo height $ctext]
8020                           / [font metrics textfont -linespace]}]
8021         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8022     }
8023     $ctext yview $target_scrollpos
8024     unset target_scrollpos
8025 }
8026
8027 proc setinlist {var i val} {
8028     global $var
8029
8030     while {[llength [set $var]] < $i} {
8031         lappend $var {}
8032     }
8033     if {[llength [set $var]] == $i} {
8034         lappend $var $val
8035     } else {
8036         lset $var $i $val
8037     }
8038 }
8039
8040 proc makediffhdr {fname ids} {
8041     global ctext curdiffstart treediffs diffencoding
8042     global ctext_file_names jump_to_here targetline diffline
8043
8044     set fname [encoding convertfrom $fname]
8045     set diffencoding [get_path_encoding $fname]
8046     set i [lsearch -exact $treediffs($ids) $fname]
8047     if {$i >= 0} {
8048         setinlist difffilestart $i $curdiffstart
8049     }
8050     lset ctext_file_names end $fname
8051     set l [expr {(78 - [string length $fname]) / 2}]
8052     set pad [string range "----------------------------------------" 1 $l]
8053     $ctext insert $curdiffstart "$pad $fname $pad" filesep
8054     set targetline {}
8055     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8056         set targetline [lindex $jump_to_here 1]
8057     }
8058     set diffline 0
8059 }
8060
8061 proc blobdiffmaybeseehere {ateof} {
8062     global diffseehere
8063     if {$diffseehere >= 0} {
8064         mark_ctext_line [lindex [split $diffseehere .] 0]
8065     }
8066     maybe_scroll_ctext $ateof
8067 }
8068
8069 proc getblobdiffline {bdf ids} {
8070     global diffids blobdifffd
8071     global ctext
8072
8073     set nr 0
8074     $ctext conf -state normal
8075     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8076         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8077             # Older diff read. Abort it.
8078             catch {close $bdf}
8079             if {$ids != $diffids} {
8080                 array unset blobdifffd $ids
8081             }
8082             return 0
8083         }
8084         parseblobdiffline $ids $line
8085     }
8086     $ctext conf -state disabled
8087     blobdiffmaybeseehere [eof $bdf]
8088     if {[eof $bdf]} {
8089         catch {close $bdf}
8090         array unset blobdifffd $ids
8091         return 0
8092     }
8093     return [expr {$nr >= 1000? 2: 1}]
8094 }
8095
8096 proc parseblobdiffline {ids line} {
8097     global ctext curdiffstart
8098     global diffnexthead diffnextnote difffilestart
8099     global ctext_file_names ctext_file_lines
8100     global diffinhdr treediffs mergemax diffnparents
8101     global diffencoding jump_to_here targetline diffline currdiffsubmod
8102     global worddiff diffseehere
8103
8104     if {![string compare -length 5 "diff " $line]} {
8105         if {![regexp {^diff (--cc|--git) } $line m type]} {
8106             set line [encoding convertfrom $line]
8107             $ctext insert end "$line\n" hunksep
8108             continue
8109         }
8110         # start of a new file
8111         set diffinhdr 1
8112         $ctext insert end "\n"
8113         set curdiffstart [$ctext index "end - 1c"]
8114         lappend ctext_file_names ""
8115         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8116         $ctext insert end "\n" filesep
8117
8118         if {$type eq "--cc"} {
8119             # start of a new file in a merge diff
8120             set fname [string range $line 10 end]
8121             if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8122                 lappend treediffs($ids) $fname
8123                 add_flist [list $fname]
8124             }
8125
8126         } else {
8127             set line [string range $line 11 end]
8128             # If the name hasn't changed the length will be odd,
8129             # the middle char will be a space, and the two bits either
8130             # side will be a/name and b/name, or "a/name" and "b/name".
8131             # If the name has changed we'll get "rename from" and
8132             # "rename to" or "copy from" and "copy to" lines following
8133             # this, and we'll use them to get the filenames.
8134             # This complexity is necessary because spaces in the
8135             # filename(s) don't get escaped.
8136             set l [string length $line]
8137             set i [expr {$l / 2}]
8138             if {!(($l & 1) && [string index $line $i] eq " " &&
8139                   [string range $line 2 [expr {$i - 1}]] eq \
8140                       [string range $line [expr {$i + 3}] end])} {
8141                 return
8142             }
8143             # unescape if quoted and chop off the a/ from the front
8144             if {[string index $line 0] eq "\""} {
8145                 set fname [string range [lindex $line 0] 2 end]
8146             } else {
8147                 set fname [string range $line 2 [expr {$i - 1}]]
8148             }
8149         }
8150         makediffhdr $fname $ids
8151
8152     } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8153         set fname [encoding convertfrom [string range $line 16 end]]
8154         $ctext insert end "\n"
8155         set curdiffstart [$ctext index "end - 1c"]
8156         lappend ctext_file_names $fname
8157         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8158         $ctext insert end "$line\n" filesep
8159         set i [lsearch -exact $treediffs($ids) $fname]
8160         if {$i >= 0} {
8161             setinlist difffilestart $i $curdiffstart
8162         }
8163
8164     } elseif {![string compare -length 2 "@@" $line]} {
8165         regexp {^@@+} $line ats
8166         set line [encoding convertfrom $diffencoding $line]
8167         $ctext insert end "$line\n" hunksep
8168         if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8169             set diffline $nl
8170         }
8171         set diffnparents [expr {[string length $ats] - 1}]
8172         set diffinhdr 0
8173
8174     } elseif {![string compare -length 10 "Submodule " $line]} {
8175         # start of a new submodule
8176         if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8177             set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8178         } else {
8179             set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8180         }
8181         if {$currdiffsubmod != $fname} {
8182             $ctext insert end "\n";     # Add newline after commit message
8183         }
8184         set curdiffstart [$ctext index "end - 1c"]
8185         lappend ctext_file_names ""
8186         if {$currdiffsubmod != $fname} {
8187             lappend ctext_file_lines $fname
8188             makediffhdr $fname $ids
8189             set currdiffsubmod $fname
8190             $ctext insert end "\n$line\n" filesep
8191         } else {
8192             $ctext insert end "$line\n" filesep
8193         }
8194     } elseif {![string compare -length 3 "  >" $line]} {
8195         set $currdiffsubmod ""
8196         set line [encoding convertfrom $diffencoding $line]
8197         $ctext insert end "$line\n" dresult
8198     } elseif {![string compare -length 3 "  <" $line]} {
8199         set $currdiffsubmod ""
8200         set line [encoding convertfrom $diffencoding $line]
8201         $ctext insert end "$line\n" d0
8202     } elseif {$diffinhdr} {
8203         if {![string compare -length 12 "rename from " $line]} {
8204             set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8205             if {[string index $fname 0] eq "\""} {
8206                 set fname [lindex $fname 0]
8207             }
8208             set fname [encoding convertfrom $fname]
8209             set i [lsearch -exact $treediffs($ids) $fname]
8210             if {$i >= 0} {
8211                 setinlist difffilestart $i $curdiffstart
8212             }
8213         } elseif {![string compare -length 10 $line "rename to "] ||
8214                   ![string compare -length 8 $line "copy to "]} {
8215             set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8216             if {[string index $fname 0] eq "\""} {
8217                 set fname [lindex $fname 0]
8218             }
8219             makediffhdr $fname $ids
8220         } elseif {[string compare -length 3 $line "---"] == 0} {
8221             # do nothing
8222             return
8223         } elseif {[string compare -length 3 $line "+++"] == 0} {
8224             set diffinhdr 0
8225             return
8226         }
8227         $ctext insert end "$line\n" filesep
8228
8229     } else {
8230         set line [string map {\x1A ^Z} \
8231                       [encoding convertfrom $diffencoding $line]]
8232         # parse the prefix - one ' ', '-' or '+' for each parent
8233         set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8234         set tag [expr {$diffnparents > 1? "m": "d"}]
8235         set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8236         set words_pre_markup ""
8237         set words_post_markup ""
8238         if {[string trim $prefix " -+"] eq {}} {
8239             # prefix only has " ", "-" and "+" in it: normal diff line
8240             set num [string first "-" $prefix]
8241             if {$dowords} {
8242                 set line [string range $line 1 end]
8243             }
8244             if {$num >= 0} {
8245                 # removed line, first parent with line is $num
8246                 if {$num >= $mergemax} {
8247                     set num "max"
8248                 }
8249                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8250                     $ctext insert end "\[-$line-\]" $tag$num
8251                 } else {
8252                     $ctext insert end "$line" $tag$num
8253                 }
8254                 if {!$dowords} {
8255                     $ctext insert end "\n" $tag$num
8256                 }
8257             } else {
8258                 set tags {}
8259                 if {[string first "+" $prefix] >= 0} {
8260                     # added line
8261                     lappend tags ${tag}result
8262                     if {$diffnparents > 1} {
8263                         set num [string first " " $prefix]
8264                         if {$num >= 0} {
8265                             if {$num >= $mergemax} {
8266                                 set num "max"
8267                             }
8268                             lappend tags m$num
8269                         }
8270                     }
8271                     set words_pre_markup "{+"
8272                     set words_post_markup "+}"
8273                 }
8274                 if {$targetline ne {}} {
8275                     if {$diffline == $targetline} {
8276                         set diffseehere [$ctext index "end - 1 chars"]
8277                         set targetline {}
8278                     } else {
8279                         incr diffline
8280                     }
8281                 }
8282                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8283                     $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8284                 } else {
8285                     $ctext insert end "$line" $tags
8286                 }
8287                 if {!$dowords} {
8288                     $ctext insert end "\n" $tags
8289                 }
8290             }
8291         } elseif {$dowords && $prefix eq "~"} {
8292             $ctext insert end "\n" {}
8293         } else {
8294             # "\ No newline at end of file",
8295             # or something else we don't recognize
8296             $ctext insert end "$line\n" hunksep
8297         }
8298     }
8299 }
8300
8301 proc changediffdisp {} {
8302     global ctext diffelide
8303
8304     $ctext tag conf d0 -elide [lindex $diffelide 0]
8305     $ctext tag conf dresult -elide [lindex $diffelide 1]
8306 }
8307
8308 proc highlightfile {cline} {
8309     global cflist cflist_top
8310
8311     if {![info exists cflist_top]} return
8312
8313     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8314     $cflist tag add highlight $cline.0 "$cline.0 lineend"
8315     $cflist see $cline.0
8316     set cflist_top $cline
8317 }
8318
8319 proc highlightfile_for_scrollpos {topidx} {
8320     global cmitmode difffilestart
8321
8322     if {$cmitmode eq "tree"} return
8323     if {![info exists difffilestart]} return
8324
8325     set top [lindex [split $topidx .] 0]
8326     if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8327         highlightfile 0
8328     } else {
8329         highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8330     }
8331 }
8332
8333 proc prevfile {} {
8334     global difffilestart ctext cmitmode
8335
8336     if {$cmitmode eq "tree"} return
8337     set prev 0.0
8338     set here [$ctext index @0,0]
8339     foreach loc $difffilestart {
8340         if {[$ctext compare $loc >= $here]} {
8341             $ctext yview $prev
8342             return
8343         }
8344         set prev $loc
8345     }
8346     $ctext yview $prev
8347 }
8348
8349 proc nextfile {} {
8350     global difffilestart ctext cmitmode
8351
8352     if {$cmitmode eq "tree"} return
8353     set here [$ctext index @0,0]
8354     foreach loc $difffilestart {
8355         if {[$ctext compare $loc > $here]} {
8356             $ctext yview $loc
8357             return
8358         }
8359     }
8360 }
8361
8362 proc clear_ctext {{first 1.0}} {
8363     global ctext smarktop smarkbot
8364     global ctext_file_names ctext_file_lines
8365     global pendinglinks
8366
8367     set l [lindex [split $first .] 0]
8368     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8369         set smarktop $l
8370     }
8371     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8372         set smarkbot $l
8373     }
8374     $ctext delete $first end
8375     if {$first eq "1.0"} {
8376         unset -nocomplain pendinglinks
8377     }
8378     set ctext_file_names {}
8379     set ctext_file_lines {}
8380 }
8381
8382 proc settabs {{firstab {}}} {
8383     global firsttabstop tabstop ctext have_tk85
8384
8385     if {$firstab ne {} && $have_tk85} {
8386         set firsttabstop $firstab
8387     }
8388     set w [font measure textfont "0"]
8389     if {$firsttabstop != 0} {
8390         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8391                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8392     } elseif {$have_tk85 || $tabstop != 8} {
8393         $ctext conf -tabs [expr {$tabstop * $w}]
8394     } else {
8395         $ctext conf -tabs {}
8396     }
8397 }
8398
8399 proc incrsearch {name ix op} {
8400     global ctext searchstring searchdirn
8401
8402     if {[catch {$ctext index anchor}]} {
8403         # no anchor set, use start of selection, or of visible area
8404         set sel [$ctext tag ranges sel]
8405         if {$sel ne {}} {
8406             $ctext mark set anchor [lindex $sel 0]
8407         } elseif {$searchdirn eq "-forwards"} {
8408             $ctext mark set anchor @0,0
8409         } else {
8410             $ctext mark set anchor @0,[winfo height $ctext]
8411         }
8412     }
8413     if {$searchstring ne {}} {
8414         set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8415         if {$here ne {}} {
8416             $ctext see $here
8417             set mend "$here + $mlen c"
8418             $ctext tag remove sel 1.0 end
8419             $ctext tag add sel $here $mend
8420             suppress_highlighting_file_for_current_scrollpos
8421             highlightfile_for_scrollpos $here
8422         }
8423     }
8424     rehighlight_search_results
8425 }
8426
8427 proc dosearch {} {
8428     global sstring ctext searchstring searchdirn
8429
8430     focus $sstring
8431     $sstring icursor end
8432     set searchdirn -forwards
8433     if {$searchstring ne {}} {
8434         set sel [$ctext tag ranges sel]
8435         if {$sel ne {}} {
8436             set start "[lindex $sel 0] + 1c"
8437         } elseif {[catch {set start [$ctext index anchor]}]} {
8438             set start "@0,0"
8439         }
8440         set match [$ctext search -count mlen -- $searchstring $start]
8441         $ctext tag remove sel 1.0 end
8442         if {$match eq {}} {
8443             bell
8444             return
8445         }
8446         $ctext see $match
8447         suppress_highlighting_file_for_current_scrollpos
8448         highlightfile_for_scrollpos $match
8449         set mend "$match + $mlen c"
8450         $ctext tag add sel $match $mend
8451         $ctext mark unset anchor
8452         rehighlight_search_results
8453     }
8454 }
8455
8456 proc dosearchback {} {
8457     global sstring ctext searchstring searchdirn
8458
8459     focus $sstring
8460     $sstring icursor end
8461     set searchdirn -backwards
8462     if {$searchstring ne {}} {
8463         set sel [$ctext tag ranges sel]
8464         if {$sel ne {}} {
8465             set start [lindex $sel 0]
8466         } elseif {[catch {set start [$ctext index anchor]}]} {
8467             set start @0,[winfo height $ctext]
8468         }
8469         set match [$ctext search -backwards -count ml -- $searchstring $start]
8470         $ctext tag remove sel 1.0 end
8471         if {$match eq {}} {
8472             bell
8473             return
8474         }
8475         $ctext see $match
8476         suppress_highlighting_file_for_current_scrollpos
8477         highlightfile_for_scrollpos $match
8478         set mend "$match + $ml c"
8479         $ctext tag add sel $match $mend
8480         $ctext mark unset anchor
8481         rehighlight_search_results
8482     }
8483 }
8484
8485 proc rehighlight_search_results {} {
8486     global ctext searchstring
8487
8488     $ctext tag remove found 1.0 end
8489     $ctext tag remove currentsearchhit 1.0 end
8490
8491     if {$searchstring ne {}} {
8492         searchmarkvisible 1
8493     }
8494 }
8495
8496 proc searchmark {first last} {
8497     global ctext searchstring
8498
8499     set sel [$ctext tag ranges sel]
8500
8501     set mend $first.0
8502     while {1} {
8503         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8504         if {$match eq {}} break
8505         set mend "$match + $mlen c"
8506         if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8507             $ctext tag add currentsearchhit $match $mend
8508         } else {
8509             $ctext tag add found $match $mend
8510         }
8511     }
8512 }
8513
8514 proc searchmarkvisible {doall} {
8515     global ctext smarktop smarkbot
8516
8517     set topline [lindex [split [$ctext index @0,0] .] 0]
8518     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8519     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8520         # no overlap with previous
8521         searchmark $topline $botline
8522         set smarktop $topline
8523         set smarkbot $botline
8524     } else {
8525         if {$topline < $smarktop} {
8526             searchmark $topline [expr {$smarktop-1}]
8527             set smarktop $topline
8528         }
8529         if {$botline > $smarkbot} {
8530             searchmark [expr {$smarkbot+1}] $botline
8531             set smarkbot $botline
8532         }
8533     }
8534 }
8535
8536 proc suppress_highlighting_file_for_current_scrollpos {} {
8537     global ctext suppress_highlighting_file_for_this_scrollpos
8538
8539     set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8540 }
8541
8542 proc scrolltext {f0 f1} {
8543     global searchstring cmitmode ctext
8544     global suppress_highlighting_file_for_this_scrollpos
8545
8546     set topidx [$ctext index @0,0]
8547     if {![info exists suppress_highlighting_file_for_this_scrollpos]
8548         || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8549         highlightfile_for_scrollpos $topidx
8550     }
8551
8552     unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8553
8554     .bleft.bottom.sb set $f0 $f1
8555     if {$searchstring ne {}} {
8556         searchmarkvisible 0
8557     }
8558 }
8559
8560 proc setcoords {} {
8561     global linespc charspc canvx0 canvy0
8562     global xspc1 xspc2 lthickness
8563
8564     set linespc [font metrics mainfont -linespace]
8565     set charspc [font measure mainfont "m"]
8566     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8567     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8568     set lthickness [expr {int($linespc / 9) + 1}]
8569     set xspc1(0) $linespc
8570     set xspc2 $linespc
8571 }
8572
8573 proc redisplay {} {
8574     global canv
8575     global selectedline
8576
8577     set ymax [lindex [$canv cget -scrollregion] 3]
8578     if {$ymax eq {} || $ymax == 0} return
8579     set span [$canv yview]
8580     clear_display
8581     setcanvscroll
8582     allcanvs yview moveto [lindex $span 0]
8583     drawvisible
8584     if {$selectedline ne {}} {
8585         selectline $selectedline 0
8586         allcanvs yview moveto [lindex $span 0]
8587     }
8588 }
8589
8590 proc parsefont {f n} {
8591     global fontattr
8592
8593     set fontattr($f,family) [lindex $n 0]
8594     set s [lindex $n 1]
8595     if {$s eq {} || $s == 0} {
8596         set s 10
8597     } elseif {$s < 0} {
8598         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8599     }
8600     set fontattr($f,size) $s
8601     set fontattr($f,weight) normal
8602     set fontattr($f,slant) roman
8603     foreach style [lrange $n 2 end] {
8604         switch -- $style {
8605             "normal" -
8606             "bold"   {set fontattr($f,weight) $style}
8607             "roman" -
8608             "italic" {set fontattr($f,slant) $style}
8609         }
8610     }
8611 }
8612
8613 proc fontflags {f {isbold 0}} {
8614     global fontattr
8615
8616     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8617                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8618                 -slant $fontattr($f,slant)]
8619 }
8620
8621 proc fontname {f} {
8622     global fontattr
8623
8624     set n [list $fontattr($f,family) $fontattr($f,size)]
8625     if {$fontattr($f,weight) eq "bold"} {
8626         lappend n "bold"
8627     }
8628     if {$fontattr($f,slant) eq "italic"} {
8629         lappend n "italic"
8630     }
8631     return $n
8632 }
8633
8634 proc incrfont {inc} {
8635     global mainfont textfont ctext canv cflist showrefstop
8636     global stopped entries fontattr
8637
8638     unmarkmatches
8639     set s $fontattr(mainfont,size)
8640     incr s $inc
8641     if {$s < 1} {
8642         set s 1
8643     }
8644     set fontattr(mainfont,size) $s
8645     font config mainfont -size $s
8646     font config mainfontbold -size $s
8647     set mainfont [fontname mainfont]
8648     set s $fontattr(textfont,size)
8649     incr s $inc
8650     if {$s < 1} {
8651         set s 1
8652     }
8653     set fontattr(textfont,size) $s
8654     font config textfont -size $s
8655     font config textfontbold -size $s
8656     set textfont [fontname textfont]
8657     setcoords
8658     settabs
8659     redisplay
8660 }
8661
8662 proc clearsha1 {} {
8663     global sha1entry sha1string
8664     if {[string length $sha1string] == 40} {
8665         $sha1entry delete 0 end
8666     }
8667 }
8668
8669 proc sha1change {n1 n2 op} {
8670     global sha1string currentid sha1but
8671     if {$sha1string == {}
8672         || ([info exists currentid] && $sha1string == $currentid)} {
8673         set state disabled
8674     } else {
8675         set state normal
8676     }
8677     if {[$sha1but cget -state] == $state} return
8678     if {$state == "normal"} {
8679         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8680     } else {
8681         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8682     }
8683 }
8684
8685 proc gotocommit {} {
8686     global sha1string tagids headids curview varcid
8687
8688     if {$sha1string == {}
8689         || ([info exists currentid] && $sha1string == $currentid)} return
8690     if {[info exists tagids($sha1string)]} {
8691         set id $tagids($sha1string)
8692     } elseif {[info exists headids($sha1string)]} {
8693         set id $headids($sha1string)
8694     } else {
8695         set id [string tolower $sha1string]
8696         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8697             set matches [longid $id]
8698             if {$matches ne {}} {
8699                 if {[llength $matches] > 1} {
8700                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8701                     return
8702                 }
8703                 set id [lindex $matches 0]
8704             }
8705         } else {
8706             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8707                 error_popup [mc "Revision %s is not known" $sha1string]
8708                 return
8709             }
8710         }
8711     }
8712     if {[commitinview $id $curview]} {
8713         selectline [rowofcommit $id] 1
8714         return
8715     }
8716     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8717         set msg [mc "SHA1 id %s is not known" $sha1string]
8718     } else {
8719         set msg [mc "Revision %s is not in the current view" $sha1string]
8720     }
8721     error_popup $msg
8722 }
8723
8724 proc lineenter {x y id} {
8725     global hoverx hovery hoverid hovertimer
8726     global commitinfo canv
8727
8728     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8729     set hoverx $x
8730     set hovery $y
8731     set hoverid $id
8732     if {[info exists hovertimer]} {
8733         after cancel $hovertimer
8734     }
8735     set hovertimer [after 500 linehover]
8736     $canv delete hover
8737 }
8738
8739 proc linemotion {x y id} {
8740     global hoverx hovery hoverid hovertimer
8741
8742     if {[info exists hoverid] && $id == $hoverid} {
8743         set hoverx $x
8744         set hovery $y
8745         if {[info exists hovertimer]} {
8746             after cancel $hovertimer
8747         }
8748         set hovertimer [after 500 linehover]
8749     }
8750 }
8751
8752 proc lineleave {id} {
8753     global hoverid hovertimer canv
8754
8755     if {[info exists hoverid] && $id == $hoverid} {
8756         $canv delete hover
8757         if {[info exists hovertimer]} {
8758             after cancel $hovertimer
8759             unset hovertimer
8760         }
8761         unset hoverid
8762     }
8763 }
8764
8765 proc linehover {} {
8766     global hoverx hovery hoverid hovertimer
8767     global canv linespc lthickness
8768     global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8769
8770     global commitinfo
8771
8772     set text [lindex $commitinfo($hoverid) 0]
8773     set ymax [lindex [$canv cget -scrollregion] 3]
8774     if {$ymax == {}} return
8775     set yfrac [lindex [$canv yview] 0]
8776     set x [expr {$hoverx + 2 * $linespc}]
8777     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8778     set x0 [expr {$x - 2 * $lthickness}]
8779     set y0 [expr {$y - 2 * $lthickness}]
8780     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8781     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8782     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8783                -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8784                -width 1 -tags hover]
8785     $canv raise $t
8786     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8787                -font mainfont -fill $linehoverfgcolor]
8788     $canv raise $t
8789 }
8790
8791 proc clickisonarrow {id y} {
8792     global lthickness
8793
8794     set ranges [rowranges $id]
8795     set thresh [expr {2 * $lthickness + 6}]
8796     set n [expr {[llength $ranges] - 1}]
8797     for {set i 1} {$i < $n} {incr i} {
8798         set row [lindex $ranges $i]
8799         if {abs([yc $row] - $y) < $thresh} {
8800             return $i
8801         }
8802     }
8803     return {}
8804 }
8805
8806 proc arrowjump {id n y} {
8807     global canv
8808
8809     # 1 <-> 2, 3 <-> 4, etc...
8810     set n [expr {(($n - 1) ^ 1) + 1}]
8811     set row [lindex [rowranges $id] $n]
8812     set yt [yc $row]
8813     set ymax [lindex [$canv cget -scrollregion] 3]
8814     if {$ymax eq {} || $ymax <= 0} return
8815     set view [$canv yview]
8816     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8817     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8818     if {$yfrac < 0} {
8819         set yfrac 0
8820     }
8821     allcanvs yview moveto $yfrac
8822 }
8823
8824 proc lineclick {x y id isnew} {
8825     global ctext commitinfo children canv thickerline curview
8826
8827     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8828     unmarkmatches
8829     unselectline
8830     normalline
8831     $canv delete hover
8832     # draw this line thicker than normal
8833     set thickerline $id
8834     drawlines $id
8835     if {$isnew} {
8836         set ymax [lindex [$canv cget -scrollregion] 3]
8837         if {$ymax eq {}} return
8838         set yfrac [lindex [$canv yview] 0]
8839         set y [expr {$y + $yfrac * $ymax}]
8840     }
8841     set dirn [clickisonarrow $id $y]
8842     if {$dirn ne {}} {
8843         arrowjump $id $dirn $y
8844         return
8845     }
8846
8847     if {$isnew} {
8848         addtohistory [list lineclick $x $y $id 0] savectextpos
8849     }
8850     # fill the details pane with info about this line
8851     $ctext conf -state normal
8852     clear_ctext
8853     settabs 0
8854     $ctext insert end "[mc "Parent"]:\t"
8855     $ctext insert end $id link0
8856     setlink $id link0
8857     set info $commitinfo($id)
8858     $ctext insert end "\n\t[lindex $info 0]\n"
8859     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8860     set date [formatdate [lindex $info 2]]
8861     $ctext insert end "\t[mc "Date"]:\t$date\n"
8862     set kids $children($curview,$id)
8863     if {$kids ne {}} {
8864         $ctext insert end "\n[mc "Children"]:"
8865         set i 0
8866         foreach child $kids {
8867             incr i
8868             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8869             set info $commitinfo($child)
8870             $ctext insert end "\n\t"
8871             $ctext insert end $child link$i
8872             setlink $child link$i
8873             $ctext insert end "\n\t[lindex $info 0]"
8874             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8875             set date [formatdate [lindex $info 2]]
8876             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8877         }
8878     }
8879     maybe_scroll_ctext 1
8880     $ctext conf -state disabled
8881     init_flist {}
8882 }
8883
8884 proc normalline {} {
8885     global thickerline
8886     if {[info exists thickerline]} {
8887         set id $thickerline
8888         unset thickerline
8889         drawlines $id
8890     }
8891 }
8892
8893 proc selbyid {id {isnew 1}} {
8894     global curview
8895     if {[commitinview $id $curview]} {
8896         selectline [rowofcommit $id] $isnew
8897     }
8898 }
8899
8900 proc mstime {} {
8901     global startmstime
8902     if {![info exists startmstime]} {
8903         set startmstime [clock clicks -milliseconds]
8904     }
8905     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8906 }
8907
8908 proc rowmenu {x y id} {
8909     global rowctxmenu selectedline rowmenuid curview
8910     global nullid nullid2 fakerowmenu mainhead markedid
8911
8912     stopfinding
8913     set rowmenuid $id
8914     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8915         set state disabled
8916     } else {
8917         set state normal
8918     }
8919     if {[info exists markedid] && $markedid ne $id} {
8920         set mstate normal
8921     } else {
8922         set mstate disabled
8923     }
8924     if {$id ne $nullid && $id ne $nullid2} {
8925         set menu $rowctxmenu
8926         if {$mainhead ne {}} {
8927             $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8928         } else {
8929             $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8930         }
8931         $menu entryconfigure 10 -state $mstate
8932         $menu entryconfigure 11 -state $mstate
8933         $menu entryconfigure 12 -state $mstate
8934     } else {
8935         set menu $fakerowmenu
8936     }
8937     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8938     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8939     $menu entryconfigure [mca "Make patch"] -state $state
8940     $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8941     $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8942     tk_popup $menu $x $y
8943 }
8944
8945 proc markhere {} {
8946     global rowmenuid markedid canv
8947
8948     set markedid $rowmenuid
8949     make_idmark $markedid
8950 }
8951
8952 proc gotomark {} {
8953     global markedid
8954
8955     if {[info exists markedid]} {
8956         selbyid $markedid
8957     }
8958 }
8959
8960 proc replace_by_kids {l r} {
8961     global curview children
8962
8963     set id [commitonrow $r]
8964     set l [lreplace $l 0 0]
8965     foreach kid $children($curview,$id) {
8966         lappend l [rowofcommit $kid]
8967     }
8968     return [lsort -integer -decreasing -unique $l]
8969 }
8970
8971 proc find_common_desc {} {
8972     global markedid rowmenuid curview children
8973
8974     if {![info exists markedid]} return
8975     if {![commitinview $markedid $curview] ||
8976         ![commitinview $rowmenuid $curview]} return
8977     #set t1 [clock clicks -milliseconds]
8978     set l1 [list [rowofcommit $markedid]]
8979     set l2 [list [rowofcommit $rowmenuid]]
8980     while 1 {
8981         set r1 [lindex $l1 0]
8982         set r2 [lindex $l2 0]
8983         if {$r1 eq {} || $r2 eq {}} break
8984         if {$r1 == $r2} {
8985             selectline $r1 1
8986             break
8987         }
8988         if {$r1 > $r2} {
8989             set l1 [replace_by_kids $l1 $r1]
8990         } else {
8991             set l2 [replace_by_kids $l2 $r2]
8992         }
8993     }
8994     #set t2 [clock clicks -milliseconds]
8995     #puts "took [expr {$t2-$t1}]ms"
8996 }
8997
8998 proc compare_commits {} {
8999     global markedid rowmenuid curview children
9000
9001     if {![info exists markedid]} return
9002     if {![commitinview $markedid $curview]} return
9003     addtohistory [list do_cmp_commits $markedid $rowmenuid]
9004     do_cmp_commits $markedid $rowmenuid
9005 }
9006
9007 proc getpatchid {id} {
9008     global patchids
9009
9010     if {![info exists patchids($id)]} {
9011         set cmd [diffcmd [list $id] {-p --root}]
9012         # trim off the initial "|"
9013         set cmd [lrange $cmd 1 end]
9014         if {[catch {
9015             set x [eval exec $cmd | git patch-id]
9016             set patchids($id) [lindex $x 0]
9017         }]} {
9018             set patchids($id) "error"
9019         }
9020     }
9021     return $patchids($id)
9022 }
9023
9024 proc do_cmp_commits {a b} {
9025     global ctext curview parents children patchids commitinfo
9026
9027     $ctext conf -state normal
9028     clear_ctext
9029     init_flist {}
9030     for {set i 0} {$i < 100} {incr i} {
9031         set skipa 0
9032         set skipb 0
9033         if {[llength $parents($curview,$a)] > 1} {
9034             appendshortlink $a [mc "Skipping merge commit "] "\n"
9035             set skipa 1
9036         } else {
9037             set patcha [getpatchid $a]
9038         }
9039         if {[llength $parents($curview,$b)] > 1} {
9040             appendshortlink $b [mc "Skipping merge commit "] "\n"
9041             set skipb 1
9042         } else {
9043             set patchb [getpatchid $b]
9044         }
9045         if {!$skipa && !$skipb} {
9046             set heada [lindex $commitinfo($a) 0]
9047             set headb [lindex $commitinfo($b) 0]
9048             if {$patcha eq "error"} {
9049                 appendshortlink $a [mc "Error getting patch ID for "] \
9050                     [mc " - stopping\n"]
9051                 break
9052             }
9053             if {$patchb eq "error"} {
9054                 appendshortlink $b [mc "Error getting patch ID for "] \
9055                     [mc " - stopping\n"]
9056                 break
9057             }
9058             if {$patcha eq $patchb} {
9059                 if {$heada eq $headb} {
9060                     appendshortlink $a [mc "Commit "]
9061                     appendshortlink $b " == " "  $heada\n"
9062                 } else {
9063                     appendshortlink $a [mc "Commit "] "  $heada\n"
9064                     appendshortlink $b [mc " is the same patch as\n       "] \
9065                         "  $headb\n"
9066                 }
9067                 set skipa 1
9068                 set skipb 1
9069             } else {
9070                 $ctext insert end "\n"
9071                 appendshortlink $a [mc "Commit "] "  $heada\n"
9072                 appendshortlink $b [mc " differs from\n       "] \
9073                     "  $headb\n"
9074                 $ctext insert end [mc "Diff of commits:\n\n"]
9075                 $ctext conf -state disabled
9076                 update
9077                 diffcommits $a $b
9078                 return
9079             }
9080         }
9081         if {$skipa} {
9082             set kids [real_children $curview,$a]
9083             if {[llength $kids] != 1} {
9084                 $ctext insert end "\n"
9085                 appendshortlink $a [mc "Commit "] \
9086                     [mc " has %s children - stopping\n" [llength $kids]]
9087                 break
9088             }
9089             set a [lindex $kids 0]
9090         }
9091         if {$skipb} {
9092             set kids [real_children $curview,$b]
9093             if {[llength $kids] != 1} {
9094                 appendshortlink $b [mc "Commit "] \
9095                     [mc " has %s children - stopping\n" [llength $kids]]
9096                 break
9097             }
9098             set b [lindex $kids 0]
9099         }
9100     }
9101     $ctext conf -state disabled
9102 }
9103
9104 proc diffcommits {a b} {
9105     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9106
9107     set tmpdir [gitknewtmpdir]
9108     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9109     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9110     if {[catch {
9111         exec git diff-tree -p --pretty $a >$fna
9112         exec git diff-tree -p --pretty $b >$fnb
9113     } err]} {
9114         error_popup [mc "Error writing commit to file: %s" $err]
9115         return
9116     }
9117     if {[catch {
9118         set fd [open "| diff -U$diffcontext $fna $fnb" r]
9119     } err]} {
9120         error_popup [mc "Error diffing commits: %s" $err]
9121         return
9122     }
9123     set diffids [list commits $a $b]
9124     set blobdifffd($diffids) $fd
9125     set diffinhdr 0
9126     set currdiffsubmod ""
9127     filerun $fd [list getblobdiffline $fd $diffids]
9128 }
9129
9130 proc diffvssel {dirn} {
9131     global rowmenuid selectedline
9132
9133     if {$selectedline eq {}} return
9134     if {$dirn} {
9135         set oldid [commitonrow $selectedline]
9136         set newid $rowmenuid
9137     } else {
9138         set oldid $rowmenuid
9139         set newid [commitonrow $selectedline]
9140     }
9141     addtohistory [list doseldiff $oldid $newid] savectextpos
9142     doseldiff $oldid $newid
9143 }
9144
9145 proc diffvsmark {dirn} {
9146     global rowmenuid markedid
9147
9148     if {![info exists markedid]} return
9149     if {$dirn} {
9150         set oldid $markedid
9151         set newid $rowmenuid
9152     } else {
9153         set oldid $rowmenuid
9154         set newid $markedid
9155     }
9156     addtohistory [list doseldiff $oldid $newid] savectextpos
9157     doseldiff $oldid $newid
9158 }
9159
9160 proc doseldiff {oldid newid} {
9161     global ctext
9162     global commitinfo
9163
9164     $ctext conf -state normal
9165     clear_ctext
9166     init_flist [mc "Top"]
9167     $ctext insert end "[mc "From"] "
9168     $ctext insert end $oldid link0
9169     setlink $oldid link0
9170     $ctext insert end "\n     "
9171     $ctext insert end [lindex $commitinfo($oldid) 0]
9172     $ctext insert end "\n\n[mc "To"]   "
9173     $ctext insert end $newid link1
9174     setlink $newid link1
9175     $ctext insert end "\n     "
9176     $ctext insert end [lindex $commitinfo($newid) 0]
9177     $ctext insert end "\n"
9178     $ctext conf -state disabled
9179     $ctext tag remove found 1.0 end
9180     startdiff [list $oldid $newid]
9181 }
9182
9183 proc mkpatch {} {
9184     global rowmenuid currentid commitinfo patchtop patchnum NS
9185
9186     if {![info exists currentid]} return
9187     set oldid $currentid
9188     set oldhead [lindex $commitinfo($oldid) 0]
9189     set newid $rowmenuid
9190     set newhead [lindex $commitinfo($newid) 0]
9191     set top .patch
9192     set patchtop $top
9193     catch {destroy $top}
9194     ttk_toplevel $top
9195     make_transient $top .
9196     ${NS}::label $top.title -text [mc "Generate patch"]
9197     grid $top.title - -pady 10
9198     ${NS}::label $top.from -text [mc "From:"]
9199     ${NS}::entry $top.fromsha1 -width 40
9200     $top.fromsha1 insert 0 $oldid
9201     $top.fromsha1 conf -state readonly
9202     grid $top.from $top.fromsha1 -sticky w
9203     ${NS}::entry $top.fromhead -width 60
9204     $top.fromhead insert 0 $oldhead
9205     $top.fromhead conf -state readonly
9206     grid x $top.fromhead -sticky w
9207     ${NS}::label $top.to -text [mc "To:"]
9208     ${NS}::entry $top.tosha1 -width 40
9209     $top.tosha1 insert 0 $newid
9210     $top.tosha1 conf -state readonly
9211     grid $top.to $top.tosha1 -sticky w
9212     ${NS}::entry $top.tohead -width 60
9213     $top.tohead insert 0 $newhead
9214     $top.tohead conf -state readonly
9215     grid x $top.tohead -sticky w
9216     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9217     grid $top.rev x -pady 10 -padx 5
9218     ${NS}::label $top.flab -text [mc "Output file:"]
9219     ${NS}::entry $top.fname -width 60
9220     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9221     incr patchnum
9222     grid $top.flab $top.fname -sticky w
9223     ${NS}::frame $top.buts
9224     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9225     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9226     bind $top <Key-Return> mkpatchgo
9227     bind $top <Key-Escape> mkpatchcan
9228     grid $top.buts.gen $top.buts.can
9229     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9230     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9231     grid $top.buts - -pady 10 -sticky ew
9232     focus $top.fname
9233 }
9234
9235 proc mkpatchrev {} {
9236     global patchtop
9237
9238     set oldid [$patchtop.fromsha1 get]
9239     set oldhead [$patchtop.fromhead get]
9240     set newid [$patchtop.tosha1 get]
9241     set newhead [$patchtop.tohead get]
9242     foreach e [list fromsha1 fromhead tosha1 tohead] \
9243             v [list $newid $newhead $oldid $oldhead] {
9244         $patchtop.$e conf -state normal
9245         $patchtop.$e delete 0 end
9246         $patchtop.$e insert 0 $v
9247         $patchtop.$e conf -state readonly
9248     }
9249 }
9250
9251 proc mkpatchgo {} {
9252     global patchtop nullid nullid2
9253
9254     set oldid [$patchtop.fromsha1 get]
9255     set newid [$patchtop.tosha1 get]
9256     set fname [$patchtop.fname get]
9257     set cmd [diffcmd [list $oldid $newid] -p]
9258     # trim off the initial "|"
9259     set cmd [lrange $cmd 1 end]
9260     lappend cmd >$fname &
9261     if {[catch {eval exec $cmd} err]} {
9262         error_popup "[mc "Error creating patch:"] $err" $patchtop
9263     }
9264     catch {destroy $patchtop}
9265     unset patchtop
9266 }
9267
9268 proc mkpatchcan {} {
9269     global patchtop
9270
9271     catch {destroy $patchtop}
9272     unset patchtop
9273 }
9274
9275 proc mktag {} {
9276     global rowmenuid mktagtop commitinfo NS
9277
9278     set top .maketag
9279     set mktagtop $top
9280     catch {destroy $top}
9281     ttk_toplevel $top
9282     make_transient $top .
9283     ${NS}::label $top.title -text [mc "Create tag"]
9284     grid $top.title - -pady 10
9285     ${NS}::label $top.id -text [mc "ID:"]
9286     ${NS}::entry $top.sha1 -width 40
9287     $top.sha1 insert 0 $rowmenuid
9288     $top.sha1 conf -state readonly
9289     grid $top.id $top.sha1 -sticky w
9290     ${NS}::entry $top.head -width 60
9291     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9292     $top.head conf -state readonly
9293     grid x $top.head -sticky w
9294     ${NS}::label $top.tlab -text [mc "Tag name:"]
9295     ${NS}::entry $top.tag -width 60
9296     grid $top.tlab $top.tag -sticky w
9297     ${NS}::label $top.op -text [mc "Tag message is optional"]
9298     grid $top.op -columnspan 2 -sticky we
9299     ${NS}::label $top.mlab -text [mc "Tag message:"]
9300     ${NS}::entry $top.msg -width 60
9301     grid $top.mlab $top.msg -sticky w
9302     ${NS}::frame $top.buts
9303     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9304     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9305     bind $top <Key-Return> mktaggo
9306     bind $top <Key-Escape> mktagcan
9307     grid $top.buts.gen $top.buts.can
9308     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9309     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9310     grid $top.buts - -pady 10 -sticky ew
9311     focus $top.tag
9312 }
9313
9314 proc domktag {} {
9315     global mktagtop env tagids idtags
9316
9317     set id [$mktagtop.sha1 get]
9318     set tag [$mktagtop.tag get]
9319     set msg [$mktagtop.msg get]
9320     if {$tag == {}} {
9321         error_popup [mc "No tag name specified"] $mktagtop
9322         return 0
9323     }
9324     if {[info exists tagids($tag)]} {
9325         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9326         return 0
9327     }
9328     if {[catch {
9329         if {$msg != {}} {
9330             exec git tag -a -m $msg $tag $id
9331         } else {
9332             exec git tag $tag $id
9333         }
9334     } err]} {
9335         error_popup "[mc "Error creating tag:"] $err" $mktagtop
9336         return 0
9337     }
9338
9339     set tagids($tag) $id
9340     lappend idtags($id) $tag
9341     redrawtags $id
9342     addedtag $id
9343     dispneartags 0
9344     run refill_reflist
9345     return 1
9346 }
9347
9348 proc redrawtags {id} {
9349     global canv linehtag idpos currentid curview cmitlisted markedid
9350     global canvxmax iddrawn circleitem mainheadid circlecolors
9351     global mainheadcirclecolor
9352
9353     if {![commitinview $id $curview]} return
9354     if {![info exists iddrawn($id)]} return
9355     set row [rowofcommit $id]
9356     if {$id eq $mainheadid} {
9357         set ofill $mainheadcirclecolor
9358     } else {
9359         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9360     }
9361     $canv itemconf $circleitem($row) -fill $ofill
9362     $canv delete tag.$id
9363     set xt [eval drawtags $id $idpos($id)]
9364     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9365     set text [$canv itemcget $linehtag($id) -text]
9366     set font [$canv itemcget $linehtag($id) -font]
9367     set xr [expr {$xt + [font measure $font $text]}]
9368     if {$xr > $canvxmax} {
9369         set canvxmax $xr
9370         setcanvscroll
9371     }
9372     if {[info exists currentid] && $currentid == $id} {
9373         make_secsel $id
9374     }
9375     if {[info exists markedid] && $markedid eq $id} {
9376         make_idmark $id
9377     }
9378 }
9379
9380 proc mktagcan {} {
9381     global mktagtop
9382
9383     catch {destroy $mktagtop}
9384     unset mktagtop
9385 }
9386
9387 proc mktaggo {} {
9388     if {![domktag]} return
9389     mktagcan
9390 }
9391
9392 proc copysummary {} {
9393     global rowmenuid autosellen
9394
9395     set format "%h (\"%s\", %ad)"
9396     set cmd [list git show -s --pretty=format:$format --date=short]
9397     if {$autosellen < 40} {
9398         lappend cmd --abbrev=$autosellen
9399     }
9400     set summary [eval exec $cmd $rowmenuid]
9401
9402     clipboard clear
9403     clipboard append $summary
9404 }
9405
9406 proc writecommit {} {
9407     global rowmenuid wrcomtop commitinfo wrcomcmd NS
9408
9409     set top .writecommit
9410     set wrcomtop $top
9411     catch {destroy $top}
9412     ttk_toplevel $top
9413     make_transient $top .
9414     ${NS}::label $top.title -text [mc "Write commit to file"]
9415     grid $top.title - -pady 10
9416     ${NS}::label $top.id -text [mc "ID:"]
9417     ${NS}::entry $top.sha1 -width 40
9418     $top.sha1 insert 0 $rowmenuid
9419     $top.sha1 conf -state readonly
9420     grid $top.id $top.sha1 -sticky w
9421     ${NS}::entry $top.head -width 60
9422     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9423     $top.head conf -state readonly
9424     grid x $top.head -sticky w
9425     ${NS}::label $top.clab -text [mc "Command:"]
9426     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9427     grid $top.clab $top.cmd -sticky w -pady 10
9428     ${NS}::label $top.flab -text [mc "Output file:"]
9429     ${NS}::entry $top.fname -width 60
9430     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9431     grid $top.flab $top.fname -sticky w
9432     ${NS}::frame $top.buts
9433     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9434     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9435     bind $top <Key-Return> wrcomgo
9436     bind $top <Key-Escape> wrcomcan
9437     grid $top.buts.gen $top.buts.can
9438     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9439     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9440     grid $top.buts - -pady 10 -sticky ew
9441     focus $top.fname
9442 }
9443
9444 proc wrcomgo {} {
9445     global wrcomtop
9446
9447     set id [$wrcomtop.sha1 get]
9448     set cmd "echo $id | [$wrcomtop.cmd get]"
9449     set fname [$wrcomtop.fname get]
9450     if {[catch {exec sh -c $cmd >$fname &} err]} {
9451         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9452     }
9453     catch {destroy $wrcomtop}
9454     unset wrcomtop
9455 }
9456
9457 proc wrcomcan {} {
9458     global wrcomtop
9459
9460     catch {destroy $wrcomtop}
9461     unset wrcomtop
9462 }
9463
9464 proc mkbranch {} {
9465     global NS rowmenuid
9466
9467     set top .branchdialog
9468
9469     set val(name) ""
9470     set val(id) $rowmenuid
9471     set val(command) [list mkbrgo $top]
9472
9473     set ui(title) [mc "Create branch"]
9474     set ui(accept) [mc "Create"]
9475
9476     branchdia $top val ui
9477 }
9478
9479 proc mvbranch {} {
9480     global NS
9481     global headmenuid headmenuhead
9482
9483     set top .branchdialog
9484
9485     set val(name) $headmenuhead
9486     set val(id) $headmenuid
9487     set val(command) [list mvbrgo $top $headmenuhead]
9488
9489     set ui(title) [mc "Rename branch %s" $headmenuhead]
9490     set ui(accept) [mc "Rename"]
9491
9492     branchdia $top val ui
9493 }
9494
9495 proc branchdia {top valvar uivar} {
9496     global NS commitinfo
9497     upvar $valvar val $uivar ui
9498
9499     catch {destroy $top}
9500     ttk_toplevel $top
9501     make_transient $top .
9502     ${NS}::label $top.title -text $ui(title)
9503     grid $top.title - -pady 10
9504     ${NS}::label $top.id -text [mc "ID:"]
9505     ${NS}::entry $top.sha1 -width 40
9506     $top.sha1 insert 0 $val(id)
9507     $top.sha1 conf -state readonly
9508     grid $top.id $top.sha1 -sticky w
9509     ${NS}::entry $top.head -width 60
9510     $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9511     $top.head conf -state readonly
9512     grid x $top.head -sticky ew
9513     grid columnconfigure $top 1 -weight 1
9514     ${NS}::label $top.nlab -text [mc "Name:"]
9515     ${NS}::entry $top.name -width 40
9516     $top.name insert 0 $val(name)
9517     grid $top.nlab $top.name -sticky w
9518     ${NS}::frame $top.buts
9519     ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9520     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9521     bind $top <Key-Return> $val(command)
9522     bind $top <Key-Escape> "catch {destroy $top}"
9523     grid $top.buts.go $top.buts.can
9524     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9525     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9526     grid $top.buts - -pady 10 -sticky ew
9527     focus $top.name
9528 }
9529
9530 proc mkbrgo {top} {
9531     global headids idheads
9532
9533     set name [$top.name get]
9534     set id [$top.sha1 get]
9535     set cmdargs {}
9536     set old_id {}
9537     if {$name eq {}} {
9538         error_popup [mc "Please specify a name for the new branch"] $top
9539         return
9540     }
9541     if {[info exists headids($name)]} {
9542         if {![confirm_popup [mc \
9543                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9544             return
9545         }
9546         set old_id $headids($name)
9547         lappend cmdargs -f
9548     }
9549     catch {destroy $top}
9550     lappend cmdargs $name $id
9551     nowbusy newbranch
9552     update
9553     if {[catch {
9554         eval exec git branch $cmdargs
9555     } err]} {
9556         notbusy newbranch
9557         error_popup $err
9558     } else {
9559         notbusy newbranch
9560         if {$old_id ne {}} {
9561             movehead $id $name
9562             movedhead $id $name
9563             redrawtags $old_id
9564             redrawtags $id
9565         } else {
9566             set headids($name) $id
9567             lappend idheads($id) $name
9568             addedhead $id $name
9569             redrawtags $id
9570         }
9571         dispneartags 0
9572         run refill_reflist
9573     }
9574 }
9575
9576 proc mvbrgo {top prevname} {
9577     global headids idheads mainhead mainheadid
9578
9579     set name [$top.name get]
9580     set id [$top.sha1 get]
9581     set cmdargs {}
9582     if {$name eq $prevname} {
9583         catch {destroy $top}
9584         return
9585     }
9586     if {$name eq {}} {
9587         error_popup [mc "Please specify a new name for the branch"] $top
9588         return
9589     }
9590     catch {destroy $top}
9591     lappend cmdargs -m $prevname $name
9592     nowbusy renamebranch
9593     update
9594     if {[catch {
9595         eval exec git branch $cmdargs
9596     } err]} {
9597         notbusy renamebranch
9598         error_popup $err
9599     } else {
9600         notbusy renamebranch
9601         removehead $id $prevname
9602         removedhead $id $prevname
9603         set headids($name) $id
9604         lappend idheads($id) $name
9605         addedhead $id $name
9606         if {$prevname eq $mainhead} {
9607             set mainhead $name
9608             set mainheadid $id
9609         }
9610         redrawtags $id
9611         dispneartags 0
9612         run refill_reflist
9613     }
9614 }
9615
9616 proc exec_citool {tool_args {baseid {}}} {
9617     global commitinfo env
9618
9619     set save_env [array get env GIT_AUTHOR_*]
9620
9621     if {$baseid ne {}} {
9622         if {![info exists commitinfo($baseid)]} {
9623             getcommit $baseid
9624         }
9625         set author [lindex $commitinfo($baseid) 1]
9626         set date [lindex $commitinfo($baseid) 2]
9627         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9628                     $author author name email]
9629             && $date ne {}} {
9630             set env(GIT_AUTHOR_NAME) $name
9631             set env(GIT_AUTHOR_EMAIL) $email
9632             set env(GIT_AUTHOR_DATE) $date
9633         }
9634     }
9635
9636     eval exec git citool $tool_args &
9637
9638     array unset env GIT_AUTHOR_*
9639     array set env $save_env
9640 }
9641
9642 proc cherrypick {} {
9643     global rowmenuid curview
9644     global mainhead mainheadid
9645     global gitdir
9646
9647     set oldhead [exec git rev-parse HEAD]
9648     set dheads [descheads $rowmenuid]
9649     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9650         set ok [confirm_popup [mc "Commit %s is already\
9651                 included in branch %s -- really re-apply it?" \
9652                                    [string range $rowmenuid 0 7] $mainhead]]
9653         if {!$ok} return
9654     }
9655     nowbusy cherrypick [mc "Cherry-picking"]
9656     update
9657     # Unfortunately git-cherry-pick writes stuff to stderr even when
9658     # no error occurs, and exec takes that as an indication of error...
9659     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9660         notbusy cherrypick
9661         if {[regexp -line \
9662                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9663                  $err msg fname]} {
9664             error_popup [mc "Cherry-pick failed because of local changes\
9665                         to file '%s'.\nPlease commit, reset or stash\
9666                         your changes and try again." $fname]
9667         } elseif {[regexp -line \
9668                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9669                        $err]} {
9670             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9671                         conflict.\nDo you wish to run git citool to\
9672                         resolve it?"]]} {
9673                 # Force citool to read MERGE_MSG
9674                 file delete [file join $gitdir "GITGUI_MSG"]
9675                 exec_citool {} $rowmenuid
9676             }
9677         } else {
9678             error_popup $err
9679         }
9680         run updatecommits
9681         return
9682     }
9683     set newhead [exec git rev-parse HEAD]
9684     if {$newhead eq $oldhead} {
9685         notbusy cherrypick
9686         error_popup [mc "No changes committed"]
9687         return
9688     }
9689     addnewchild $newhead $oldhead
9690     if {[commitinview $oldhead $curview]} {
9691         # XXX this isn't right if we have a path limit...
9692         insertrow $newhead $oldhead $curview
9693         if {$mainhead ne {}} {
9694             movehead $newhead $mainhead
9695             movedhead $newhead $mainhead
9696         }
9697         set mainheadid $newhead
9698         redrawtags $oldhead
9699         redrawtags $newhead
9700         selbyid $newhead
9701     }
9702     notbusy cherrypick
9703 }
9704
9705 proc revert {} {
9706     global rowmenuid curview
9707     global mainhead mainheadid
9708     global gitdir
9709
9710     set oldhead [exec git rev-parse HEAD]
9711     set dheads [descheads $rowmenuid]
9712     if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9713        set ok [confirm_popup [mc "Commit %s is not\
9714            included in branch %s -- really revert it?" \
9715                       [string range $rowmenuid 0 7] $mainhead]]
9716        if {!$ok} return
9717     }
9718     nowbusy revert [mc "Reverting"]
9719     update
9720
9721     if [catch {exec git revert --no-edit $rowmenuid} err] {
9722         notbusy revert
9723         if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9724                 $err match files] {
9725             regsub {\n( |\t)+} $files "\n" files
9726             error_popup [mc "Revert failed because of local changes to\
9727                 the following files:%s Please commit, reset or stash \
9728                 your changes and try again." $files]
9729         } elseif [regexp {error: could not revert} $err] {
9730             if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9731                 Do you wish to run git citool to resolve it?"]] {
9732                 # Force citool to read MERGE_MSG
9733                 file delete [file join $gitdir "GITGUI_MSG"]
9734                 exec_citool {} $rowmenuid
9735             }
9736         } else { error_popup $err }
9737         run updatecommits
9738         return
9739     }
9740
9741     set newhead [exec git rev-parse HEAD]
9742     if { $newhead eq $oldhead } {
9743         notbusy revert
9744         error_popup [mc "No changes committed"]
9745         return
9746     }
9747
9748     addnewchild $newhead $oldhead
9749
9750     if [commitinview $oldhead $curview] {
9751         # XXX this isn't right if we have a path limit...
9752         insertrow $newhead $oldhead $curview
9753         if {$mainhead ne {}} {
9754             movehead $newhead $mainhead
9755             movedhead $newhead $mainhead
9756         }
9757         set mainheadid $newhead
9758         redrawtags $oldhead
9759         redrawtags $newhead
9760         selbyid $newhead
9761     }
9762
9763     notbusy revert
9764 }
9765
9766 proc resethead {} {
9767     global mainhead rowmenuid confirm_ok resettype NS
9768
9769     set confirm_ok 0
9770     set w ".confirmreset"
9771     ttk_toplevel $w
9772     make_transient $w .
9773     wm title $w [mc "Confirm reset"]
9774     ${NS}::label $w.m -text \
9775         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9776     pack $w.m -side top -fill x -padx 20 -pady 20
9777     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9778     set resettype mixed
9779     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9780         -text [mc "Soft: Leave working tree and index untouched"]
9781     grid $w.f.soft -sticky w
9782     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9783         -text [mc "Mixed: Leave working tree untouched, reset index"]
9784     grid $w.f.mixed -sticky w
9785     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9786         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9787     grid $w.f.hard -sticky w
9788     pack $w.f -side top -fill x -padx 4
9789     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9790     pack $w.ok -side left -fill x -padx 20 -pady 20
9791     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9792     bind $w <Key-Escape> [list destroy $w]
9793     pack $w.cancel -side right -fill x -padx 20 -pady 20
9794     bind $w <Visibility> "grab $w; focus $w"
9795     tkwait window $w
9796     if {!$confirm_ok} return
9797     if {[catch {set fd [open \
9798             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9799         error_popup $err
9800     } else {
9801         dohidelocalchanges
9802         filerun $fd [list readresetstat $fd]
9803         nowbusy reset [mc "Resetting"]
9804         selbyid $rowmenuid
9805     }
9806 }
9807
9808 proc readresetstat {fd} {
9809     global mainhead mainheadid showlocalchanges rprogcoord
9810
9811     if {[gets $fd line] >= 0} {
9812         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9813             set rprogcoord [expr {1.0 * $m / $n}]
9814             adjustprogress
9815         }
9816         return 1
9817     }
9818     set rprogcoord 0
9819     adjustprogress
9820     notbusy reset
9821     if {[catch {close $fd} err]} {
9822         error_popup $err
9823     }
9824     set oldhead $mainheadid
9825     set newhead [exec git rev-parse HEAD]
9826     if {$newhead ne $oldhead} {
9827         movehead $newhead $mainhead
9828         movedhead $newhead $mainhead
9829         set mainheadid $newhead
9830         redrawtags $oldhead
9831         redrawtags $newhead
9832     }
9833     if {$showlocalchanges} {
9834         doshowlocalchanges
9835     }
9836     return 0
9837 }
9838
9839 # context menu for a head
9840 proc headmenu {x y id head} {
9841     global headmenuid headmenuhead headctxmenu mainhead headids
9842
9843     stopfinding
9844     set headmenuid $id
9845     set headmenuhead $head
9846     array set state {0 normal 1 normal 2 normal}
9847     if {[string match "remotes/*" $head]} {
9848         set localhead [string range $head [expr [string last / $head] + 1] end]
9849         if {[info exists headids($localhead)]} {
9850             set state(0) disabled
9851         }
9852         array set state {1 disabled 2 disabled}
9853     }
9854     if {$head eq $mainhead} {
9855         array set state {0 disabled 2 disabled}
9856     }
9857     foreach i {0 1 2} {
9858         $headctxmenu entryconfigure $i -state $state($i)
9859     }
9860     tk_popup $headctxmenu $x $y
9861 }
9862
9863 proc cobranch {} {
9864     global headmenuid headmenuhead headids
9865     global showlocalchanges
9866
9867     # check the tree is clean first??
9868     set newhead $headmenuhead
9869     set command [list | git checkout]
9870     if {[string match "remotes/*" $newhead]} {
9871         set remote $newhead
9872         set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9873         # The following check is redundant - the menu option should
9874         # be disabled to begin with...
9875         if {[info exists headids($newhead)]} {
9876             error_popup [mc "A local branch named %s exists already" $newhead]
9877             return
9878         }
9879         lappend command -b $newhead --track $remote
9880     } else {
9881         lappend command $newhead
9882     }
9883     lappend command 2>@1
9884     nowbusy checkout [mc "Checking out"]
9885     update
9886     dohidelocalchanges
9887     if {[catch {
9888         set fd [open $command r]
9889     } err]} {
9890         notbusy checkout
9891         error_popup $err
9892         if {$showlocalchanges} {
9893             dodiffindex
9894         }
9895     } else {
9896         filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9897     }
9898 }
9899
9900 proc readcheckoutstat {fd newhead newheadid} {
9901     global mainhead mainheadid headids idheads showlocalchanges progresscoords
9902     global viewmainheadid curview
9903
9904     if {[gets $fd line] >= 0} {
9905         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9906             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9907             adjustprogress
9908         }
9909         return 1
9910     }
9911     set progresscoords {0 0}
9912     adjustprogress
9913     notbusy checkout
9914     if {[catch {close $fd} err]} {
9915         error_popup $err
9916         return
9917     }
9918     set oldmainid $mainheadid
9919     if {! [info exists headids($newhead)]} {
9920         set headids($newhead) $newheadid
9921         lappend idheads($newheadid) $newhead
9922         addedhead $newheadid $newhead
9923     }
9924     set mainhead $newhead
9925     set mainheadid $newheadid
9926     set viewmainheadid($curview) $newheadid
9927     redrawtags $oldmainid
9928     redrawtags $newheadid
9929     selbyid $newheadid
9930     if {$showlocalchanges} {
9931         dodiffindex
9932     }
9933 }
9934
9935 proc rmbranch {} {
9936     global headmenuid headmenuhead mainhead
9937     global idheads
9938
9939     set head $headmenuhead
9940     set id $headmenuid
9941     # this check shouldn't be needed any more...
9942     if {$head eq $mainhead} {
9943         error_popup [mc "Cannot delete the currently checked-out branch"]
9944         return
9945     }
9946     set dheads [descheads $id]
9947     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9948         # the stuff on this branch isn't on any other branch
9949         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9950                         branch.\nReally delete branch %s?" $head $head]]} return
9951     }
9952     nowbusy rmbranch
9953     update
9954     if {[catch {exec git branch -D $head} err]} {
9955         notbusy rmbranch
9956         error_popup $err
9957         return
9958     }
9959     removehead $id $head
9960     removedhead $id $head
9961     redrawtags $id
9962     notbusy rmbranch
9963     dispneartags 0
9964     run refill_reflist
9965 }
9966
9967 # Display a list of tags and heads
9968 proc showrefs {} {
9969     global showrefstop bgcolor fgcolor selectbgcolor NS
9970     global bglist fglist reflistfilter reflist maincursor
9971
9972     set top .showrefs
9973     set showrefstop $top
9974     if {[winfo exists $top]} {
9975         raise $top
9976         refill_reflist
9977         return
9978     }
9979     ttk_toplevel $top
9980     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9981     make_transient $top .
9982     text $top.list -background $bgcolor -foreground $fgcolor \
9983         -selectbackground $selectbgcolor -font mainfont \
9984         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9985         -width 30 -height 20 -cursor $maincursor \
9986         -spacing1 1 -spacing3 1 -state disabled
9987     $top.list tag configure highlight -background $selectbgcolor
9988     if {![lsearch -exact $bglist $top.list]} {
9989         lappend bglist $top.list
9990         lappend fglist $top.list
9991     }
9992     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9993     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9994     grid $top.list $top.ysb -sticky nsew
9995     grid $top.xsb x -sticky ew
9996     ${NS}::frame $top.f
9997     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9998     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9999     set reflistfilter "*"
10000     trace add variable reflistfilter write reflistfilter_change
10001     pack $top.f.e -side right -fill x -expand 1
10002     pack $top.f.l -side left
10003     grid $top.f - -sticky ew -pady 2
10004     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
10005     bind $top <Key-Escape> [list destroy $top]
10006     grid $top.close -
10007     grid columnconfigure $top 0 -weight 1
10008     grid rowconfigure $top 0 -weight 1
10009     bind $top.list <1> {break}
10010     bind $top.list <B1-Motion> {break}
10011     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10012     set reflist {}
10013     refill_reflist
10014 }
10015
10016 proc sel_reflist {w x y} {
10017     global showrefstop reflist headids tagids otherrefids
10018
10019     if {![winfo exists $showrefstop]} return
10020     set l [lindex [split [$w index "@$x,$y"] "."] 0]
10021     set ref [lindex $reflist [expr {$l-1}]]
10022     set n [lindex $ref 0]
10023     switch -- [lindex $ref 1] {
10024         "H" {selbyid $headids($n)}
10025         "T" {selbyid $tagids($n)}
10026         "o" {selbyid $otherrefids($n)}
10027     }
10028     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10029 }
10030
10031 proc unsel_reflist {} {
10032     global showrefstop
10033
10034     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10035     $showrefstop.list tag remove highlight 0.0 end
10036 }
10037
10038 proc reflistfilter_change {n1 n2 op} {
10039     global reflistfilter
10040
10041     after cancel refill_reflist
10042     after 200 refill_reflist
10043 }
10044
10045 proc refill_reflist {} {
10046     global reflist reflistfilter showrefstop headids tagids otherrefids
10047     global curview
10048
10049     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10050     set refs {}
10051     foreach n [array names headids] {
10052         if {[string match $reflistfilter $n]} {
10053             if {[commitinview $headids($n) $curview]} {
10054                 lappend refs [list $n H]
10055             } else {
10056                 interestedin $headids($n) {run refill_reflist}
10057             }
10058         }
10059     }
10060     foreach n [array names tagids] {
10061         if {[string match $reflistfilter $n]} {
10062             if {[commitinview $tagids($n) $curview]} {
10063                 lappend refs [list $n T]
10064             } else {
10065                 interestedin $tagids($n) {run refill_reflist}
10066             }
10067         }
10068     }
10069     foreach n [array names otherrefids] {
10070         if {[string match $reflistfilter $n]} {
10071             if {[commitinview $otherrefids($n) $curview]} {
10072                 lappend refs [list $n o]
10073             } else {
10074                 interestedin $otherrefids($n) {run refill_reflist}
10075             }
10076         }
10077     }
10078     set refs [lsort -index 0 $refs]
10079     if {$refs eq $reflist} return
10080
10081     # Update the contents of $showrefstop.list according to the
10082     # differences between $reflist (old) and $refs (new)
10083     $showrefstop.list conf -state normal
10084     $showrefstop.list insert end "\n"
10085     set i 0
10086     set j 0
10087     while {$i < [llength $reflist] || $j < [llength $refs]} {
10088         if {$i < [llength $reflist]} {
10089             if {$j < [llength $refs]} {
10090                 set cmp [string compare [lindex $reflist $i 0] \
10091                              [lindex $refs $j 0]]
10092                 if {$cmp == 0} {
10093                     set cmp [string compare [lindex $reflist $i 1] \
10094                                  [lindex $refs $j 1]]
10095                 }
10096             } else {
10097                 set cmp -1
10098             }
10099         } else {
10100             set cmp 1
10101         }
10102         switch -- $cmp {
10103             -1 {
10104                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10105                 incr i
10106             }
10107             0 {
10108                 incr i
10109                 incr j
10110             }
10111             1 {
10112                 set l [expr {$j + 1}]
10113                 $showrefstop.list image create $l.0 -align baseline \
10114                     -image reficon-[lindex $refs $j 1] -padx 2
10115                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10116                 incr j
10117             }
10118         }
10119     }
10120     set reflist $refs
10121     # delete last newline
10122     $showrefstop.list delete end-2c end-1c
10123     $showrefstop.list conf -state disabled
10124 }
10125
10126 # Stuff for finding nearby tags
10127 proc getallcommits {} {
10128     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10129     global idheads idtags idotherrefs allparents tagobjid
10130     global gitdir
10131
10132     if {![info exists allcommits]} {
10133         set nextarc 0
10134         set allcommits 0
10135         set seeds {}
10136         set allcwait 0
10137         set cachedarcs 0
10138         set allccache [file join $gitdir "gitk.cache"]
10139         if {![catch {
10140             set f [open $allccache r]
10141             set allcwait 1
10142             getcache $f
10143         }]} return
10144     }
10145
10146     if {$allcwait} {
10147         return
10148     }
10149     set cmd [list | git rev-list --parents]
10150     set allcupdate [expr {$seeds ne {}}]
10151     if {!$allcupdate} {
10152         set ids "--all"
10153     } else {
10154         set refs [concat [array names idheads] [array names idtags] \
10155                       [array names idotherrefs]]
10156         set ids {}
10157         set tagobjs {}
10158         foreach name [array names tagobjid] {
10159             lappend tagobjs $tagobjid($name)
10160         }
10161         foreach id [lsort -unique $refs] {
10162             if {![info exists allparents($id)] &&
10163                 [lsearch -exact $tagobjs $id] < 0} {
10164                 lappend ids $id
10165             }
10166         }
10167         if {$ids ne {}} {
10168             foreach id $seeds {
10169                 lappend ids "^$id"
10170             }
10171         }
10172     }
10173     if {$ids ne {}} {
10174         set fd [open [concat $cmd $ids] r]
10175         fconfigure $fd -blocking 0
10176         incr allcommits
10177         nowbusy allcommits
10178         filerun $fd [list getallclines $fd]
10179     } else {
10180         dispneartags 0
10181     }
10182 }
10183
10184 # Since most commits have 1 parent and 1 child, we group strings of
10185 # such commits into "arcs" joining branch/merge points (BMPs), which
10186 # are commits that either don't have 1 parent or don't have 1 child.
10187 #
10188 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10189 # arcout(id) - outgoing arcs for BMP
10190 # arcids(a) - list of IDs on arc including end but not start
10191 # arcstart(a) - BMP ID at start of arc
10192 # arcend(a) - BMP ID at end of arc
10193 # growing(a) - arc a is still growing
10194 # arctags(a) - IDs out of arcids (excluding end) that have tags
10195 # archeads(a) - IDs out of arcids (excluding end) that have heads
10196 # The start of an arc is at the descendent end, so "incoming" means
10197 # coming from descendents, and "outgoing" means going towards ancestors.
10198
10199 proc getallclines {fd} {
10200     global allparents allchildren idtags idheads nextarc
10201     global arcnos arcids arctags arcout arcend arcstart archeads growing
10202     global seeds allcommits cachedarcs allcupdate
10203
10204     set nid 0
10205     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10206         set id [lindex $line 0]
10207         if {[info exists allparents($id)]} {
10208             # seen it already
10209             continue
10210         }
10211         set cachedarcs 0
10212         set olds [lrange $line 1 end]
10213         set allparents($id) $olds
10214         if {![info exists allchildren($id)]} {
10215             set allchildren($id) {}
10216             set arcnos($id) {}
10217             lappend seeds $id
10218         } else {
10219             set a $arcnos($id)
10220             if {[llength $olds] == 1 && [llength $a] == 1} {
10221                 lappend arcids($a) $id
10222                 if {[info exists idtags($id)]} {
10223                     lappend arctags($a) $id
10224                 }
10225                 if {[info exists idheads($id)]} {
10226                     lappend archeads($a) $id
10227                 }
10228                 if {[info exists allparents($olds)]} {
10229                     # seen parent already
10230                     if {![info exists arcout($olds)]} {
10231                         splitarc $olds
10232                     }
10233                     lappend arcids($a) $olds
10234                     set arcend($a) $olds
10235                     unset growing($a)
10236                 }
10237                 lappend allchildren($olds) $id
10238                 lappend arcnos($olds) $a
10239                 continue
10240             }
10241         }
10242         foreach a $arcnos($id) {
10243             lappend arcids($a) $id
10244             set arcend($a) $id
10245             unset growing($a)
10246         }
10247
10248         set ao {}
10249         foreach p $olds {
10250             lappend allchildren($p) $id
10251             set a [incr nextarc]
10252             set arcstart($a) $id
10253             set archeads($a) {}
10254             set arctags($a) {}
10255             set archeads($a) {}
10256             set arcids($a) {}
10257             lappend ao $a
10258             set growing($a) 1
10259             if {[info exists allparents($p)]} {
10260                 # seen it already, may need to make a new branch
10261                 if {![info exists arcout($p)]} {
10262                     splitarc $p
10263                 }
10264                 lappend arcids($a) $p
10265                 set arcend($a) $p
10266                 unset growing($a)
10267             }
10268             lappend arcnos($p) $a
10269         }
10270         set arcout($id) $ao
10271     }
10272     if {$nid > 0} {
10273         global cached_dheads cached_dtags cached_atags
10274         unset -nocomplain cached_dheads
10275         unset -nocomplain cached_dtags
10276         unset -nocomplain cached_atags
10277     }
10278     if {![eof $fd]} {
10279         return [expr {$nid >= 1000? 2: 1}]
10280     }
10281     set cacheok 1
10282     if {[catch {
10283         fconfigure $fd -blocking 1
10284         close $fd
10285     } err]} {
10286         # got an error reading the list of commits
10287         # if we were updating, try rereading the whole thing again
10288         if {$allcupdate} {
10289             incr allcommits -1
10290             dropcache $err
10291             return
10292         }
10293         error_popup "[mc "Error reading commit topology information;\
10294                 branch and preceding/following tag information\
10295                 will be incomplete."]\n($err)"
10296         set cacheok 0
10297     }
10298     if {[incr allcommits -1] == 0} {
10299         notbusy allcommits
10300         if {$cacheok} {
10301             run savecache
10302         }
10303     }
10304     dispneartags 0
10305     return 0
10306 }
10307
10308 proc recalcarc {a} {
10309     global arctags archeads arcids idtags idheads
10310
10311     set at {}
10312     set ah {}
10313     foreach id [lrange $arcids($a) 0 end-1] {
10314         if {[info exists idtags($id)]} {
10315             lappend at $id
10316         }
10317         if {[info exists idheads($id)]} {
10318             lappend ah $id
10319         }
10320     }
10321     set arctags($a) $at
10322     set archeads($a) $ah
10323 }
10324
10325 proc splitarc {p} {
10326     global arcnos arcids nextarc arctags archeads idtags idheads
10327     global arcstart arcend arcout allparents growing
10328
10329     set a $arcnos($p)
10330     if {[llength $a] != 1} {
10331         puts "oops splitarc called but [llength $a] arcs already"
10332         return
10333     }
10334     set a [lindex $a 0]
10335     set i [lsearch -exact $arcids($a) $p]
10336     if {$i < 0} {
10337         puts "oops splitarc $p not in arc $a"
10338         return
10339     }
10340     set na [incr nextarc]
10341     if {[info exists arcend($a)]} {
10342         set arcend($na) $arcend($a)
10343     } else {
10344         set l [lindex $allparents([lindex $arcids($a) end]) 0]
10345         set j [lsearch -exact $arcnos($l) $a]
10346         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10347     }
10348     set tail [lrange $arcids($a) [expr {$i+1}] end]
10349     set arcids($a) [lrange $arcids($a) 0 $i]
10350     set arcend($a) $p
10351     set arcstart($na) $p
10352     set arcout($p) $na
10353     set arcids($na) $tail
10354     if {[info exists growing($a)]} {
10355         set growing($na) 1
10356         unset growing($a)
10357     }
10358
10359     foreach id $tail {
10360         if {[llength $arcnos($id)] == 1} {
10361             set arcnos($id) $na
10362         } else {
10363             set j [lsearch -exact $arcnos($id) $a]
10364             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10365         }
10366     }
10367
10368     # reconstruct tags and heads lists
10369     if {$arctags($a) ne {} || $archeads($a) ne {}} {
10370         recalcarc $a
10371         recalcarc $na
10372     } else {
10373         set arctags($na) {}
10374         set archeads($na) {}
10375     }
10376 }
10377
10378 # Update things for a new commit added that is a child of one
10379 # existing commit.  Used when cherry-picking.
10380 proc addnewchild {id p} {
10381     global allparents allchildren idtags nextarc
10382     global arcnos arcids arctags arcout arcend arcstart archeads growing
10383     global seeds allcommits
10384
10385     if {![info exists allcommits] || ![info exists arcnos($p)]} return
10386     set allparents($id) [list $p]
10387     set allchildren($id) {}
10388     set arcnos($id) {}
10389     lappend seeds $id
10390     lappend allchildren($p) $id
10391     set a [incr nextarc]
10392     set arcstart($a) $id
10393     set archeads($a) {}
10394     set arctags($a) {}
10395     set arcids($a) [list $p]
10396     set arcend($a) $p
10397     if {![info exists arcout($p)]} {
10398         splitarc $p
10399     }
10400     lappend arcnos($p) $a
10401     set arcout($id) [list $a]
10402 }
10403
10404 # This implements a cache for the topology information.
10405 # The cache saves, for each arc, the start and end of the arc,
10406 # the ids on the arc, and the outgoing arcs from the end.
10407 proc readcache {f} {
10408     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10409     global idtags idheads allparents cachedarcs possible_seeds seeds growing
10410     global allcwait
10411
10412     set a $nextarc
10413     set lim $cachedarcs
10414     if {$lim - $a > 500} {
10415         set lim [expr {$a + 500}]
10416     }
10417     if {[catch {
10418         if {$a == $lim} {
10419             # finish reading the cache and setting up arctags, etc.
10420             set line [gets $f]
10421             if {$line ne "1"} {error "bad final version"}
10422             close $f
10423             foreach id [array names idtags] {
10424                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10425                     [llength $allparents($id)] == 1} {
10426                     set a [lindex $arcnos($id) 0]
10427                     if {$arctags($a) eq {}} {
10428                         recalcarc $a
10429                     }
10430                 }
10431             }
10432             foreach id [array names idheads] {
10433                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10434                     [llength $allparents($id)] == 1} {
10435                     set a [lindex $arcnos($id) 0]
10436                     if {$archeads($a) eq {}} {
10437                         recalcarc $a
10438                     }
10439                 }
10440             }
10441             foreach id [lsort -unique $possible_seeds] {
10442                 if {$arcnos($id) eq {}} {
10443                     lappend seeds $id
10444                 }
10445             }
10446             set allcwait 0
10447         } else {
10448             while {[incr a] <= $lim} {
10449                 set line [gets $f]
10450                 if {[llength $line] != 3} {error "bad line"}
10451                 set s [lindex $line 0]
10452                 set arcstart($a) $s
10453                 lappend arcout($s) $a
10454                 if {![info exists arcnos($s)]} {
10455                     lappend possible_seeds $s
10456                     set arcnos($s) {}
10457                 }
10458                 set e [lindex $line 1]
10459                 if {$e eq {}} {
10460                     set growing($a) 1
10461                 } else {
10462                     set arcend($a) $e
10463                     if {![info exists arcout($e)]} {
10464                         set arcout($e) {}
10465                     }
10466                 }
10467                 set arcids($a) [lindex $line 2]
10468                 foreach id $arcids($a) {
10469                     lappend allparents($s) $id
10470                     set s $id
10471                     lappend arcnos($id) $a
10472                 }
10473                 if {![info exists allparents($s)]} {
10474                     set allparents($s) {}
10475                 }
10476                 set arctags($a) {}
10477                 set archeads($a) {}
10478             }
10479             set nextarc [expr {$a - 1}]
10480         }
10481     } err]} {
10482         dropcache $err
10483         return 0
10484     }
10485     if {!$allcwait} {
10486         getallcommits
10487     }
10488     return $allcwait
10489 }
10490
10491 proc getcache {f} {
10492     global nextarc cachedarcs possible_seeds
10493
10494     if {[catch {
10495         set line [gets $f]
10496         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10497         # make sure it's an integer
10498         set cachedarcs [expr {int([lindex $line 1])}]
10499         if {$cachedarcs < 0} {error "bad number of arcs"}
10500         set nextarc 0
10501         set possible_seeds {}
10502         run readcache $f
10503     } err]} {
10504         dropcache $err
10505     }
10506     return 0
10507 }
10508
10509 proc dropcache {err} {
10510     global allcwait nextarc cachedarcs seeds
10511
10512     #puts "dropping cache ($err)"
10513     foreach v {arcnos arcout arcids arcstart arcend growing \
10514                    arctags archeads allparents allchildren} {
10515         global $v
10516         unset -nocomplain $v
10517     }
10518     set allcwait 0
10519     set nextarc 0
10520     set cachedarcs 0
10521     set seeds {}
10522     getallcommits
10523 }
10524
10525 proc writecache {f} {
10526     global cachearc cachedarcs allccache
10527     global arcstart arcend arcnos arcids arcout
10528
10529     set a $cachearc
10530     set lim $cachedarcs
10531     if {$lim - $a > 1000} {
10532         set lim [expr {$a + 1000}]
10533     }
10534     if {[catch {
10535         while {[incr a] <= $lim} {
10536             if {[info exists arcend($a)]} {
10537                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10538             } else {
10539                 puts $f [list $arcstart($a) {} $arcids($a)]
10540             }
10541         }
10542     } err]} {
10543         catch {close $f}
10544         catch {file delete $allccache}
10545         #puts "writing cache failed ($err)"
10546         return 0
10547     }
10548     set cachearc [expr {$a - 1}]
10549     if {$a > $cachedarcs} {
10550         puts $f "1"
10551         close $f
10552         return 0
10553     }
10554     return 1
10555 }
10556
10557 proc savecache {} {
10558     global nextarc cachedarcs cachearc allccache
10559
10560     if {$nextarc == $cachedarcs} return
10561     set cachearc 0
10562     set cachedarcs $nextarc
10563     catch {
10564         set f [open $allccache w]
10565         puts $f [list 1 $cachedarcs]
10566         run writecache $f
10567     }
10568 }
10569
10570 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10571 # or 0 if neither is true.
10572 proc anc_or_desc {a b} {
10573     global arcout arcstart arcend arcnos cached_isanc
10574
10575     if {$arcnos($a) eq $arcnos($b)} {
10576         # Both are on the same arc(s); either both are the same BMP,
10577         # or if one is not a BMP, the other is also not a BMP or is
10578         # the BMP at end of the arc (and it only has 1 incoming arc).
10579         # Or both can be BMPs with no incoming arcs.
10580         if {$a eq $b || $arcnos($a) eq {}} {
10581             return 0
10582         }
10583         # assert {[llength $arcnos($a)] == 1}
10584         set arc [lindex $arcnos($a) 0]
10585         set i [lsearch -exact $arcids($arc) $a]
10586         set j [lsearch -exact $arcids($arc) $b]
10587         if {$i < 0 || $i > $j} {
10588             return 1
10589         } else {
10590             return -1
10591         }
10592     }
10593
10594     if {![info exists arcout($a)]} {
10595         set arc [lindex $arcnos($a) 0]
10596         if {[info exists arcend($arc)]} {
10597             set aend $arcend($arc)
10598         } else {
10599             set aend {}
10600         }
10601         set a $arcstart($arc)
10602     } else {
10603         set aend $a
10604     }
10605     if {![info exists arcout($b)]} {
10606         set arc [lindex $arcnos($b) 0]
10607         if {[info exists arcend($arc)]} {
10608             set bend $arcend($arc)
10609         } else {
10610             set bend {}
10611         }
10612         set b $arcstart($arc)
10613     } else {
10614         set bend $b
10615     }
10616     if {$a eq $bend} {
10617         return 1
10618     }
10619     if {$b eq $aend} {
10620         return -1
10621     }
10622     if {[info exists cached_isanc($a,$bend)]} {
10623         if {$cached_isanc($a,$bend)} {
10624             return 1
10625         }
10626     }
10627     if {[info exists cached_isanc($b,$aend)]} {
10628         if {$cached_isanc($b,$aend)} {
10629             return -1
10630         }
10631         if {[info exists cached_isanc($a,$bend)]} {
10632             return 0
10633         }
10634     }
10635
10636     set todo [list $a $b]
10637     set anc($a) a
10638     set anc($b) b
10639     for {set i 0} {$i < [llength $todo]} {incr i} {
10640         set x [lindex $todo $i]
10641         if {$anc($x) eq {}} {
10642             continue
10643         }
10644         foreach arc $arcnos($x) {
10645             set xd $arcstart($arc)
10646             if {$xd eq $bend} {
10647                 set cached_isanc($a,$bend) 1
10648                 set cached_isanc($b,$aend) 0
10649                 return 1
10650             } elseif {$xd eq $aend} {
10651                 set cached_isanc($b,$aend) 1
10652                 set cached_isanc($a,$bend) 0
10653                 return -1
10654             }
10655             if {![info exists anc($xd)]} {
10656                 set anc($xd) $anc($x)
10657                 lappend todo $xd
10658             } elseif {$anc($xd) ne $anc($x)} {
10659                 set anc($xd) {}
10660             }
10661         }
10662     }
10663     set cached_isanc($a,$bend) 0
10664     set cached_isanc($b,$aend) 0
10665     return 0
10666 }
10667
10668 # This identifies whether $desc has an ancestor that is
10669 # a growing tip of the graph and which is not an ancestor of $anc
10670 # and returns 0 if so and 1 if not.
10671 # If we subsequently discover a tag on such a growing tip, and that
10672 # turns out to be a descendent of $anc (which it could, since we
10673 # don't necessarily see children before parents), then $desc
10674 # isn't a good choice to display as a descendent tag of
10675 # $anc (since it is the descendent of another tag which is
10676 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10677 # display as a ancestor tag of $desc.
10678 #
10679 proc is_certain {desc anc} {
10680     global arcnos arcout arcstart arcend growing problems
10681
10682     set certain {}
10683     if {[llength $arcnos($anc)] == 1} {
10684         # tags on the same arc are certain
10685         if {$arcnos($desc) eq $arcnos($anc)} {
10686             return 1
10687         }
10688         if {![info exists arcout($anc)]} {
10689             # if $anc is partway along an arc, use the start of the arc instead
10690             set a [lindex $arcnos($anc) 0]
10691             set anc $arcstart($a)
10692         }
10693     }
10694     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10695         set x $desc
10696     } else {
10697         set a [lindex $arcnos($desc) 0]
10698         set x $arcend($a)
10699     }
10700     if {$x == $anc} {
10701         return 1
10702     }
10703     set anclist [list $x]
10704     set dl($x) 1
10705     set nnh 1
10706     set ngrowanc 0
10707     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10708         set x [lindex $anclist $i]
10709         if {$dl($x)} {
10710             incr nnh -1
10711         }
10712         set done($x) 1
10713         foreach a $arcout($x) {
10714             if {[info exists growing($a)]} {
10715                 if {![info exists growanc($x)] && $dl($x)} {
10716                     set growanc($x) 1
10717                     incr ngrowanc
10718                 }
10719             } else {
10720                 set y $arcend($a)
10721                 if {[info exists dl($y)]} {
10722                     if {$dl($y)} {
10723                         if {!$dl($x)} {
10724                             set dl($y) 0
10725                             if {![info exists done($y)]} {
10726                                 incr nnh -1
10727                             }
10728                             if {[info exists growanc($x)]} {
10729                                 incr ngrowanc -1
10730                             }
10731                             set xl [list $y]
10732                             for {set k 0} {$k < [llength $xl]} {incr k} {
10733                                 set z [lindex $xl $k]
10734                                 foreach c $arcout($z) {
10735                                     if {[info exists arcend($c)]} {
10736                                         set v $arcend($c)
10737                                         if {[info exists dl($v)] && $dl($v)} {
10738                                             set dl($v) 0
10739                                             if {![info exists done($v)]} {
10740                                                 incr nnh -1
10741                                             }
10742                                             if {[info exists growanc($v)]} {
10743                                                 incr ngrowanc -1
10744                                             }
10745                                             lappend xl $v
10746                                         }
10747                                     }
10748                                 }
10749                             }
10750                         }
10751                     }
10752                 } elseif {$y eq $anc || !$dl($x)} {
10753                     set dl($y) 0
10754                     lappend anclist $y
10755                 } else {
10756                     set dl($y) 1
10757                     lappend anclist $y
10758                     incr nnh
10759                 }
10760             }
10761         }
10762     }
10763     foreach x [array names growanc] {
10764         if {$dl($x)} {
10765             return 0
10766         }
10767         return 0
10768     }
10769     return 1
10770 }
10771
10772 proc validate_arctags {a} {
10773     global arctags idtags
10774
10775     set i -1
10776     set na $arctags($a)
10777     foreach id $arctags($a) {
10778         incr i
10779         if {![info exists idtags($id)]} {
10780             set na [lreplace $na $i $i]
10781             incr i -1
10782         }
10783     }
10784     set arctags($a) $na
10785 }
10786
10787 proc validate_archeads {a} {
10788     global archeads idheads
10789
10790     set i -1
10791     set na $archeads($a)
10792     foreach id $archeads($a) {
10793         incr i
10794         if {![info exists idheads($id)]} {
10795             set na [lreplace $na $i $i]
10796             incr i -1
10797         }
10798     }
10799     set archeads($a) $na
10800 }
10801
10802 # Return the list of IDs that have tags that are descendents of id,
10803 # ignoring IDs that are descendents of IDs already reported.
10804 proc desctags {id} {
10805     global arcnos arcstart arcids arctags idtags allparents
10806     global growing cached_dtags
10807
10808     if {![info exists allparents($id)]} {
10809         return {}
10810     }
10811     set t1 [clock clicks -milliseconds]
10812     set argid $id
10813     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10814         # part-way along an arc; check that arc first
10815         set a [lindex $arcnos($id) 0]
10816         if {$arctags($a) ne {}} {
10817             validate_arctags $a
10818             set i [lsearch -exact $arcids($a) $id]
10819             set tid {}
10820             foreach t $arctags($a) {
10821                 set j [lsearch -exact $arcids($a) $t]
10822                 if {$j >= $i} break
10823                 set tid $t
10824             }
10825             if {$tid ne {}} {
10826                 return $tid
10827             }
10828         }
10829         set id $arcstart($a)
10830         if {[info exists idtags($id)]} {
10831             return $id
10832         }
10833     }
10834     if {[info exists cached_dtags($id)]} {
10835         return $cached_dtags($id)
10836     }
10837
10838     set origid $id
10839     set todo [list $id]
10840     set queued($id) 1
10841     set nc 1
10842     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10843         set id [lindex $todo $i]
10844         set done($id) 1
10845         set ta [info exists hastaggedancestor($id)]
10846         if {!$ta} {
10847             incr nc -1
10848         }
10849         # ignore tags on starting node
10850         if {!$ta && $i > 0} {
10851             if {[info exists idtags($id)]} {
10852                 set tagloc($id) $id
10853                 set ta 1
10854             } elseif {[info exists cached_dtags($id)]} {
10855                 set tagloc($id) $cached_dtags($id)
10856                 set ta 1
10857             }
10858         }
10859         foreach a $arcnos($id) {
10860             set d $arcstart($a)
10861             if {!$ta && $arctags($a) ne {}} {
10862                 validate_arctags $a
10863                 if {$arctags($a) ne {}} {
10864                     lappend tagloc($id) [lindex $arctags($a) end]
10865                 }
10866             }
10867             if {$ta || $arctags($a) ne {}} {
10868                 set tomark [list $d]
10869                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10870                     set dd [lindex $tomark $j]
10871                     if {![info exists hastaggedancestor($dd)]} {
10872                         if {[info exists done($dd)]} {
10873                             foreach b $arcnos($dd) {
10874                                 lappend tomark $arcstart($b)
10875                             }
10876                             if {[info exists tagloc($dd)]} {
10877                                 unset tagloc($dd)
10878                             }
10879                         } elseif {[info exists queued($dd)]} {
10880                             incr nc -1
10881                         }
10882                         set hastaggedancestor($dd) 1
10883                     }
10884                 }
10885             }
10886             if {![info exists queued($d)]} {
10887                 lappend todo $d
10888                 set queued($d) 1
10889                 if {![info exists hastaggedancestor($d)]} {
10890                     incr nc
10891                 }
10892             }
10893         }
10894     }
10895     set tags {}
10896     foreach id [array names tagloc] {
10897         if {![info exists hastaggedancestor($id)]} {
10898             foreach t $tagloc($id) {
10899                 if {[lsearch -exact $tags $t] < 0} {
10900                     lappend tags $t
10901                 }
10902             }
10903         }
10904     }
10905     set t2 [clock clicks -milliseconds]
10906     set loopix $i
10907
10908     # remove tags that are descendents of other tags
10909     for {set i 0} {$i < [llength $tags]} {incr i} {
10910         set a [lindex $tags $i]
10911         for {set j 0} {$j < $i} {incr j} {
10912             set b [lindex $tags $j]
10913             set r [anc_or_desc $a $b]
10914             if {$r == 1} {
10915                 set tags [lreplace $tags $j $j]
10916                 incr j -1
10917                 incr i -1
10918             } elseif {$r == -1} {
10919                 set tags [lreplace $tags $i $i]
10920                 incr i -1
10921                 break
10922             }
10923         }
10924     }
10925
10926     if {[array names growing] ne {}} {
10927         # graph isn't finished, need to check if any tag could get
10928         # eclipsed by another tag coming later.  Simply ignore any
10929         # tags that could later get eclipsed.
10930         set ctags {}
10931         foreach t $tags {
10932             if {[is_certain $t $origid]} {
10933                 lappend ctags $t
10934             }
10935         }
10936         if {$tags eq $ctags} {
10937             set cached_dtags($origid) $tags
10938         } else {
10939             set tags $ctags
10940         }
10941     } else {
10942         set cached_dtags($origid) $tags
10943     }
10944     set t3 [clock clicks -milliseconds]
10945     if {0 && $t3 - $t1 >= 100} {
10946         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10947             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10948     }
10949     return $tags
10950 }
10951
10952 proc anctags {id} {
10953     global arcnos arcids arcout arcend arctags idtags allparents
10954     global growing cached_atags
10955
10956     if {![info exists allparents($id)]} {
10957         return {}
10958     }
10959     set t1 [clock clicks -milliseconds]
10960     set argid $id
10961     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10962         # part-way along an arc; check that arc first
10963         set a [lindex $arcnos($id) 0]
10964         if {$arctags($a) ne {}} {
10965             validate_arctags $a
10966             set i [lsearch -exact $arcids($a) $id]
10967             foreach t $arctags($a) {
10968                 set j [lsearch -exact $arcids($a) $t]
10969                 if {$j > $i} {
10970                     return $t
10971                 }
10972             }
10973         }
10974         if {![info exists arcend($a)]} {
10975             return {}
10976         }
10977         set id $arcend($a)
10978         if {[info exists idtags($id)]} {
10979             return $id
10980         }
10981     }
10982     if {[info exists cached_atags($id)]} {
10983         return $cached_atags($id)
10984     }
10985
10986     set origid $id
10987     set todo [list $id]
10988     set queued($id) 1
10989     set taglist {}
10990     set nc 1
10991     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10992         set id [lindex $todo $i]
10993         set done($id) 1
10994         set td [info exists hastaggeddescendent($id)]
10995         if {!$td} {
10996             incr nc -1
10997         }
10998         # ignore tags on starting node
10999         if {!$td && $i > 0} {
11000             if {[info exists idtags($id)]} {
11001                 set tagloc($id) $id
11002                 set td 1
11003             } elseif {[info exists cached_atags($id)]} {
11004                 set tagloc($id) $cached_atags($id)
11005                 set td 1
11006             }
11007         }
11008         foreach a $arcout($id) {
11009             if {!$td && $arctags($a) ne {}} {
11010                 validate_arctags $a
11011                 if {$arctags($a) ne {}} {
11012                     lappend tagloc($id) [lindex $arctags($a) 0]
11013                 }
11014             }
11015             if {![info exists arcend($a)]} continue
11016             set d $arcend($a)
11017             if {$td || $arctags($a) ne {}} {
11018                 set tomark [list $d]
11019                 for {set j 0} {$j < [llength $tomark]} {incr j} {
11020                     set dd [lindex $tomark $j]
11021                     if {![info exists hastaggeddescendent($dd)]} {
11022                         if {[info exists done($dd)]} {
11023                             foreach b $arcout($dd) {
11024                                 if {[info exists arcend($b)]} {
11025                                     lappend tomark $arcend($b)
11026                                 }
11027                             }
11028                             if {[info exists tagloc($dd)]} {
11029                                 unset tagloc($dd)
11030                             }
11031                         } elseif {[info exists queued($dd)]} {
11032                             incr nc -1
11033                         }
11034                         set hastaggeddescendent($dd) 1
11035                     }
11036                 }
11037             }
11038             if {![info exists queued($d)]} {
11039                 lappend todo $d
11040                 set queued($d) 1
11041                 if {![info exists hastaggeddescendent($d)]} {
11042                     incr nc
11043                 }
11044             }
11045         }
11046     }
11047     set t2 [clock clicks -milliseconds]
11048     set loopix $i
11049     set tags {}
11050     foreach id [array names tagloc] {
11051         if {![info exists hastaggeddescendent($id)]} {
11052             foreach t $tagloc($id) {
11053                 if {[lsearch -exact $tags $t] < 0} {
11054                     lappend tags $t
11055                 }
11056             }
11057         }
11058     }
11059
11060     # remove tags that are ancestors of other tags
11061     for {set i 0} {$i < [llength $tags]} {incr i} {
11062         set a [lindex $tags $i]
11063         for {set j 0} {$j < $i} {incr j} {
11064             set b [lindex $tags $j]
11065             set r [anc_or_desc $a $b]
11066             if {$r == -1} {
11067                 set tags [lreplace $tags $j $j]
11068                 incr j -1
11069                 incr i -1
11070             } elseif {$r == 1} {
11071                 set tags [lreplace $tags $i $i]
11072                 incr i -1
11073                 break
11074             }
11075         }
11076     }
11077
11078     if {[array names growing] ne {}} {
11079         # graph isn't finished, need to check if any tag could get
11080         # eclipsed by another tag coming later.  Simply ignore any
11081         # tags that could later get eclipsed.
11082         set ctags {}
11083         foreach t $tags {
11084             if {[is_certain $origid $t]} {
11085                 lappend ctags $t
11086             }
11087         }
11088         if {$tags eq $ctags} {
11089             set cached_atags($origid) $tags
11090         } else {
11091             set tags $ctags
11092         }
11093     } else {
11094         set cached_atags($origid) $tags
11095     }
11096     set t3 [clock clicks -milliseconds]
11097     if {0 && $t3 - $t1 >= 100} {
11098         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11099             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11100     }
11101     return $tags
11102 }
11103
11104 # Return the list of IDs that have heads that are descendents of id,
11105 # including id itself if it has a head.
11106 proc descheads {id} {
11107     global arcnos arcstart arcids archeads idheads cached_dheads
11108     global allparents arcout
11109
11110     if {![info exists allparents($id)]} {
11111         return {}
11112     }
11113     set aret {}
11114     if {![info exists arcout($id)]} {
11115         # part-way along an arc; check it first
11116         set a [lindex $arcnos($id) 0]
11117         if {$archeads($a) ne {}} {
11118             validate_archeads $a
11119             set i [lsearch -exact $arcids($a) $id]
11120             foreach t $archeads($a) {
11121                 set j [lsearch -exact $arcids($a) $t]
11122                 if {$j > $i} break
11123                 lappend aret $t
11124             }
11125         }
11126         set id $arcstart($a)
11127     }
11128     set origid $id
11129     set todo [list $id]
11130     set seen($id) 1
11131     set ret {}
11132     for {set i 0} {$i < [llength $todo]} {incr i} {
11133         set id [lindex $todo $i]
11134         if {[info exists cached_dheads($id)]} {
11135             set ret [concat $ret $cached_dheads($id)]
11136         } else {
11137             if {[info exists idheads($id)]} {
11138                 lappend ret $id
11139             }
11140             foreach a $arcnos($id) {
11141                 if {$archeads($a) ne {}} {
11142                     validate_archeads $a
11143                     if {$archeads($a) ne {}} {
11144                         set ret [concat $ret $archeads($a)]
11145                     }
11146                 }
11147                 set d $arcstart($a)
11148                 if {![info exists seen($d)]} {
11149                     lappend todo $d
11150                     set seen($d) 1
11151                 }
11152             }
11153         }
11154     }
11155     set ret [lsort -unique $ret]
11156     set cached_dheads($origid) $ret
11157     return [concat $ret $aret]
11158 }
11159
11160 proc addedtag {id} {
11161     global arcnos arcout cached_dtags cached_atags
11162
11163     if {![info exists arcnos($id)]} return
11164     if {![info exists arcout($id)]} {
11165         recalcarc [lindex $arcnos($id) 0]
11166     }
11167     unset -nocomplain cached_dtags
11168     unset -nocomplain cached_atags
11169 }
11170
11171 proc addedhead {hid head} {
11172     global arcnos arcout cached_dheads
11173
11174     if {![info exists arcnos($hid)]} return
11175     if {![info exists arcout($hid)]} {
11176         recalcarc [lindex $arcnos($hid) 0]
11177     }
11178     unset -nocomplain cached_dheads
11179 }
11180
11181 proc removedhead {hid head} {
11182     global cached_dheads
11183
11184     unset -nocomplain cached_dheads
11185 }
11186
11187 proc movedhead {hid head} {
11188     global arcnos arcout cached_dheads
11189
11190     if {![info exists arcnos($hid)]} return
11191     if {![info exists arcout($hid)]} {
11192         recalcarc [lindex $arcnos($hid) 0]
11193     }
11194     unset -nocomplain cached_dheads
11195 }
11196
11197 proc changedrefs {} {
11198     global cached_dheads cached_dtags cached_atags cached_tagcontent
11199     global arctags archeads arcnos arcout idheads idtags
11200
11201     foreach id [concat [array names idheads] [array names idtags]] {
11202         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11203             set a [lindex $arcnos($id) 0]
11204             if {![info exists donearc($a)]} {
11205                 recalcarc $a
11206                 set donearc($a) 1
11207             }
11208         }
11209     }
11210     unset -nocomplain cached_tagcontent
11211     unset -nocomplain cached_dtags
11212     unset -nocomplain cached_atags
11213     unset -nocomplain cached_dheads
11214 }
11215
11216 proc rereadrefs {} {
11217     global idtags idheads idotherrefs mainheadid
11218
11219     set refids [concat [array names idtags] \
11220                     [array names idheads] [array names idotherrefs]]
11221     foreach id $refids {
11222         if {![info exists ref($id)]} {
11223             set ref($id) [listrefs $id]
11224         }
11225     }
11226     set oldmainhead $mainheadid
11227     readrefs
11228     changedrefs
11229     set refids [lsort -unique [concat $refids [array names idtags] \
11230                         [array names idheads] [array names idotherrefs]]]
11231     foreach id $refids {
11232         set v [listrefs $id]
11233         if {![info exists ref($id)] || $ref($id) != $v} {
11234             redrawtags $id
11235         }
11236     }
11237     if {$oldmainhead ne $mainheadid} {
11238         redrawtags $oldmainhead
11239         redrawtags $mainheadid
11240     }
11241     run refill_reflist
11242 }
11243
11244 proc listrefs {id} {
11245     global idtags idheads idotherrefs
11246
11247     set x {}
11248     if {[info exists idtags($id)]} {
11249         set x $idtags($id)
11250     }
11251     set y {}
11252     if {[info exists idheads($id)]} {
11253         set y $idheads($id)
11254     }
11255     set z {}
11256     if {[info exists idotherrefs($id)]} {
11257         set z $idotherrefs($id)
11258     }
11259     return [list $x $y $z]
11260 }
11261
11262 proc add_tag_ctext {tag} {
11263     global ctext cached_tagcontent tagids
11264
11265     if {![info exists cached_tagcontent($tag)]} {
11266         catch {
11267             set cached_tagcontent($tag) [exec git cat-file -p $tag]
11268         }
11269     }
11270     $ctext insert end "[mc "Tag"]: $tag\n" bold
11271     if {[info exists cached_tagcontent($tag)]} {
11272         set text $cached_tagcontent($tag)
11273     } else {
11274         set text "[mc "Id"]:  $tagids($tag)"
11275     }
11276     appendwithlinks $text {}
11277 }
11278
11279 proc showtag {tag isnew} {
11280     global ctext cached_tagcontent tagids linknum tagobjid
11281
11282     if {$isnew} {
11283         addtohistory [list showtag $tag 0] savectextpos
11284     }
11285     $ctext conf -state normal
11286     clear_ctext
11287     settabs 0
11288     set linknum 0
11289     add_tag_ctext $tag
11290     maybe_scroll_ctext 1
11291     $ctext conf -state disabled
11292     init_flist {}
11293 }
11294
11295 proc showtags {id isnew} {
11296     global idtags ctext linknum
11297
11298     if {$isnew} {
11299         addtohistory [list showtags $id 0] savectextpos
11300     }
11301     $ctext conf -state normal
11302     clear_ctext
11303     settabs 0
11304     set linknum 0
11305     set sep {}
11306     foreach tag $idtags($id) {
11307         $ctext insert end $sep
11308         add_tag_ctext $tag
11309         set sep "\n\n"
11310     }
11311     maybe_scroll_ctext 1
11312     $ctext conf -state disabled
11313     init_flist {}
11314 }
11315
11316 proc doquit {} {
11317     global stopped
11318     global gitktmpdir
11319
11320     set stopped 100
11321     savestuff .
11322     destroy .
11323
11324     if {[info exists gitktmpdir]} {
11325         catch {file delete -force $gitktmpdir}
11326     }
11327 }
11328
11329 proc mkfontdisp {font top which} {
11330     global fontattr fontpref $font NS use_ttk
11331
11332     set fontpref($font) [set $font]
11333     ${NS}::button $top.${font}but -text $which \
11334         -command [list choosefont $font $which]
11335     ${NS}::label $top.$font -relief flat -font $font \
11336         -text $fontattr($font,family) -justify left
11337     grid x $top.${font}but $top.$font -sticky w
11338 }
11339
11340 proc choosefont {font which} {
11341     global fontparam fontlist fonttop fontattr
11342     global prefstop NS
11343
11344     set fontparam(which) $which
11345     set fontparam(font) $font
11346     set fontparam(family) [font actual $font -family]
11347     set fontparam(size) $fontattr($font,size)
11348     set fontparam(weight) $fontattr($font,weight)
11349     set fontparam(slant) $fontattr($font,slant)
11350     set top .gitkfont
11351     set fonttop $top
11352     if {![winfo exists $top]} {
11353         font create sample
11354         eval font config sample [font actual $font]
11355         ttk_toplevel $top
11356         make_transient $top $prefstop
11357         wm title $top [mc "Gitk font chooser"]
11358         ${NS}::label $top.l -textvariable fontparam(which)
11359         pack $top.l -side top
11360         set fontlist [lsort [font families]]
11361         ${NS}::frame $top.f
11362         listbox $top.f.fam -listvariable fontlist \
11363             -yscrollcommand [list $top.f.sb set]
11364         bind $top.f.fam <<ListboxSelect>> selfontfam
11365         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11366         pack $top.f.sb -side right -fill y
11367         pack $top.f.fam -side left -fill both -expand 1
11368         pack $top.f -side top -fill both -expand 1
11369         ${NS}::frame $top.g
11370         spinbox $top.g.size -from 4 -to 40 -width 4 \
11371             -textvariable fontparam(size) \
11372             -validatecommand {string is integer -strict %s}
11373         checkbutton $top.g.bold -padx 5 \
11374             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11375             -variable fontparam(weight) -onvalue bold -offvalue normal
11376         checkbutton $top.g.ital -padx 5 \
11377             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11378             -variable fontparam(slant) -onvalue italic -offvalue roman
11379         pack $top.g.size $top.g.bold $top.g.ital -side left
11380         pack $top.g -side top
11381         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11382             -background white
11383         $top.c create text 100 25 -anchor center -text $which -font sample \
11384             -fill black -tags text
11385         bind $top.c <Configure> [list centertext $top.c]
11386         pack $top.c -side top -fill x
11387         ${NS}::frame $top.buts
11388         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11389         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11390         bind $top <Key-Return> fontok
11391         bind $top <Key-Escape> fontcan
11392         grid $top.buts.ok $top.buts.can
11393         grid columnconfigure $top.buts 0 -weight 1 -uniform a
11394         grid columnconfigure $top.buts 1 -weight 1 -uniform a
11395         pack $top.buts -side bottom -fill x
11396         trace add variable fontparam write chg_fontparam
11397     } else {
11398         raise $top
11399         $top.c itemconf text -text $which
11400     }
11401     set i [lsearch -exact $fontlist $fontparam(family)]
11402     if {$i >= 0} {
11403         $top.f.fam selection set $i
11404         $top.f.fam see $i
11405     }
11406 }
11407
11408 proc centertext {w} {
11409     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11410 }
11411
11412 proc fontok {} {
11413     global fontparam fontpref prefstop
11414
11415     set f $fontparam(font)
11416     set fontpref($f) [list $fontparam(family) $fontparam(size)]
11417     if {$fontparam(weight) eq "bold"} {
11418         lappend fontpref($f) "bold"
11419     }
11420     if {$fontparam(slant) eq "italic"} {
11421         lappend fontpref($f) "italic"
11422     }
11423     set w $prefstop.notebook.fonts.$f
11424     $w conf -text $fontparam(family) -font $fontpref($f)
11425
11426     fontcan
11427 }
11428
11429 proc fontcan {} {
11430     global fonttop fontparam
11431
11432     if {[info exists fonttop]} {
11433         catch {destroy $fonttop}
11434         catch {font delete sample}
11435         unset fonttop
11436         unset fontparam
11437     }
11438 }
11439
11440 if {[package vsatisfies [package provide Tk] 8.6]} {
11441     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11442     # function to make use of it.
11443     proc choosefont {font which} {
11444         tk fontchooser configure -title $which -font $font \
11445             -command [list on_choosefont $font $which]
11446         tk fontchooser show
11447     }
11448     proc on_choosefont {font which newfont} {
11449         global fontparam
11450         puts stderr "$font $newfont"
11451         array set f [font actual $newfont]
11452         set fontparam(which) $which
11453         set fontparam(font) $font
11454         set fontparam(family) $f(-family)
11455         set fontparam(size) $f(-size)
11456         set fontparam(weight) $f(-weight)
11457         set fontparam(slant) $f(-slant)
11458         fontok
11459     }
11460 }
11461
11462 proc selfontfam {} {
11463     global fonttop fontparam
11464
11465     set i [$fonttop.f.fam curselection]
11466     if {$i ne {}} {
11467         set fontparam(family) [$fonttop.f.fam get $i]
11468     }
11469 }
11470
11471 proc chg_fontparam {v sub op} {
11472     global fontparam
11473
11474     font config sample -$sub $fontparam($sub)
11475 }
11476
11477 # Create a property sheet tab page
11478 proc create_prefs_page {w} {
11479     global NS
11480     set parent [join [lrange [split $w .] 0 end-1] .]
11481     if {[winfo class $parent] eq "TNotebook"} {
11482         ${NS}::frame $w
11483     } else {
11484         ${NS}::labelframe $w
11485     }
11486 }
11487
11488 proc prefspage_general {notebook} {
11489     global NS maxwidth maxgraphpct showneartags showlocalchanges
11490     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11491     global hideremotes want_ttk have_ttk maxrefs
11492
11493     set page [create_prefs_page $notebook.general]
11494
11495     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11496     grid $page.ldisp - -sticky w -pady 10
11497     ${NS}::label $page.spacer -text " "
11498     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11499     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11500     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11501                                          #xgettext:no-tcl-format
11502     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11503     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11504     grid x $page.maxpctl $page.maxpct -sticky w
11505     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11506         -variable showlocalchanges
11507     grid x $page.showlocal -sticky w
11508     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11509         -variable autoselect
11510     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11511     grid x $page.autoselect $page.autosellen -sticky w
11512     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11513         -variable hideremotes
11514     grid x $page.hideremotes -sticky w
11515
11516     ${NS}::label $page.ddisp -text [mc "Diff display options"]
11517     grid $page.ddisp - -sticky w -pady 10
11518     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11519     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11520     grid x $page.tabstopl $page.tabstop -sticky w
11521     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11522         -variable showneartags
11523     grid x $page.ntag -sticky w
11524     ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11525     spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11526     grid x $page.maxrefsl $page.maxrefs -sticky w
11527     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11528         -variable limitdiffs
11529     grid x $page.ldiff -sticky w
11530     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11531         -variable perfile_attrs
11532     grid x $page.lattr -sticky w
11533
11534     ${NS}::entry $page.extdifft -textvariable extdifftool
11535     ${NS}::frame $page.extdifff
11536     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11537     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11538     pack $page.extdifff.l $page.extdifff.b -side left
11539     pack configure $page.extdifff.l -padx 10
11540     grid x $page.extdifff $page.extdifft -sticky ew
11541
11542     ${NS}::label $page.lgen -text [mc "General options"]
11543     grid $page.lgen - -sticky w -pady 10
11544     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11545         -text [mc "Use themed widgets"]
11546     if {$have_ttk} {
11547         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11548     } else {
11549         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11550     }
11551     grid x $page.want_ttk $page.ttk_note -sticky w
11552     return $page
11553 }
11554
11555 proc prefspage_colors {notebook} {
11556     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11557
11558     set page [create_prefs_page $notebook.colors]
11559
11560     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11561     grid $page.cdisp - -sticky w -pady 10
11562     label $page.ui -padx 40 -relief sunk -background $uicolor
11563     ${NS}::button $page.uibut -text [mc "Interface"] \
11564        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11565     grid x $page.uibut $page.ui -sticky w
11566     label $page.bg -padx 40 -relief sunk -background $bgcolor
11567     ${NS}::button $page.bgbut -text [mc "Background"] \
11568         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11569     grid x $page.bgbut $page.bg -sticky w
11570     label $page.fg -padx 40 -relief sunk -background $fgcolor
11571     ${NS}::button $page.fgbut -text [mc "Foreground"] \
11572         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11573     grid x $page.fgbut $page.fg -sticky w
11574     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11575     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11576         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11577                       [list $ctext tag conf d0 -foreground]]
11578     grid x $page.diffoldbut $page.diffold -sticky w
11579     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11580     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11581         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11582                       [list $ctext tag conf dresult -foreground]]
11583     grid x $page.diffnewbut $page.diffnew -sticky w
11584     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11585     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11586         -command [list choosecolor diffcolors 2 $page.hunksep \
11587                       [mc "diff hunk header"] \
11588                       [list $ctext tag conf hunksep -foreground]]
11589     grid x $page.hunksepbut $page.hunksep -sticky w
11590     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11591     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11592         -command [list choosecolor markbgcolor {} $page.markbgsep \
11593                       [mc "marked line background"] \
11594                       [list $ctext tag conf omark -background]]
11595     grid x $page.markbgbut $page.markbgsep -sticky w
11596     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11597     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11598         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11599     grid x $page.selbgbut $page.selbgsep -sticky w
11600     return $page
11601 }
11602
11603 proc prefspage_fonts {notebook} {
11604     global NS
11605     set page [create_prefs_page $notebook.fonts]
11606     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11607     grid $page.cfont - -sticky w -pady 10
11608     mkfontdisp mainfont $page [mc "Main font"]
11609     mkfontdisp textfont $page [mc "Diff display font"]
11610     mkfontdisp uifont $page [mc "User interface font"]
11611     return $page
11612 }
11613
11614 proc doprefs {} {
11615     global maxwidth maxgraphpct use_ttk NS
11616     global oldprefs prefstop showneartags showlocalchanges
11617     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11618     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11619     global hideremotes want_ttk have_ttk
11620
11621     set top .gitkprefs
11622     set prefstop $top
11623     if {[winfo exists $top]} {
11624         raise $top
11625         return
11626     }
11627     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11628                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11629         set oldprefs($v) [set $v]
11630     }
11631     ttk_toplevel $top
11632     wm title $top [mc "Gitk preferences"]
11633     make_transient $top .
11634
11635     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11636         set notebook [ttk::notebook $top.notebook]
11637     } else {
11638         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11639     }
11640
11641     lappend pages [prefspage_general $notebook] [mc "General"]
11642     lappend pages [prefspage_colors $notebook] [mc "Colors"]
11643     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11644     set col 0
11645     foreach {page title} $pages {
11646         if {$use_notebook} {
11647             $notebook add $page -text $title
11648         } else {
11649             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11650                          -text $title -command [list raise $page]]
11651             $page configure -text $title
11652             grid $btn -row 0 -column [incr col] -sticky w
11653             grid $page -row 1 -column 0 -sticky news -columnspan 100
11654         }
11655     }
11656
11657     if {!$use_notebook} {
11658         grid columnconfigure $notebook 0 -weight 1
11659         grid rowconfigure $notebook 1 -weight 1
11660         raise [lindex $pages 0]
11661     }
11662
11663     grid $notebook -sticky news -padx 2 -pady 2
11664     grid rowconfigure $top 0 -weight 1
11665     grid columnconfigure $top 0 -weight 1
11666
11667     ${NS}::frame $top.buts
11668     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11669     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11670     bind $top <Key-Return> prefsok
11671     bind $top <Key-Escape> prefscan
11672     grid $top.buts.ok $top.buts.can
11673     grid columnconfigure $top.buts 0 -weight 1 -uniform a
11674     grid columnconfigure $top.buts 1 -weight 1 -uniform a
11675     grid $top.buts - - -pady 10 -sticky ew
11676     grid columnconfigure $top 2 -weight 1
11677     bind $top <Visibility> [list focus $top.buts.ok]
11678 }
11679
11680 proc choose_extdiff {} {
11681     global extdifftool
11682
11683     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11684     if {$prog ne {}} {
11685         set extdifftool $prog
11686     }
11687 }
11688
11689 proc choosecolor {v vi w x cmd} {
11690     global $v
11691
11692     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11693                -title [mc "Gitk: choose color for %s" $x]]
11694     if {$c eq {}} return
11695     $w conf -background $c
11696     lset $v $vi $c
11697     eval $cmd $c
11698 }
11699
11700 proc setselbg {c} {
11701     global bglist cflist
11702     foreach w $bglist {
11703         if {[winfo exists $w]} {
11704             $w configure -selectbackground $c
11705         }
11706     }
11707     $cflist tag configure highlight \
11708         -background [$cflist cget -selectbackground]
11709     allcanvs itemconf secsel -fill $c
11710 }
11711
11712 # This sets the background color and the color scheme for the whole UI.
11713 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11714 # if we don't specify one ourselves, which makes the checkbuttons and
11715 # radiobuttons look bad.  This chooses white for selectColor if the
11716 # background color is light, or black if it is dark.
11717 proc setui {c} {
11718     if {[tk windowingsystem] eq "win32"} { return }
11719     set bg [winfo rgb . $c]
11720     set selc black
11721     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11722         set selc white
11723     }
11724     tk_setPalette background $c selectColor $selc
11725 }
11726
11727 proc setbg {c} {
11728     global bglist
11729
11730     foreach w $bglist {
11731         if {[winfo exists $w]} {
11732             $w conf -background $c
11733         }
11734     }
11735 }
11736
11737 proc setfg {c} {
11738     global fglist canv
11739
11740     foreach w $fglist {
11741         if {[winfo exists $w]} {
11742             $w conf -foreground $c
11743         }
11744     }
11745     allcanvs itemconf text -fill $c
11746     $canv itemconf circle -outline $c
11747     $canv itemconf markid -outline $c
11748 }
11749
11750 proc prefscan {} {
11751     global oldprefs prefstop
11752
11753     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11754                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11755         global $v
11756         set $v $oldprefs($v)
11757     }
11758     catch {destroy $prefstop}
11759     unset prefstop
11760     fontcan
11761 }
11762
11763 proc prefsok {} {
11764     global maxwidth maxgraphpct
11765     global oldprefs prefstop showneartags showlocalchanges
11766     global fontpref mainfont textfont uifont
11767     global limitdiffs treediffs perfile_attrs
11768     global hideremotes
11769
11770     catch {destroy $prefstop}
11771     unset prefstop
11772     fontcan
11773     set fontchanged 0
11774     if {$mainfont ne $fontpref(mainfont)} {
11775         set mainfont $fontpref(mainfont)
11776         parsefont mainfont $mainfont
11777         eval font configure mainfont [fontflags mainfont]
11778         eval font configure mainfontbold [fontflags mainfont 1]
11779         setcoords
11780         set fontchanged 1
11781     }
11782     if {$textfont ne $fontpref(textfont)} {
11783         set textfont $fontpref(textfont)
11784         parsefont textfont $textfont
11785         eval font configure textfont [fontflags textfont]
11786         eval font configure textfontbold [fontflags textfont 1]
11787     }
11788     if {$uifont ne $fontpref(uifont)} {
11789         set uifont $fontpref(uifont)
11790         parsefont uifont $uifont
11791         eval font configure uifont [fontflags uifont]
11792     }
11793     settabs
11794     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11795         if {$showlocalchanges} {
11796             doshowlocalchanges
11797         } else {
11798             dohidelocalchanges
11799         }
11800     }
11801     if {$limitdiffs != $oldprefs(limitdiffs) ||
11802         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11803         # treediffs elements are limited by path;
11804         # won't have encodings cached if perfile_attrs was just turned on
11805         unset -nocomplain treediffs
11806     }
11807     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11808         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11809         redisplay
11810     } elseif {$showneartags != $oldprefs(showneartags) ||
11811           $limitdiffs != $oldprefs(limitdiffs)} {
11812         reselectline
11813     }
11814     if {$hideremotes != $oldprefs(hideremotes)} {
11815         rereadrefs
11816     }
11817 }
11818
11819 proc formatdate {d} {
11820     global datetimeformat
11821     if {$d ne {}} {
11822         # If $datetimeformat includes a timezone, display in the
11823         # timezone of the argument.  Otherwise, display in local time.
11824         if {[string match {*%[zZ]*} $datetimeformat]} {
11825             if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11826                 # Tcl < 8.5 does not support -timezone.  Emulate it by
11827                 # setting TZ (e.g. TZ=<-0430>+04:30).
11828                 global env
11829                 if {[info exists env(TZ)]} {
11830                     set savedTZ $env(TZ)
11831                 }
11832                 set zone [lindex $d 1]
11833                 set sign [string map {+ - - +} [string index $zone 0]]
11834                 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11835                 set d [clock format [lindex $d 0] -format $datetimeformat]
11836                 if {[info exists savedTZ]} {
11837                     set env(TZ) $savedTZ
11838                 } else {
11839                     unset env(TZ)
11840                 }
11841             }
11842         } else {
11843             set d [clock format [lindex $d 0] -format $datetimeformat]
11844         }
11845     }
11846     return $d
11847 }
11848
11849 # This list of encoding names and aliases is distilled from
11850 # http://www.iana.org/assignments/character-sets.
11851 # Not all of them are supported by Tcl.
11852 set encoding_aliases {
11853     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11854       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11855     { ISO-10646-UTF-1 csISO10646UTF1 }
11856     { ISO_646.basic:1983 ref csISO646basic1983 }
11857     { INVARIANT csINVARIANT }
11858     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11859     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11860     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11861     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11862     { NATS-DANO iso-ir-9-1 csNATSDANO }
11863     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11864     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11865     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11866     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11867     { ISO-2022-KR csISO2022KR }
11868     { EUC-KR csEUCKR }
11869     { ISO-2022-JP csISO2022JP }
11870     { ISO-2022-JP-2 csISO2022JP2 }
11871     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11872       csISO13JISC6220jp }
11873     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11874     { IT iso-ir-15 ISO646-IT csISO15Italian }
11875     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11876     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11877     { greek7-old iso-ir-18 csISO18Greek7Old }
11878     { latin-greek iso-ir-19 csISO19LatinGreek }
11879     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11880     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11881     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11882     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11883     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11884     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11885     { INIS iso-ir-49 csISO49INIS }
11886     { INIS-8 iso-ir-50 csISO50INIS8 }
11887     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11888     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11889     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11890     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11891     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11892     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11893       csISO60Norwegian1 }
11894     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11895     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11896     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11897     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11898     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11899     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11900     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11901     { greek7 iso-ir-88 csISO88Greek7 }
11902     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11903     { iso-ir-90 csISO90 }
11904     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11905     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11906       csISO92JISC62991984b }
11907     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11908     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11909     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11910       csISO95JIS62291984handadd }
11911     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11912     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11913     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11914     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11915       CP819 csISOLatin1 }
11916     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11917     { T.61-7bit iso-ir-102 csISO102T617bit }
11918     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11919     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11920     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11921     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11922     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11923     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11924     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11925     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11926       arabic csISOLatinArabic }
11927     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11928     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11929     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11930       greek greek8 csISOLatinGreek }
11931     { T.101-G2 iso-ir-128 csISO128T101G2 }
11932     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11933       csISOLatinHebrew }
11934     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11935     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11936     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11937     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11938     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11939     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11940     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11941       csISOLatinCyrillic }
11942     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11943     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11944     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11945     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11946     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11947     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11948     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11949     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11950     { ISO_10367-box iso-ir-155 csISO10367Box }
11951     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11952     { latin-lap lap iso-ir-158 csISO158Lap }
11953     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11954     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11955     { us-dk csUSDK }
11956     { dk-us csDKUS }
11957     { JIS_X0201 X0201 csHalfWidthKatakana }
11958     { KSC5636 ISO646-KR csKSC5636 }
11959     { ISO-10646-UCS-2 csUnicode }
11960     { ISO-10646-UCS-4 csUCS4 }
11961     { DEC-MCS dec csDECMCS }
11962     { hp-roman8 roman8 r8 csHPRoman8 }
11963     { macintosh mac csMacintosh }
11964     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11965       csIBM037 }
11966     { IBM038 EBCDIC-INT cp038 csIBM038 }
11967     { IBM273 CP273 csIBM273 }
11968     { IBM274 EBCDIC-BE CP274 csIBM274 }
11969     { IBM275 EBCDIC-BR cp275 csIBM275 }
11970     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11971     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11972     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11973     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11974     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11975     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11976     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11977     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11978     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11979     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11980     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11981     { IBM437 cp437 437 csPC8CodePage437 }
11982     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11983     { IBM775 cp775 csPC775Baltic }
11984     { IBM850 cp850 850 csPC850Multilingual }
11985     { IBM851 cp851 851 csIBM851 }
11986     { IBM852 cp852 852 csPCp852 }
11987     { IBM855 cp855 855 csIBM855 }
11988     { IBM857 cp857 857 csIBM857 }
11989     { IBM860 cp860 860 csIBM860 }
11990     { IBM861 cp861 861 cp-is csIBM861 }
11991     { IBM862 cp862 862 csPC862LatinHebrew }
11992     { IBM863 cp863 863 csIBM863 }
11993     { IBM864 cp864 csIBM864 }
11994     { IBM865 cp865 865 csIBM865 }
11995     { IBM866 cp866 866 csIBM866 }
11996     { IBM868 CP868 cp-ar csIBM868 }
11997     { IBM869 cp869 869 cp-gr csIBM869 }
11998     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11999     { IBM871 CP871 ebcdic-cp-is csIBM871 }
12000     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12001     { IBM891 cp891 csIBM891 }
12002     { IBM903 cp903 csIBM903 }
12003     { IBM904 cp904 904 csIBBM904 }
12004     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12005     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12006     { IBM1026 CP1026 csIBM1026 }
12007     { EBCDIC-AT-DE csIBMEBCDICATDE }
12008     { EBCDIC-AT-DE-A csEBCDICATDEA }
12009     { EBCDIC-CA-FR csEBCDICCAFR }
12010     { EBCDIC-DK-NO csEBCDICDKNO }
12011     { EBCDIC-DK-NO-A csEBCDICDKNOA }
12012     { EBCDIC-FI-SE csEBCDICFISE }
12013     { EBCDIC-FI-SE-A csEBCDICFISEA }
12014     { EBCDIC-FR csEBCDICFR }
12015     { EBCDIC-IT csEBCDICIT }
12016     { EBCDIC-PT csEBCDICPT }
12017     { EBCDIC-ES csEBCDICES }
12018     { EBCDIC-ES-A csEBCDICESA }
12019     { EBCDIC-ES-S csEBCDICESS }
12020     { EBCDIC-UK csEBCDICUK }
12021     { EBCDIC-US csEBCDICUS }
12022     { UNKNOWN-8BIT csUnknown8BiT }
12023     { MNEMONIC csMnemonic }
12024     { MNEM csMnem }
12025     { VISCII csVISCII }
12026     { VIQR csVIQR }
12027     { KOI8-R csKOI8R }
12028     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12029     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12030     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12031     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12032     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12033     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12034     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12035     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12036     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12037     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12038     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12039     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12040     { IBM1047 IBM-1047 }
12041     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12042     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12043     { UNICODE-1-1 csUnicode11 }
12044     { CESU-8 csCESU-8 }
12045     { BOCU-1 csBOCU-1 }
12046     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12047     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12048       l8 }
12049     { ISO-8859-15 ISO_8859-15 Latin-9 }
12050     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12051     { GBK CP936 MS936 windows-936 }
12052     { JIS_Encoding csJISEncoding }
12053     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12054     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12055       EUC-JP }
12056     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12057     { ISO-10646-UCS-Basic csUnicodeASCII }
12058     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12059     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12060     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12061     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12062     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12063     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12064     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12065     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12066     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12067     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12068     { Adobe-Standard-Encoding csAdobeStandardEncoding }
12069     { Ventura-US csVenturaUS }
12070     { Ventura-International csVenturaInternational }
12071     { PC8-Danish-Norwegian csPC8DanishNorwegian }
12072     { PC8-Turkish csPC8Turkish }
12073     { IBM-Symbols csIBMSymbols }
12074     { IBM-Thai csIBMThai }
12075     { HP-Legal csHPLegal }
12076     { HP-Pi-font csHPPiFont }
12077     { HP-Math8 csHPMath8 }
12078     { Adobe-Symbol-Encoding csHPPSMath }
12079     { HP-DeskTop csHPDesktop }
12080     { Ventura-Math csVenturaMath }
12081     { Microsoft-Publishing csMicrosoftPublishing }
12082     { Windows-31J csWindows31J }
12083     { GB2312 csGB2312 }
12084     { Big5 csBig5 }
12085 }
12086
12087 proc tcl_encoding {enc} {
12088     global encoding_aliases tcl_encoding_cache
12089     if {[info exists tcl_encoding_cache($enc)]} {
12090         return $tcl_encoding_cache($enc)
12091     }
12092     set names [encoding names]
12093     set lcnames [string tolower $names]
12094     set enc [string tolower $enc]
12095     set i [lsearch -exact $lcnames $enc]
12096     if {$i < 0} {
12097         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12098         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12099             set i [lsearch -exact $lcnames $encx]
12100         }
12101     }
12102     if {$i < 0} {
12103         foreach l $encoding_aliases {
12104             set ll [string tolower $l]
12105             if {[lsearch -exact $ll $enc] < 0} continue
12106             # look through the aliases for one that tcl knows about
12107             foreach e $ll {
12108                 set i [lsearch -exact $lcnames $e]
12109                 if {$i < 0} {
12110                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12111                         set i [lsearch -exact $lcnames $ex]
12112                     }
12113                 }
12114                 if {$i >= 0} break
12115             }
12116             break
12117         }
12118     }
12119     set tclenc {}
12120     if {$i >= 0} {
12121         set tclenc [lindex $names $i]
12122     }
12123     set tcl_encoding_cache($enc) $tclenc
12124     return $tclenc
12125 }
12126
12127 proc gitattr {path attr default} {
12128     global path_attr_cache
12129     if {[info exists path_attr_cache($attr,$path)]} {
12130         set r $path_attr_cache($attr,$path)
12131     } else {
12132         set r "unspecified"
12133         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12134             regexp "(.*): $attr: (.*)" $line m f r
12135         }
12136         set path_attr_cache($attr,$path) $r
12137     }
12138     if {$r eq "unspecified"} {
12139         return $default
12140     }
12141     return $r
12142 }
12143
12144 proc cache_gitattr {attr pathlist} {
12145     global path_attr_cache
12146     set newlist {}
12147     foreach path $pathlist {
12148         if {![info exists path_attr_cache($attr,$path)]} {
12149             lappend newlist $path
12150         }
12151     }
12152     set lim 1000
12153     if {[tk windowingsystem] == "win32"} {
12154         # windows has a 32k limit on the arguments to a command...
12155         set lim 30
12156     }
12157     while {$newlist ne {}} {
12158         set head [lrange $newlist 0 [expr {$lim - 1}]]
12159         set newlist [lrange $newlist $lim end]
12160         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12161             foreach row [split $rlist "\n"] {
12162                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12163                     if {[string index $path 0] eq "\""} {
12164                         set path [encoding convertfrom [lindex $path 0]]
12165                     }
12166                     set path_attr_cache($attr,$path) $value
12167                 }
12168             }
12169         }
12170     }
12171 }
12172
12173 proc get_path_encoding {path} {
12174     global gui_encoding perfile_attrs
12175     set tcl_enc $gui_encoding
12176     if {$path ne {} && $perfile_attrs} {
12177         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12178         if {$enc2 ne {}} {
12179             set tcl_enc $enc2
12180         }
12181     }
12182     return $tcl_enc
12183 }
12184
12185 ## For msgcat loading, first locate the installation location.
12186 if { [info exists ::env(GITK_MSGSDIR)] } {
12187     ## Msgsdir was manually set in the environment.
12188     set gitk_msgsdir $::env(GITK_MSGSDIR)
12189 } else {
12190     ## Let's guess the prefix from argv0.
12191     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12192     set gitk_libdir [file join $gitk_prefix share gitk lib]
12193     set gitk_msgsdir [file join $gitk_libdir msgs]
12194     unset gitk_prefix
12195 }
12196
12197 ## Internationalization (i18n) through msgcat and gettext. See
12198 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12199 package require msgcat
12200 namespace import ::msgcat::mc
12201 ## And eventually load the actual message catalog
12202 ::msgcat::mcload $gitk_msgsdir
12203
12204 # First check that Tcl/Tk is recent enough
12205 if {[catch {package require Tk 8.4} err]} {
12206     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12207                          Gitk requires at least Tcl/Tk 8.4."]
12208     exit 1
12209 }
12210
12211 # on OSX bring the current Wish process window to front
12212 if {[tk windowingsystem] eq "aqua"} {
12213     exec osascript -e [format {
12214         tell application "System Events"
12215             set frontmost of processes whose unix id is %d to true
12216         end tell
12217     } [pid] ]
12218 }
12219
12220 # Unset GIT_TRACE var if set
12221 if { [info exists ::env(GIT_TRACE)] } {
12222     unset ::env(GIT_TRACE)
12223 }
12224
12225 # defaults...
12226 set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12227
12228 set gitencoding {}
12229 catch {
12230     set gitencoding [exec git config --get i18n.commitencoding]
12231 }
12232 catch {
12233     set gitencoding [exec git config --get i18n.logoutputencoding]
12234 }
12235 if {$gitencoding == ""} {
12236     set gitencoding "utf-8"
12237 }
12238 set tclencoding [tcl_encoding $gitencoding]
12239 if {$tclencoding == {}} {
12240     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12241 }
12242
12243 set gui_encoding [encoding system]
12244 catch {
12245     set enc [exec git config --get gui.encoding]
12246     if {$enc ne {}} {
12247         set tclenc [tcl_encoding $enc]
12248         if {$tclenc ne {}} {
12249             set gui_encoding $tclenc
12250         } else {
12251             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12252         }
12253     }
12254 }
12255
12256 set log_showroot true
12257 catch {
12258     set log_showroot [exec git config --bool --get log.showroot]
12259 }
12260
12261 if {[tk windowingsystem] eq "aqua"} {
12262     set mainfont {{Lucida Grande} 9}
12263     set textfont {Monaco 9}
12264     set uifont {{Lucida Grande} 9 bold}
12265 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12266     # fontconfig!
12267     set mainfont {sans 9}
12268     set textfont {monospace 9}
12269     set uifont {sans 9 bold}
12270 } else {
12271     set mainfont {Helvetica 9}
12272     set textfont {Courier 9}
12273     set uifont {Helvetica 9 bold}
12274 }
12275 set tabstop 8
12276 set findmergefiles 0
12277 set maxgraphpct 50
12278 set maxwidth 16
12279 set revlistorder 0
12280 set fastdate 0
12281 set uparrowlen 5
12282 set downarrowlen 5
12283 set mingaplen 100
12284 set cmitmode "patch"
12285 set wrapcomment "none"
12286 set showneartags 1
12287 set hideremotes 0
12288 set maxrefs 20
12289 set visiblerefs {"master"}
12290 set maxlinelen 200
12291 set showlocalchanges 1
12292 set limitdiffs 1
12293 set datetimeformat "%Y-%m-%d %H:%M:%S"
12294 set autoselect 1
12295 set autosellen 40
12296 set perfile_attrs 0
12297 set want_ttk 1
12298
12299 if {[tk windowingsystem] eq "aqua"} {
12300     set extdifftool "opendiff"
12301 } else {
12302     set extdifftool "meld"
12303 }
12304
12305 set colors {"#00ff00" red blue magenta darkgrey brown orange}
12306 if {[tk windowingsystem] eq "win32"} {
12307     set uicolor SystemButtonFace
12308     set uifgcolor SystemButtonText
12309     set uifgdisabledcolor SystemDisabledText
12310     set bgcolor SystemWindow
12311     set fgcolor SystemWindowText
12312     set selectbgcolor SystemHighlight
12313 } else {
12314     set uicolor grey85
12315     set uifgcolor black
12316     set uifgdisabledcolor "#999"
12317     set bgcolor white
12318     set fgcolor black
12319     set selectbgcolor gray85
12320 }
12321 set diffcolors {red "#00a000" blue}
12322 set diffcontext 3
12323 set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12324 set ignorespace 0
12325 set worddiff ""
12326 set markbgcolor "#e0e0ff"
12327
12328 set headbgcolor "#00ff00"
12329 set headfgcolor black
12330 set headoutlinecolor black
12331 set remotebgcolor #ffddaa
12332 set tagbgcolor yellow
12333 set tagfgcolor black
12334 set tagoutlinecolor black
12335 set reflinecolor black
12336 set filesepbgcolor #aaaaaa
12337 set filesepfgcolor black
12338 set linehoverbgcolor #ffff80
12339 set linehoverfgcolor black
12340 set linehoveroutlinecolor black
12341 set mainheadcirclecolor yellow
12342 set workingfilescirclecolor red
12343 set indexcirclecolor "#00ff00"
12344 set circlecolors {white blue gray blue blue}
12345 set linkfgcolor blue
12346 set circleoutlinecolor $fgcolor
12347 set foundbgcolor yellow
12348 set currentsearchhitbgcolor orange
12349
12350 # button for popping up context menus
12351 if {[tk windowingsystem] eq "aqua"} {
12352     set ctxbut <Button-2>
12353 } else {
12354     set ctxbut <Button-3>
12355 }
12356
12357 catch {
12358     # follow the XDG base directory specification by default. See
12359     # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12360     if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12361         # XDG_CONFIG_HOME environment variable is set
12362         set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12363         set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12364     } else {
12365         # default XDG_CONFIG_HOME
12366         set config_file "~/.config/git/gitk"
12367         set config_file_tmp "~/.config/git/gitk-tmp"
12368     }
12369     if {![file exists $config_file]} {
12370         # for backward compatibility use the old config file if it exists
12371         if {[file exists "~/.gitk"]} {
12372             set config_file "~/.gitk"
12373             set config_file_tmp "~/.gitk-tmp"
12374         } elseif {![file exists [file dirname $config_file]]} {
12375             file mkdir [file dirname $config_file]
12376         }
12377     }
12378     source $config_file
12379 }
12380 config_check_tmp_exists 50
12381
12382 set config_variables {
12383     mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12384     cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12385     hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12386     bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12387     markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12388     extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12389     remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12390     filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12391     linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12392     indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12393 }
12394 foreach var $config_variables {
12395     config_init_trace $var
12396     trace add variable $var write config_variable_change_cb
12397 }
12398
12399 parsefont mainfont $mainfont
12400 eval font create mainfont [fontflags mainfont]
12401 eval font create mainfontbold [fontflags mainfont 1]
12402
12403 parsefont textfont $textfont
12404 eval font create textfont [fontflags textfont]
12405 eval font create textfontbold [fontflags textfont 1]
12406
12407 parsefont uifont $uifont
12408 eval font create uifont [fontflags uifont]
12409
12410 setui $uicolor
12411
12412 setoptions
12413
12414 # check that we can find a .git directory somewhere...
12415 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12416     show_error {} . [mc "Cannot find a git repository here."]
12417     exit 1
12418 }
12419
12420 set selecthead {}
12421 set selectheadid {}
12422
12423 set revtreeargs {}
12424 set cmdline_files {}
12425 set i 0
12426 set revtreeargscmd {}
12427 foreach arg $argv {
12428     switch -glob -- $arg {
12429         "" { }
12430         "--" {
12431             set cmdline_files [lrange $argv [expr {$i + 1}] end]
12432             break
12433         }
12434         "--select-commit=*" {
12435             set selecthead [string range $arg 16 end]
12436         }
12437         "--argscmd=*" {
12438             set revtreeargscmd [string range $arg 10 end]
12439         }
12440         default {
12441             lappend revtreeargs $arg
12442         }
12443     }
12444     incr i
12445 }
12446
12447 if {$selecthead eq "HEAD"} {
12448     set selecthead {}
12449 }
12450
12451 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12452     # no -- on command line, but some arguments (other than --argscmd)
12453     if {[catch {
12454         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12455         set cmdline_files [split $f "\n"]
12456         set n [llength $cmdline_files]
12457         set revtreeargs [lrange $revtreeargs 0 end-$n]
12458         # Unfortunately git rev-parse doesn't produce an error when
12459         # something is both a revision and a filename.  To be consistent
12460         # with git log and git rev-list, check revtreeargs for filenames.
12461         foreach arg $revtreeargs {
12462             if {[file exists $arg]} {
12463                 show_error {} . [mc "Ambiguous argument '%s': both revision\
12464                                  and filename" $arg]
12465                 exit 1
12466             }
12467         }
12468     } err]} {
12469         # unfortunately we get both stdout and stderr in $err,
12470         # so look for "fatal:".
12471         set i [string first "fatal:" $err]
12472         if {$i > 0} {
12473             set err [string range $err [expr {$i + 6}] end]
12474         }
12475         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12476         exit 1
12477     }
12478 }
12479
12480 set nullid "0000000000000000000000000000000000000000"
12481 set nullid2 "0000000000000000000000000000000000000001"
12482 set nullfile "/dev/null"
12483
12484 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12485 if {![info exists have_ttk]} {
12486     set have_ttk [llength [info commands ::ttk::style]]
12487 }
12488 set use_ttk [expr {$have_ttk && $want_ttk}]
12489 set NS [expr {$use_ttk ? "ttk" : ""}]
12490
12491 if {$use_ttk} {
12492     setttkstyle
12493 }
12494
12495 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12496
12497 set show_notes {}
12498 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12499     set show_notes "--show-notes"
12500 }
12501
12502 set appname "gitk"
12503
12504 set runq {}
12505 set history {}
12506 set historyindex 0
12507 set fh_serial 0
12508 set nhl_names {}
12509 set highlight_paths {}
12510 set findpattern {}
12511 set searchdirn -forwards
12512 set boldids {}
12513 set boldnameids {}
12514 set diffelide {0 0}
12515 set markingmatches 0
12516 set linkentercount 0
12517 set need_redisplay 0
12518 set nrows_drawn 0
12519 set firsttabstop 0
12520
12521 set nextviewnum 1
12522 set curview 0
12523 set selectedview 0
12524 set selectedhlview [mc "None"]
12525 set highlight_related [mc "None"]
12526 set highlight_files {}
12527 set viewfiles(0) {}
12528 set viewperm(0) 0
12529 set viewchanged(0) 0
12530 set viewargs(0) {}
12531 set viewargscmd(0) {}
12532
12533 set selectedline {}
12534 set numcommits 0
12535 set loginstance 0
12536 set cmdlineok 0
12537 set stopped 0
12538 set stuffsaved 0
12539 set patchnum 0
12540 set lserial 0
12541 set hasworktree [hasworktree]
12542 set cdup {}
12543 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12544     set cdup [exec git rev-parse --show-cdup]
12545 }
12546 set worktree [exec git rev-parse --show-toplevel]
12547 setcoords
12548 makewindow
12549 catch {
12550     image create photo gitlogo      -width 16 -height 16
12551
12552     image create photo gitlogominus -width  4 -height  2
12553     gitlogominus put #C00000 -to 0 0 4 2
12554     gitlogo copy gitlogominus -to  1 5
12555     gitlogo copy gitlogominus -to  6 5
12556     gitlogo copy gitlogominus -to 11 5
12557     image delete gitlogominus
12558
12559     image create photo gitlogoplus  -width  4 -height  4
12560     gitlogoplus  put #008000 -to 1 0 3 4
12561     gitlogoplus  put #008000 -to 0 1 4 3
12562     gitlogo copy gitlogoplus  -to  1 9
12563     gitlogo copy gitlogoplus  -to  6 9
12564     gitlogo copy gitlogoplus  -to 11 9
12565     image delete gitlogoplus
12566
12567     image create photo gitlogo32    -width 32 -height 32
12568     gitlogo32 copy gitlogo -zoom 2 2
12569
12570     wm iconphoto . -default gitlogo gitlogo32
12571 }
12572 # wait for the window to become visible
12573 tkwait visibility .
12574 set_window_title
12575 update
12576 readrefs
12577
12578 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12579     # create a view for the files/dirs specified on the command line
12580     set curview 1
12581     set selectedview 1
12582     set nextviewnum 2
12583     set viewname(1) [mc "Command line"]
12584     set viewfiles(1) $cmdline_files
12585     set viewargs(1) $revtreeargs
12586     set viewargscmd(1) $revtreeargscmd
12587     set viewperm(1) 0
12588     set viewchanged(1) 0
12589     set vdatemode(1) 0
12590     addviewmenu 1
12591     .bar.view entryconf [mca "&Edit view..."] -state normal
12592     .bar.view entryconf [mca "&Delete view"] -state normal
12593 }
12594
12595 if {[info exists permviews]} {
12596     foreach v $permviews {
12597         set n $nextviewnum
12598         incr nextviewnum
12599         set viewname($n) [lindex $v 0]
12600         set viewfiles($n) [lindex $v 1]
12601         set viewargs($n) [lindex $v 2]
12602         set viewargscmd($n) [lindex $v 3]
12603         set viewperm($n) 1
12604         set viewchanged($n) 0
12605         addviewmenu $n
12606     }
12607 }
12608
12609 if {[tk windowingsystem] eq "win32"} {
12610     focus -force .
12611 }
12612
12613 getcommits {}
12614
12615 # Local variables:
12616 # mode: tcl
12617 # indent-tabs-mode: t
12618 # tab-width: 8
12619 # End: