gitk: Add Chinese (zh_CN) translation
[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 # Also look for URLs of the form "http[s]://..." and make them web links.
7020 proc appendwithlinks {text tags} {
7021     global ctext linknum curview
7022
7023     set start [$ctext index "end - 1c"]
7024     $ctext insert end $text $tags
7025     set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7026     foreach l $links {
7027         set s [lindex $l 0]
7028         set e [lindex $l 1]
7029         set linkid [string range $text $s $e]
7030         incr e
7031         $ctext tag delete link$linknum
7032         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7033         setlink $linkid link$linknum
7034         incr linknum
7035     }
7036     set wlinks [regexp -indices -all -inline -line \
7037                     {https?://[^[:space:]]+} $text]
7038     foreach l $wlinks {
7039         set s2 [lindex $l 0]
7040         set e2 [lindex $l 1]
7041         set url [string range $text $s2 $e2]
7042         incr e2
7043         $ctext tag delete link$linknum
7044         $ctext tag add link$linknum "$start + $s2 c" "$start + $e2 c"
7045         setwlink $url link$linknum
7046         incr linknum
7047     }
7048 }
7049
7050 proc setlink {id lk} {
7051     global curview ctext pendinglinks
7052     global linkfgcolor
7053
7054     if {[string range $id 0 1] eq "-g"} {
7055       set id [string range $id 2 end]
7056     }
7057
7058     set known 0
7059     if {[string length $id] < 40} {
7060         set matches [longid $id]
7061         if {[llength $matches] > 0} {
7062             if {[llength $matches] > 1} return
7063             set known 1
7064             set id [lindex $matches 0]
7065         }
7066     } else {
7067         set known [commitinview $id $curview]
7068     }
7069     if {$known} {
7070         $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7071         $ctext tag bind $lk <1> [list selbyid $id]
7072         $ctext tag bind $lk <Enter> {linkcursor %W 1}
7073         $ctext tag bind $lk <Leave> {linkcursor %W -1}
7074     } else {
7075         lappend pendinglinks($id) $lk
7076         interestedin $id {makelink %P}
7077     }
7078 }
7079
7080 proc setwlink {url lk} {
7081     global ctext
7082     global linkfgcolor
7083     global web_browser
7084
7085     if {$web_browser eq {}} return
7086     $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7087     $ctext tag bind $lk <1> [list browseweb $url]
7088     $ctext tag bind $lk <Enter> {linkcursor %W 1}
7089     $ctext tag bind $lk <Leave> {linkcursor %W -1}
7090 }
7091
7092 proc appendshortlink {id {pre {}} {post {}}} {
7093     global ctext linknum
7094
7095     $ctext insert end $pre
7096     $ctext tag delete link$linknum
7097     $ctext insert end [string range $id 0 7] link$linknum
7098     $ctext insert end $post
7099     setlink $id link$linknum
7100     incr linknum
7101 }
7102
7103 proc makelink {id} {
7104     global pendinglinks
7105
7106     if {![info exists pendinglinks($id)]} return
7107     foreach lk $pendinglinks($id) {
7108         setlink $id $lk
7109     }
7110     unset pendinglinks($id)
7111 }
7112
7113 proc linkcursor {w inc} {
7114     global linkentercount curtextcursor
7115
7116     if {[incr linkentercount $inc] > 0} {
7117         $w configure -cursor hand2
7118     } else {
7119         $w configure -cursor $curtextcursor
7120         if {$linkentercount < 0} {
7121             set linkentercount 0
7122         }
7123     }
7124 }
7125
7126 proc browseweb {url} {
7127     global web_browser
7128
7129     if {$web_browser eq {}} return
7130     # Use eval here in case $web_browser is a command plus some arguments
7131     if {[catch {eval exec $web_browser [list $url] &} err]} {
7132         error_popup "[mc "Error starting web browser:"] $err"
7133     }
7134 }
7135
7136 proc viewnextline {dir} {
7137     global canv linespc
7138
7139     $canv delete hover
7140     set ymax [lindex [$canv cget -scrollregion] 3]
7141     set wnow [$canv yview]
7142     set wtop [expr {[lindex $wnow 0] * $ymax}]
7143     set newtop [expr {$wtop + $dir * $linespc}]
7144     if {$newtop < 0} {
7145         set newtop 0
7146     } elseif {$newtop > $ymax} {
7147         set newtop $ymax
7148     }
7149     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7150 }
7151
7152 # add a list of tag or branch names at position pos
7153 # returns the number of names inserted
7154 proc appendrefs {pos ids var} {
7155     global ctext linknum curview $var maxrefs visiblerefs mainheadid
7156
7157     if {[catch {$ctext index $pos}]} {
7158         return 0
7159     }
7160     $ctext conf -state normal
7161     $ctext delete $pos "$pos lineend"
7162     set tags {}
7163     foreach id $ids {
7164         foreach tag [set $var\($id\)] {
7165             lappend tags [list $tag $id]
7166         }
7167     }
7168
7169     set sep {}
7170     set tags [lsort -index 0 -decreasing $tags]
7171     set nutags 0
7172
7173     if {[llength $tags] > $maxrefs} {
7174         # If we are displaying heads, and there are too many,
7175         # see if there are some important heads to display.
7176         # Currently that are the current head and heads listed in $visiblerefs option
7177         set itags {}
7178         if {$var eq "idheads"} {
7179             set utags {}
7180             foreach ti $tags {
7181                 set hname [lindex $ti 0]
7182                 set id [lindex $ti 1]
7183                 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7184                     [llength $itags] < $maxrefs} {
7185                     lappend itags $ti
7186                 } else {
7187                     lappend utags $ti
7188                 }
7189             }
7190             set tags $utags
7191         }
7192         if {$itags ne {}} {
7193             set str [mc "and many more"]
7194             set sep " "
7195         } else {
7196             set str [mc "many"]
7197         }
7198         $ctext insert $pos "$str ([llength $tags])"
7199         set nutags [llength $tags]
7200         set tags $itags
7201     }
7202
7203     foreach ti $tags {
7204         set id [lindex $ti 1]
7205         set lk link$linknum
7206         incr linknum
7207         $ctext tag delete $lk
7208         $ctext insert $pos $sep
7209         $ctext insert $pos [lindex $ti 0] $lk
7210         setlink $id $lk
7211         set sep ", "
7212     }
7213     $ctext tag add wwrap "$pos linestart" "$pos lineend"
7214     $ctext conf -state disabled
7215     return [expr {[llength $tags] + $nutags}]
7216 }
7217
7218 # called when we have finished computing the nearby tags
7219 proc dispneartags {delay} {
7220     global selectedline currentid showneartags tagphase
7221
7222     if {$selectedline eq {} || !$showneartags} return
7223     after cancel dispnexttag
7224     if {$delay} {
7225         after 200 dispnexttag
7226         set tagphase -1
7227     } else {
7228         after idle dispnexttag
7229         set tagphase 0
7230     }
7231 }
7232
7233 proc dispnexttag {} {
7234     global selectedline currentid showneartags tagphase ctext
7235
7236     if {$selectedline eq {} || !$showneartags} return
7237     switch -- $tagphase {
7238         0 {
7239             set dtags [desctags $currentid]
7240             if {$dtags ne {}} {
7241                 appendrefs precedes $dtags idtags
7242             }
7243         }
7244         1 {
7245             set atags [anctags $currentid]
7246             if {$atags ne {}} {
7247                 appendrefs follows $atags idtags
7248             }
7249         }
7250         2 {
7251             set dheads [descheads $currentid]
7252             if {$dheads ne {}} {
7253                 if {[appendrefs branch $dheads idheads] > 1
7254                     && [$ctext get "branch -3c"] eq "h"} {
7255                     # turn "Branch" into "Branches"
7256                     $ctext conf -state normal
7257                     $ctext insert "branch -2c" "es"
7258                     $ctext conf -state disabled
7259                 }
7260             }
7261         }
7262     }
7263     if {[incr tagphase] <= 2} {
7264         after idle dispnexttag
7265     }
7266 }
7267
7268 proc make_secsel {id} {
7269     global linehtag linentag linedtag canv canv2 canv3
7270
7271     if {![info exists linehtag($id)]} return
7272     $canv delete secsel
7273     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7274                -tags secsel -fill [$canv cget -selectbackground]]
7275     $canv lower $t
7276     $canv2 delete secsel
7277     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7278                -tags secsel -fill [$canv2 cget -selectbackground]]
7279     $canv2 lower $t
7280     $canv3 delete secsel
7281     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7282                -tags secsel -fill [$canv3 cget -selectbackground]]
7283     $canv3 lower $t
7284 }
7285
7286 proc make_idmark {id} {
7287     global linehtag canv fgcolor
7288
7289     if {![info exists linehtag($id)]} return
7290     $canv delete markid
7291     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7292                -tags markid -outline $fgcolor]
7293     $canv raise $t
7294 }
7295
7296 proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7297     global canv ctext commitinfo selectedline
7298     global canvy0 linespc parents children curview
7299     global currentid sha1entry
7300     global commentend idtags linknum
7301     global mergemax numcommits pending_select
7302     global cmitmode showneartags allcommits
7303     global targetrow targetid lastscrollrows
7304     global autoselect autosellen jump_to_here
7305     global vinlinediff
7306
7307     unset -nocomplain pending_select
7308     $canv delete hover
7309     normalline
7310     unsel_reflist
7311     stopfinding
7312     if {$l < 0 || $l >= $numcommits} return
7313     set id [commitonrow $l]
7314     set targetid $id
7315     set targetrow $l
7316     set selectedline $l
7317     set currentid $id
7318     if {$lastscrollrows < $numcommits} {
7319         setcanvscroll
7320     }
7321
7322     if {$cmitmode ne "patch" && $switch_to_patch} {
7323         set cmitmode "patch"
7324     }
7325
7326     set y [expr {$canvy0 + $l * $linespc}]
7327     set ymax [lindex [$canv cget -scrollregion] 3]
7328     set ytop [expr {$y - $linespc - 1}]
7329     set ybot [expr {$y + $linespc + 1}]
7330     set wnow [$canv yview]
7331     set wtop [expr {[lindex $wnow 0] * $ymax}]
7332     set wbot [expr {[lindex $wnow 1] * $ymax}]
7333     set wh [expr {$wbot - $wtop}]
7334     set newtop $wtop
7335     if {$ytop < $wtop} {
7336         if {$ybot < $wtop} {
7337             set newtop [expr {$y - $wh / 2.0}]
7338         } else {
7339             set newtop $ytop
7340             if {$newtop > $wtop - $linespc} {
7341                 set newtop [expr {$wtop - $linespc}]
7342             }
7343         }
7344     } elseif {$ybot > $wbot} {
7345         if {$ytop > $wbot} {
7346             set newtop [expr {$y - $wh / 2.0}]
7347         } else {
7348             set newtop [expr {$ybot - $wh}]
7349             if {$newtop < $wtop + $linespc} {
7350                 set newtop [expr {$wtop + $linespc}]
7351             }
7352         }
7353     }
7354     if {$newtop != $wtop} {
7355         if {$newtop < 0} {
7356             set newtop 0
7357         }
7358         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7359         drawvisible
7360     }
7361
7362     make_secsel $id
7363
7364     if {$isnew} {
7365         addtohistory [list selbyid $id 0] savecmitpos
7366     }
7367
7368     $sha1entry delete 0 end
7369     $sha1entry insert 0 $id
7370     if {$autoselect} {
7371         $sha1entry selection range 0 $autosellen
7372     }
7373     rhighlight_sel $id
7374
7375     $ctext conf -state normal
7376     clear_ctext
7377     set linknum 0
7378     if {![info exists commitinfo($id)]} {
7379         getcommit $id
7380     }
7381     set info $commitinfo($id)
7382     set date [formatdate [lindex $info 2]]
7383     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7384     set date [formatdate [lindex $info 4]]
7385     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7386     if {[info exists idtags($id)]} {
7387         $ctext insert end [mc "Tags:"]
7388         foreach tag $idtags($id) {
7389             $ctext insert end " $tag"
7390         }
7391         $ctext insert end "\n"
7392     }
7393
7394     set headers {}
7395     set olds $parents($curview,$id)
7396     if {[llength $olds] > 1} {
7397         set np 0
7398         foreach p $olds {
7399             if {$np >= $mergemax} {
7400                 set tag mmax
7401             } else {
7402                 set tag m$np
7403             }
7404             $ctext insert end "[mc "Parent"]: " $tag
7405             appendwithlinks [commit_descriptor $p] {}
7406             incr np
7407         }
7408     } else {
7409         foreach p $olds {
7410             append headers "[mc "Parent"]: [commit_descriptor $p]"
7411         }
7412     }
7413
7414     foreach c $children($curview,$id) {
7415         append headers "[mc "Child"]:  [commit_descriptor $c]"
7416     }
7417
7418     # make anything that looks like a SHA1 ID be a clickable link
7419     appendwithlinks $headers {}
7420     if {$showneartags} {
7421         if {![info exists allcommits]} {
7422             getallcommits
7423         }
7424         $ctext insert end "[mc "Branch"]: "
7425         $ctext mark set branch "end -1c"
7426         $ctext mark gravity branch left
7427         $ctext insert end "\n[mc "Follows"]: "
7428         $ctext mark set follows "end -1c"
7429         $ctext mark gravity follows left
7430         $ctext insert end "\n[mc "Precedes"]: "
7431         $ctext mark set precedes "end -1c"
7432         $ctext mark gravity precedes left
7433         $ctext insert end "\n"
7434         dispneartags 1
7435     }
7436     $ctext insert end "\n"
7437     set comment [lindex $info 5]
7438     if {[string first "\r" $comment] >= 0} {
7439         set comment [string map {"\r" "\n    "} $comment]
7440     }
7441     appendwithlinks $comment {comment}
7442
7443     $ctext tag remove found 1.0 end
7444     $ctext conf -state disabled
7445     set commentend [$ctext index "end - 1c"]
7446
7447     set jump_to_here $desired_loc
7448     init_flist [mc "Comments"]
7449     if {$cmitmode eq "tree"} {
7450         gettree $id
7451     } elseif {$vinlinediff($curview) == 1} {
7452         showinlinediff $id
7453     } elseif {[llength $olds] <= 1} {
7454         startdiff $id
7455     } else {
7456         mergediff $id
7457     }
7458 }
7459
7460 proc selfirstline {} {
7461     unmarkmatches
7462     selectline 0 1
7463 }
7464
7465 proc sellastline {} {
7466     global numcommits
7467     unmarkmatches
7468     set l [expr {$numcommits - 1}]
7469     selectline $l 1
7470 }
7471
7472 proc selnextline {dir} {
7473     global selectedline
7474     focus .
7475     if {$selectedline eq {}} return
7476     set l [expr {$selectedline + $dir}]
7477     unmarkmatches
7478     selectline $l 1
7479 }
7480
7481 proc selnextpage {dir} {
7482     global canv linespc selectedline numcommits
7483
7484     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7485     if {$lpp < 1} {
7486         set lpp 1
7487     }
7488     allcanvs yview scroll [expr {$dir * $lpp}] units
7489     drawvisible
7490     if {$selectedline eq {}} return
7491     set l [expr {$selectedline + $dir * $lpp}]
7492     if {$l < 0} {
7493         set l 0
7494     } elseif {$l >= $numcommits} {
7495         set l [expr $numcommits - 1]
7496     }
7497     unmarkmatches
7498     selectline $l 1
7499 }
7500
7501 proc unselectline {} {
7502     global selectedline currentid
7503
7504     set selectedline {}
7505     unset -nocomplain currentid
7506     allcanvs delete secsel
7507     rhighlight_none
7508 }
7509
7510 proc reselectline {} {
7511     global selectedline
7512
7513     if {$selectedline ne {}} {
7514         selectline $selectedline 0
7515     }
7516 }
7517
7518 proc addtohistory {cmd {saveproc {}}} {
7519     global history historyindex curview
7520
7521     unset_posvars
7522     save_position
7523     set elt [list $curview $cmd $saveproc {}]
7524     if {$historyindex > 0
7525         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7526         return
7527     }
7528
7529     if {$historyindex < [llength $history]} {
7530         set history [lreplace $history $historyindex end $elt]
7531     } else {
7532         lappend history $elt
7533     }
7534     incr historyindex
7535     if {$historyindex > 1} {
7536         .tf.bar.leftbut conf -state normal
7537     } else {
7538         .tf.bar.leftbut conf -state disabled
7539     }
7540     .tf.bar.rightbut conf -state disabled
7541 }
7542
7543 # save the scrolling position of the diff display pane
7544 proc save_position {} {
7545     global historyindex history
7546
7547     if {$historyindex < 1} return
7548     set hi [expr {$historyindex - 1}]
7549     set fn [lindex $history $hi 2]
7550     if {$fn ne {}} {
7551         lset history $hi 3 [eval $fn]
7552     }
7553 }
7554
7555 proc unset_posvars {} {
7556     global last_posvars
7557
7558     if {[info exists last_posvars]} {
7559         foreach {var val} $last_posvars {
7560             global $var
7561             unset -nocomplain $var
7562         }
7563         unset last_posvars
7564     }
7565 }
7566
7567 proc godo {elt} {
7568     global curview last_posvars
7569
7570     set view [lindex $elt 0]
7571     set cmd [lindex $elt 1]
7572     set pv [lindex $elt 3]
7573     if {$curview != $view} {
7574         showview $view
7575     }
7576     unset_posvars
7577     foreach {var val} $pv {
7578         global $var
7579         set $var $val
7580     }
7581     set last_posvars $pv
7582     eval $cmd
7583 }
7584
7585 proc goback {} {
7586     global history historyindex
7587     focus .
7588
7589     if {$historyindex > 1} {
7590         save_position
7591         incr historyindex -1
7592         godo [lindex $history [expr {$historyindex - 1}]]
7593         .tf.bar.rightbut conf -state normal
7594     }
7595     if {$historyindex <= 1} {
7596         .tf.bar.leftbut conf -state disabled
7597     }
7598 }
7599
7600 proc goforw {} {
7601     global history historyindex
7602     focus .
7603
7604     if {$historyindex < [llength $history]} {
7605         save_position
7606         set cmd [lindex $history $historyindex]
7607         incr historyindex
7608         godo $cmd
7609         .tf.bar.leftbut conf -state normal
7610     }
7611     if {$historyindex >= [llength $history]} {
7612         .tf.bar.rightbut conf -state disabled
7613     }
7614 }
7615
7616 proc go_to_parent {i} {
7617     global parents curview targetid
7618     set ps $parents($curview,$targetid)
7619     if {[llength $ps] >= $i} {
7620         selbyid [lindex $ps [expr $i - 1]]
7621     }
7622 }
7623
7624 proc gettree {id} {
7625     global treefilelist treeidlist diffids diffmergeid treepending
7626     global nullid nullid2
7627
7628     set diffids $id
7629     unset -nocomplain diffmergeid
7630     if {![info exists treefilelist($id)]} {
7631         if {![info exists treepending]} {
7632             if {$id eq $nullid} {
7633                 set cmd [list | git ls-files]
7634             } elseif {$id eq $nullid2} {
7635                 set cmd [list | git ls-files --stage -t]
7636             } else {
7637                 set cmd [list | git ls-tree -r $id]
7638             }
7639             if {[catch {set gtf [open $cmd r]}]} {
7640                 return
7641             }
7642             set treepending $id
7643             set treefilelist($id) {}
7644             set treeidlist($id) {}
7645             fconfigure $gtf -blocking 0 -encoding binary
7646             filerun $gtf [list gettreeline $gtf $id]
7647         }
7648     } else {
7649         setfilelist $id
7650     }
7651 }
7652
7653 proc gettreeline {gtf id} {
7654     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7655
7656     set nl 0
7657     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7658         if {$diffids eq $nullid} {
7659             set fname $line
7660         } else {
7661             set i [string first "\t" $line]
7662             if {$i < 0} continue
7663             set fname [string range $line [expr {$i+1}] end]
7664             set line [string range $line 0 [expr {$i-1}]]
7665             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7666             set sha1 [lindex $line 2]
7667             lappend treeidlist($id) $sha1
7668         }
7669         if {[string index $fname 0] eq "\""} {
7670             set fname [lindex $fname 0]
7671         }
7672         set fname [encoding convertfrom $fname]
7673         lappend treefilelist($id) $fname
7674     }
7675     if {![eof $gtf]} {
7676         return [expr {$nl >= 1000? 2: 1}]
7677     }
7678     close $gtf
7679     unset treepending
7680     if {$cmitmode ne "tree"} {
7681         if {![info exists diffmergeid]} {
7682             gettreediffs $diffids
7683         }
7684     } elseif {$id ne $diffids} {
7685         gettree $diffids
7686     } else {
7687         setfilelist $id
7688     }
7689     return 0
7690 }
7691
7692 proc showfile {f} {
7693     global treefilelist treeidlist diffids nullid nullid2
7694     global ctext_file_names ctext_file_lines
7695     global ctext commentend
7696
7697     set i [lsearch -exact $treefilelist($diffids) $f]
7698     if {$i < 0} {
7699         puts "oops, $f not in list for id $diffids"
7700         return
7701     }
7702     if {$diffids eq $nullid} {
7703         if {[catch {set bf [open $f r]} err]} {
7704             puts "oops, can't read $f: $err"
7705             return
7706         }
7707     } else {
7708         set blob [lindex $treeidlist($diffids) $i]
7709         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7710             puts "oops, error reading blob $blob: $err"
7711             return
7712         }
7713     }
7714     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7715     filerun $bf [list getblobline $bf $diffids]
7716     $ctext config -state normal
7717     clear_ctext $commentend
7718     lappend ctext_file_names $f
7719     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7720     $ctext insert end "\n"
7721     $ctext insert end "$f\n" filesep
7722     $ctext config -state disabled
7723     $ctext yview $commentend
7724     settabs 0
7725 }
7726
7727 proc getblobline {bf id} {
7728     global diffids cmitmode ctext
7729
7730     if {$id ne $diffids || $cmitmode ne "tree"} {
7731         catch {close $bf}
7732         return 0
7733     }
7734     $ctext config -state normal
7735     set nl 0
7736     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7737         $ctext insert end "$line\n"
7738     }
7739     if {[eof $bf]} {
7740         global jump_to_here ctext_file_names commentend
7741
7742         # delete last newline
7743         $ctext delete "end - 2c" "end - 1c"
7744         close $bf
7745         if {$jump_to_here ne {} &&
7746             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7747             set lnum [expr {[lindex $jump_to_here 1] +
7748                             [lindex [split $commentend .] 0]}]
7749             mark_ctext_line $lnum
7750         }
7751         $ctext config -state disabled
7752         return 0
7753     }
7754     $ctext config -state disabled
7755     return [expr {$nl >= 1000? 2: 1}]
7756 }
7757
7758 proc mark_ctext_line {lnum} {
7759     global ctext markbgcolor
7760
7761     $ctext tag delete omark
7762     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7763     $ctext tag conf omark -background $markbgcolor
7764     $ctext see $lnum.0
7765 }
7766
7767 proc mergediff {id} {
7768     global diffmergeid
7769     global diffids treediffs
7770     global parents curview
7771
7772     set diffmergeid $id
7773     set diffids $id
7774     set treediffs($id) {}
7775     set np [llength $parents($curview,$id)]
7776     settabs $np
7777     getblobdiffs $id
7778 }
7779
7780 proc startdiff {ids} {
7781     global treediffs diffids treepending diffmergeid nullid nullid2
7782
7783     settabs 1
7784     set diffids $ids
7785     unset -nocomplain diffmergeid
7786     if {![info exists treediffs($ids)] ||
7787         [lsearch -exact $ids $nullid] >= 0 ||
7788         [lsearch -exact $ids $nullid2] >= 0} {
7789         if {![info exists treepending]} {
7790             gettreediffs $ids
7791         }
7792     } else {
7793         addtocflist $ids
7794     }
7795 }
7796
7797 proc showinlinediff {ids} {
7798     global commitinfo commitdata ctext
7799     global treediffs
7800
7801     set info $commitinfo($ids)
7802     set diff [lindex $info 7]
7803     set difflines [split $diff "\n"]
7804
7805     initblobdiffvars
7806     set treediff {}
7807
7808     set inhdr 0
7809     foreach line $difflines {
7810         if {![string compare -length 5 "diff " $line]} {
7811             set inhdr 1
7812         } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7813             # offset also accounts for the b/ prefix
7814             lappend treediff [string range $line 6 end]
7815             set inhdr 0
7816         }
7817     }
7818
7819     set treediffs($ids) $treediff
7820     add_flist $treediff
7821
7822     $ctext conf -state normal
7823     foreach line $difflines {
7824         parseblobdiffline $ids $line
7825     }
7826     maybe_scroll_ctext 1
7827     $ctext conf -state disabled
7828 }
7829
7830 # If the filename (name) is under any of the passed filter paths
7831 # then return true to include the file in the listing.
7832 proc path_filter {filter name} {
7833     set worktree [gitworktree]
7834     foreach p $filter {
7835         set fq_p [file normalize $p]
7836         set fq_n [file normalize [file join $worktree $name]]
7837         if {[string match [file normalize $fq_p]* $fq_n]} {
7838             return 1
7839         }
7840     }
7841     return 0
7842 }
7843
7844 proc addtocflist {ids} {
7845     global treediffs
7846
7847     add_flist $treediffs($ids)
7848     getblobdiffs $ids
7849 }
7850
7851 proc diffcmd {ids flags} {
7852     global log_showroot nullid nullid2 git_version
7853
7854     set i [lsearch -exact $ids $nullid]
7855     set j [lsearch -exact $ids $nullid2]
7856     if {$i >= 0} {
7857         if {[llength $ids] > 1 && $j < 0} {
7858             # comparing working directory with some specific revision
7859             set cmd [concat | git diff-index $flags]
7860             if {$i == 0} {
7861                 lappend cmd -R [lindex $ids 1]
7862             } else {
7863                 lappend cmd [lindex $ids 0]
7864             }
7865         } else {
7866             # comparing working directory with index
7867             set cmd [concat | git diff-files $flags]
7868             if {$j == 1} {
7869                 lappend cmd -R
7870             }
7871         }
7872     } elseif {$j >= 0} {
7873         if {[package vcompare $git_version "1.7.2"] >= 0} {
7874             set flags "$flags --ignore-submodules=dirty"
7875         }
7876         set cmd [concat | git diff-index --cached $flags]
7877         if {[llength $ids] > 1} {
7878             # comparing index with specific revision
7879             if {$j == 0} {
7880                 lappend cmd -R [lindex $ids 1]
7881             } else {
7882                 lappend cmd [lindex $ids 0]
7883             }
7884         } else {
7885             # comparing index with HEAD
7886             lappend cmd HEAD
7887         }
7888     } else {
7889         if {$log_showroot} {
7890             lappend flags --root
7891         }
7892         set cmd [concat | git diff-tree -r $flags $ids]
7893     }
7894     return $cmd
7895 }
7896
7897 proc gettreediffs {ids} {
7898     global treediff treepending limitdiffs vfilelimit curview
7899
7900     set cmd [diffcmd $ids {--no-commit-id}]
7901     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7902             set cmd [concat $cmd -- $vfilelimit($curview)]
7903     }
7904     if {[catch {set gdtf [open $cmd r]}]} return
7905
7906     set treepending $ids
7907     set treediff {}
7908     fconfigure $gdtf -blocking 0 -encoding binary
7909     filerun $gdtf [list gettreediffline $gdtf $ids]
7910 }
7911
7912 proc gettreediffline {gdtf ids} {
7913     global treediff treediffs treepending diffids diffmergeid
7914     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7915
7916     set nr 0
7917     set sublist {}
7918     set max 1000
7919     if {$perfile_attrs} {
7920         # cache_gitattr is slow, and even slower on win32 where we
7921         # have to invoke it for only about 30 paths at a time
7922         set max 500
7923         if {[tk windowingsystem] == "win32"} {
7924             set max 120
7925         }
7926     }
7927     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7928         set i [string first "\t" $line]
7929         if {$i >= 0} {
7930             set file [string range $line [expr {$i+1}] end]
7931             if {[string index $file 0] eq "\""} {
7932                 set file [lindex $file 0]
7933             }
7934             set file [encoding convertfrom $file]
7935             if {$file ne [lindex $treediff end]} {
7936                 lappend treediff $file
7937                 lappend sublist $file
7938             }
7939         }
7940     }
7941     if {$perfile_attrs} {
7942         cache_gitattr encoding $sublist
7943     }
7944     if {![eof $gdtf]} {
7945         return [expr {$nr >= $max? 2: 1}]
7946     }
7947     close $gdtf
7948     set treediffs($ids) $treediff
7949     unset treepending
7950     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7951         gettree $diffids
7952     } elseif {$ids != $diffids} {
7953         if {![info exists diffmergeid]} {
7954             gettreediffs $diffids
7955         }
7956     } else {
7957         addtocflist $ids
7958     }
7959     return 0
7960 }
7961
7962 # empty string or positive integer
7963 proc diffcontextvalidate {v} {
7964     return [regexp {^(|[1-9][0-9]*)$} $v]
7965 }
7966
7967 proc diffcontextchange {n1 n2 op} {
7968     global diffcontextstring diffcontext
7969
7970     if {[string is integer -strict $diffcontextstring]} {
7971         if {$diffcontextstring >= 0} {
7972             set diffcontext $diffcontextstring
7973             reselectline
7974         }
7975     }
7976 }
7977
7978 proc changeignorespace {} {
7979     reselectline
7980 }
7981
7982 proc changeworddiff {name ix op} {
7983     reselectline
7984 }
7985
7986 proc initblobdiffvars {} {
7987     global diffencoding targetline diffnparents
7988     global diffinhdr currdiffsubmod diffseehere
7989     set targetline {}
7990     set diffnparents 0
7991     set diffinhdr 0
7992     set diffencoding [get_path_encoding {}]
7993     set currdiffsubmod ""
7994     set diffseehere -1
7995 }
7996
7997 proc getblobdiffs {ids} {
7998     global blobdifffd diffids env
7999     global treediffs
8000     global diffcontext
8001     global ignorespace
8002     global worddiff
8003     global limitdiffs vfilelimit curview
8004     global git_version
8005
8006     set textconv {}
8007     if {[package vcompare $git_version "1.6.1"] >= 0} {
8008         set textconv "--textconv"
8009     }
8010     set submodule {}
8011     if {[package vcompare $git_version "1.6.6"] >= 0} {
8012         set submodule "--submodule"
8013     }
8014     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
8015     if {$ignorespace} {
8016         append cmd " -w"
8017     }
8018     if {$worddiff ne [mc "Line diff"]} {
8019         append cmd " --word-diff=porcelain"
8020     }
8021     if {$limitdiffs && $vfilelimit($curview) ne {}} {
8022         set cmd [concat $cmd -- $vfilelimit($curview)]
8023     }
8024     if {[catch {set bdf [open $cmd r]} err]} {
8025         error_popup [mc "Error getting diffs: %s" $err]
8026         return
8027     }
8028     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
8029     set blobdifffd($ids) $bdf
8030     initblobdiffvars
8031     filerun $bdf [list getblobdiffline $bdf $diffids]
8032 }
8033
8034 proc savecmitpos {} {
8035     global ctext cmitmode
8036
8037     if {$cmitmode eq "tree"} {
8038         return {}
8039     }
8040     return [list target_scrollpos [$ctext index @0,0]]
8041 }
8042
8043 proc savectextpos {} {
8044     global ctext
8045
8046     return [list target_scrollpos [$ctext index @0,0]]
8047 }
8048
8049 proc maybe_scroll_ctext {ateof} {
8050     global ctext target_scrollpos
8051
8052     if {![info exists target_scrollpos]} return
8053     if {!$ateof} {
8054         set nlines [expr {[winfo height $ctext]
8055                           / [font metrics textfont -linespace]}]
8056         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8057     }
8058     $ctext yview $target_scrollpos
8059     unset target_scrollpos
8060 }
8061
8062 proc setinlist {var i val} {
8063     global $var
8064
8065     while {[llength [set $var]] < $i} {
8066         lappend $var {}
8067     }
8068     if {[llength [set $var]] == $i} {
8069         lappend $var $val
8070     } else {
8071         lset $var $i $val
8072     }
8073 }
8074
8075 proc makediffhdr {fname ids} {
8076     global ctext curdiffstart treediffs diffencoding
8077     global ctext_file_names jump_to_here targetline diffline
8078
8079     set fname [encoding convertfrom $fname]
8080     set diffencoding [get_path_encoding $fname]
8081     set i [lsearch -exact $treediffs($ids) $fname]
8082     if {$i >= 0} {
8083         setinlist difffilestart $i $curdiffstart
8084     }
8085     lset ctext_file_names end $fname
8086     set l [expr {(78 - [string length $fname]) / 2}]
8087     set pad [string range "----------------------------------------" 1 $l]
8088     $ctext insert $curdiffstart "$pad $fname $pad" filesep
8089     set targetline {}
8090     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8091         set targetline [lindex $jump_to_here 1]
8092     }
8093     set diffline 0
8094 }
8095
8096 proc blobdiffmaybeseehere {ateof} {
8097     global diffseehere
8098     if {$diffseehere >= 0} {
8099         mark_ctext_line [lindex [split $diffseehere .] 0]
8100     }
8101     maybe_scroll_ctext $ateof
8102 }
8103
8104 proc getblobdiffline {bdf ids} {
8105     global diffids blobdifffd
8106     global ctext
8107
8108     set nr 0
8109     $ctext conf -state normal
8110     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8111         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8112             # Older diff read. Abort it.
8113             catch {close $bdf}
8114             if {$ids != $diffids} {
8115                 array unset blobdifffd $ids
8116             }
8117             return 0
8118         }
8119         parseblobdiffline $ids $line
8120     }
8121     $ctext conf -state disabled
8122     blobdiffmaybeseehere [eof $bdf]
8123     if {[eof $bdf]} {
8124         catch {close $bdf}
8125         array unset blobdifffd $ids
8126         return 0
8127     }
8128     return [expr {$nr >= 1000? 2: 1}]
8129 }
8130
8131 proc parseblobdiffline {ids line} {
8132     global ctext curdiffstart
8133     global diffnexthead diffnextnote difffilestart
8134     global ctext_file_names ctext_file_lines
8135     global diffinhdr treediffs mergemax diffnparents
8136     global diffencoding jump_to_here targetline diffline currdiffsubmod
8137     global worddiff diffseehere
8138
8139     if {![string compare -length 5 "diff " $line]} {
8140         if {![regexp {^diff (--cc|--git) } $line m type]} {
8141             set line [encoding convertfrom $line]
8142             $ctext insert end "$line\n" hunksep
8143             continue
8144         }
8145         # start of a new file
8146         set diffinhdr 1
8147         $ctext insert end "\n"
8148         set curdiffstart [$ctext index "end - 1c"]
8149         lappend ctext_file_names ""
8150         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8151         $ctext insert end "\n" filesep
8152
8153         if {$type eq "--cc"} {
8154             # start of a new file in a merge diff
8155             set fname [string range $line 10 end]
8156             if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8157                 lappend treediffs($ids) $fname
8158                 add_flist [list $fname]
8159             }
8160
8161         } else {
8162             set line [string range $line 11 end]
8163             # If the name hasn't changed the length will be odd,
8164             # the middle char will be a space, and the two bits either
8165             # side will be a/name and b/name, or "a/name" and "b/name".
8166             # If the name has changed we'll get "rename from" and
8167             # "rename to" or "copy from" and "copy to" lines following
8168             # this, and we'll use them to get the filenames.
8169             # This complexity is necessary because spaces in the
8170             # filename(s) don't get escaped.
8171             set l [string length $line]
8172             set i [expr {$l / 2}]
8173             if {!(($l & 1) && [string index $line $i] eq " " &&
8174                   [string range $line 2 [expr {$i - 1}]] eq \
8175                       [string range $line [expr {$i + 3}] end])} {
8176                 return
8177             }
8178             # unescape if quoted and chop off the a/ from the front
8179             if {[string index $line 0] eq "\""} {
8180                 set fname [string range [lindex $line 0] 2 end]
8181             } else {
8182                 set fname [string range $line 2 [expr {$i - 1}]]
8183             }
8184         }
8185         makediffhdr $fname $ids
8186
8187     } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8188         set fname [encoding convertfrom [string range $line 16 end]]
8189         $ctext insert end "\n"
8190         set curdiffstart [$ctext index "end - 1c"]
8191         lappend ctext_file_names $fname
8192         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8193         $ctext insert end "$line\n" filesep
8194         set i [lsearch -exact $treediffs($ids) $fname]
8195         if {$i >= 0} {
8196             setinlist difffilestart $i $curdiffstart
8197         }
8198
8199     } elseif {![string compare -length 2 "@@" $line]} {
8200         regexp {^@@+} $line ats
8201         set line [encoding convertfrom $diffencoding $line]
8202         $ctext insert end "$line\n" hunksep
8203         if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8204             set diffline $nl
8205         }
8206         set diffnparents [expr {[string length $ats] - 1}]
8207         set diffinhdr 0
8208
8209     } elseif {![string compare -length 10 "Submodule " $line]} {
8210         # start of a new submodule
8211         if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8212             set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8213         } else {
8214             set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8215         }
8216         if {$currdiffsubmod != $fname} {
8217             $ctext insert end "\n";     # Add newline after commit message
8218         }
8219         set curdiffstart [$ctext index "end - 1c"]
8220         lappend ctext_file_names ""
8221         if {$currdiffsubmod != $fname} {
8222             lappend ctext_file_lines $fname
8223             makediffhdr $fname $ids
8224             set currdiffsubmod $fname
8225             $ctext insert end "\n$line\n" filesep
8226         } else {
8227             $ctext insert end "$line\n" filesep
8228         }
8229     } elseif {![string compare -length 3 "  >" $line]} {
8230         set $currdiffsubmod ""
8231         set line [encoding convertfrom $diffencoding $line]
8232         $ctext insert end "$line\n" dresult
8233     } elseif {![string compare -length 3 "  <" $line]} {
8234         set $currdiffsubmod ""
8235         set line [encoding convertfrom $diffencoding $line]
8236         $ctext insert end "$line\n" d0
8237     } elseif {$diffinhdr} {
8238         if {![string compare -length 12 "rename from " $line]} {
8239             set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8240             if {[string index $fname 0] eq "\""} {
8241                 set fname [lindex $fname 0]
8242             }
8243             set fname [encoding convertfrom $fname]
8244             set i [lsearch -exact $treediffs($ids) $fname]
8245             if {$i >= 0} {
8246                 setinlist difffilestart $i $curdiffstart
8247             }
8248         } elseif {![string compare -length 10 $line "rename to "] ||
8249                   ![string compare -length 8 $line "copy to "]} {
8250             set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8251             if {[string index $fname 0] eq "\""} {
8252                 set fname [lindex $fname 0]
8253             }
8254             makediffhdr $fname $ids
8255         } elseif {[string compare -length 3 $line "---"] == 0} {
8256             # do nothing
8257             return
8258         } elseif {[string compare -length 3 $line "+++"] == 0} {
8259             set diffinhdr 0
8260             return
8261         }
8262         $ctext insert end "$line\n" filesep
8263
8264     } else {
8265         set line [string map {\x1A ^Z} \
8266                       [encoding convertfrom $diffencoding $line]]
8267         # parse the prefix - one ' ', '-' or '+' for each parent
8268         set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8269         set tag [expr {$diffnparents > 1? "m": "d"}]
8270         set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8271         set words_pre_markup ""
8272         set words_post_markup ""
8273         if {[string trim $prefix " -+"] eq {}} {
8274             # prefix only has " ", "-" and "+" in it: normal diff line
8275             set num [string first "-" $prefix]
8276             if {$dowords} {
8277                 set line [string range $line 1 end]
8278             }
8279             if {$num >= 0} {
8280                 # removed line, first parent with line is $num
8281                 if {$num >= $mergemax} {
8282                     set num "max"
8283                 }
8284                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8285                     $ctext insert end "\[-$line-\]" $tag$num
8286                 } else {
8287                     $ctext insert end "$line" $tag$num
8288                 }
8289                 if {!$dowords} {
8290                     $ctext insert end "\n" $tag$num
8291                 }
8292             } else {
8293                 set tags {}
8294                 if {[string first "+" $prefix] >= 0} {
8295                     # added line
8296                     lappend tags ${tag}result
8297                     if {$diffnparents > 1} {
8298                         set num [string first " " $prefix]
8299                         if {$num >= 0} {
8300                             if {$num >= $mergemax} {
8301                                 set num "max"
8302                             }
8303                             lappend tags m$num
8304                         }
8305                     }
8306                     set words_pre_markup "{+"
8307                     set words_post_markup "+}"
8308                 }
8309                 if {$targetline ne {}} {
8310                     if {$diffline == $targetline} {
8311                         set diffseehere [$ctext index "end - 1 chars"]
8312                         set targetline {}
8313                     } else {
8314                         incr diffline
8315                     }
8316                 }
8317                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8318                     $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8319                 } else {
8320                     $ctext insert end "$line" $tags
8321                 }
8322                 if {!$dowords} {
8323                     $ctext insert end "\n" $tags
8324                 }
8325             }
8326         } elseif {$dowords && $prefix eq "~"} {
8327             $ctext insert end "\n" {}
8328         } else {
8329             # "\ No newline at end of file",
8330             # or something else we don't recognize
8331             $ctext insert end "$line\n" hunksep
8332         }
8333     }
8334 }
8335
8336 proc changediffdisp {} {
8337     global ctext diffelide
8338
8339     $ctext tag conf d0 -elide [lindex $diffelide 0]
8340     $ctext tag conf dresult -elide [lindex $diffelide 1]
8341 }
8342
8343 proc highlightfile {cline} {
8344     global cflist cflist_top
8345
8346     if {![info exists cflist_top]} return
8347
8348     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8349     $cflist tag add highlight $cline.0 "$cline.0 lineend"
8350     $cflist see $cline.0
8351     set cflist_top $cline
8352 }
8353
8354 proc highlightfile_for_scrollpos {topidx} {
8355     global cmitmode difffilestart
8356
8357     if {$cmitmode eq "tree"} return
8358     if {![info exists difffilestart]} return
8359
8360     set top [lindex [split $topidx .] 0]
8361     if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8362         highlightfile 0
8363     } else {
8364         highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8365     }
8366 }
8367
8368 proc prevfile {} {
8369     global difffilestart ctext cmitmode
8370
8371     if {$cmitmode eq "tree"} return
8372     set prev 0.0
8373     set here [$ctext index @0,0]
8374     foreach loc $difffilestart {
8375         if {[$ctext compare $loc >= $here]} {
8376             $ctext yview $prev
8377             return
8378         }
8379         set prev $loc
8380     }
8381     $ctext yview $prev
8382 }
8383
8384 proc nextfile {} {
8385     global difffilestart ctext cmitmode
8386
8387     if {$cmitmode eq "tree"} return
8388     set here [$ctext index @0,0]
8389     foreach loc $difffilestart {
8390         if {[$ctext compare $loc > $here]} {
8391             $ctext yview $loc
8392             return
8393         }
8394     }
8395 }
8396
8397 proc clear_ctext {{first 1.0}} {
8398     global ctext smarktop smarkbot
8399     global ctext_file_names ctext_file_lines
8400     global pendinglinks
8401
8402     set l [lindex [split $first .] 0]
8403     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8404         set smarktop $l
8405     }
8406     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8407         set smarkbot $l
8408     }
8409     $ctext delete $first end
8410     if {$first eq "1.0"} {
8411         unset -nocomplain pendinglinks
8412     }
8413     set ctext_file_names {}
8414     set ctext_file_lines {}
8415 }
8416
8417 proc settabs {{firstab {}}} {
8418     global firsttabstop tabstop ctext have_tk85
8419
8420     if {$firstab ne {} && $have_tk85} {
8421         set firsttabstop $firstab
8422     }
8423     set w [font measure textfont "0"]
8424     if {$firsttabstop != 0} {
8425         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8426                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8427     } elseif {$have_tk85 || $tabstop != 8} {
8428         $ctext conf -tabs [expr {$tabstop * $w}]
8429     } else {
8430         $ctext conf -tabs {}
8431     }
8432 }
8433
8434 proc incrsearch {name ix op} {
8435     global ctext searchstring searchdirn
8436
8437     if {[catch {$ctext index anchor}]} {
8438         # no anchor set, use start of selection, or of visible area
8439         set sel [$ctext tag ranges sel]
8440         if {$sel ne {}} {
8441             $ctext mark set anchor [lindex $sel 0]
8442         } elseif {$searchdirn eq "-forwards"} {
8443             $ctext mark set anchor @0,0
8444         } else {
8445             $ctext mark set anchor @0,[winfo height $ctext]
8446         }
8447     }
8448     if {$searchstring ne {}} {
8449         set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8450         if {$here ne {}} {
8451             $ctext see $here
8452             set mend "$here + $mlen c"
8453             $ctext tag remove sel 1.0 end
8454             $ctext tag add sel $here $mend
8455             suppress_highlighting_file_for_current_scrollpos
8456             highlightfile_for_scrollpos $here
8457         }
8458     }
8459     rehighlight_search_results
8460 }
8461
8462 proc dosearch {} {
8463     global sstring ctext searchstring searchdirn
8464
8465     focus $sstring
8466     $sstring icursor end
8467     set searchdirn -forwards
8468     if {$searchstring ne {}} {
8469         set sel [$ctext tag ranges sel]
8470         if {$sel ne {}} {
8471             set start "[lindex $sel 0] + 1c"
8472         } elseif {[catch {set start [$ctext index anchor]}]} {
8473             set start "@0,0"
8474         }
8475         set match [$ctext search -count mlen -- $searchstring $start]
8476         $ctext tag remove sel 1.0 end
8477         if {$match eq {}} {
8478             bell
8479             return
8480         }
8481         $ctext see $match
8482         suppress_highlighting_file_for_current_scrollpos
8483         highlightfile_for_scrollpos $match
8484         set mend "$match + $mlen c"
8485         $ctext tag add sel $match $mend
8486         $ctext mark unset anchor
8487         rehighlight_search_results
8488     }
8489 }
8490
8491 proc dosearchback {} {
8492     global sstring ctext searchstring searchdirn
8493
8494     focus $sstring
8495     $sstring icursor end
8496     set searchdirn -backwards
8497     if {$searchstring ne {}} {
8498         set sel [$ctext tag ranges sel]
8499         if {$sel ne {}} {
8500             set start [lindex $sel 0]
8501         } elseif {[catch {set start [$ctext index anchor]}]} {
8502             set start @0,[winfo height $ctext]
8503         }
8504         set match [$ctext search -backwards -count ml -- $searchstring $start]
8505         $ctext tag remove sel 1.0 end
8506         if {$match eq {}} {
8507             bell
8508             return
8509         }
8510         $ctext see $match
8511         suppress_highlighting_file_for_current_scrollpos
8512         highlightfile_for_scrollpos $match
8513         set mend "$match + $ml c"
8514         $ctext tag add sel $match $mend
8515         $ctext mark unset anchor
8516         rehighlight_search_results
8517     }
8518 }
8519
8520 proc rehighlight_search_results {} {
8521     global ctext searchstring
8522
8523     $ctext tag remove found 1.0 end
8524     $ctext tag remove currentsearchhit 1.0 end
8525
8526     if {$searchstring ne {}} {
8527         searchmarkvisible 1
8528     }
8529 }
8530
8531 proc searchmark {first last} {
8532     global ctext searchstring
8533
8534     set sel [$ctext tag ranges sel]
8535
8536     set mend $first.0
8537     while {1} {
8538         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8539         if {$match eq {}} break
8540         set mend "$match + $mlen c"
8541         if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8542             $ctext tag add currentsearchhit $match $mend
8543         } else {
8544             $ctext tag add found $match $mend
8545         }
8546     }
8547 }
8548
8549 proc searchmarkvisible {doall} {
8550     global ctext smarktop smarkbot
8551
8552     set topline [lindex [split [$ctext index @0,0] .] 0]
8553     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8554     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8555         # no overlap with previous
8556         searchmark $topline $botline
8557         set smarktop $topline
8558         set smarkbot $botline
8559     } else {
8560         if {$topline < $smarktop} {
8561             searchmark $topline [expr {$smarktop-1}]
8562             set smarktop $topline
8563         }
8564         if {$botline > $smarkbot} {
8565             searchmark [expr {$smarkbot+1}] $botline
8566             set smarkbot $botline
8567         }
8568     }
8569 }
8570
8571 proc suppress_highlighting_file_for_current_scrollpos {} {
8572     global ctext suppress_highlighting_file_for_this_scrollpos
8573
8574     set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8575 }
8576
8577 proc scrolltext {f0 f1} {
8578     global searchstring cmitmode ctext
8579     global suppress_highlighting_file_for_this_scrollpos
8580
8581     set topidx [$ctext index @0,0]
8582     if {![info exists suppress_highlighting_file_for_this_scrollpos]
8583         || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8584         highlightfile_for_scrollpos $topidx
8585     }
8586
8587     unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8588
8589     .bleft.bottom.sb set $f0 $f1
8590     if {$searchstring ne {}} {
8591         searchmarkvisible 0
8592     }
8593 }
8594
8595 proc setcoords {} {
8596     global linespc charspc canvx0 canvy0
8597     global xspc1 xspc2 lthickness
8598
8599     set linespc [font metrics mainfont -linespace]
8600     set charspc [font measure mainfont "m"]
8601     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8602     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8603     set lthickness [expr {int($linespc / 9) + 1}]
8604     set xspc1(0) $linespc
8605     set xspc2 $linespc
8606 }
8607
8608 proc redisplay {} {
8609     global canv
8610     global selectedline
8611
8612     set ymax [lindex [$canv cget -scrollregion] 3]
8613     if {$ymax eq {} || $ymax == 0} return
8614     set span [$canv yview]
8615     clear_display
8616     setcanvscroll
8617     allcanvs yview moveto [lindex $span 0]
8618     drawvisible
8619     if {$selectedline ne {}} {
8620         selectline $selectedline 0
8621         allcanvs yview moveto [lindex $span 0]
8622     }
8623 }
8624
8625 proc parsefont {f n} {
8626     global fontattr
8627
8628     set fontattr($f,family) [lindex $n 0]
8629     set s [lindex $n 1]
8630     if {$s eq {} || $s == 0} {
8631         set s 10
8632     } elseif {$s < 0} {
8633         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8634     }
8635     set fontattr($f,size) $s
8636     set fontattr($f,weight) normal
8637     set fontattr($f,slant) roman
8638     foreach style [lrange $n 2 end] {
8639         switch -- $style {
8640             "normal" -
8641             "bold"   {set fontattr($f,weight) $style}
8642             "roman" -
8643             "italic" {set fontattr($f,slant) $style}
8644         }
8645     }
8646 }
8647
8648 proc fontflags {f {isbold 0}} {
8649     global fontattr
8650
8651     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8652                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8653                 -slant $fontattr($f,slant)]
8654 }
8655
8656 proc fontname {f} {
8657     global fontattr
8658
8659     set n [list $fontattr($f,family) $fontattr($f,size)]
8660     if {$fontattr($f,weight) eq "bold"} {
8661         lappend n "bold"
8662     }
8663     if {$fontattr($f,slant) eq "italic"} {
8664         lappend n "italic"
8665     }
8666     return $n
8667 }
8668
8669 proc incrfont {inc} {
8670     global mainfont textfont ctext canv cflist showrefstop
8671     global stopped entries fontattr
8672
8673     unmarkmatches
8674     set s $fontattr(mainfont,size)
8675     incr s $inc
8676     if {$s < 1} {
8677         set s 1
8678     }
8679     set fontattr(mainfont,size) $s
8680     font config mainfont -size $s
8681     font config mainfontbold -size $s
8682     set mainfont [fontname mainfont]
8683     set s $fontattr(textfont,size)
8684     incr s $inc
8685     if {$s < 1} {
8686         set s 1
8687     }
8688     set fontattr(textfont,size) $s
8689     font config textfont -size $s
8690     font config textfontbold -size $s
8691     set textfont [fontname textfont]
8692     setcoords
8693     settabs
8694     redisplay
8695 }
8696
8697 proc clearsha1 {} {
8698     global sha1entry sha1string
8699     if {[string length $sha1string] == 40} {
8700         $sha1entry delete 0 end
8701     }
8702 }
8703
8704 proc sha1change {n1 n2 op} {
8705     global sha1string currentid sha1but
8706     if {$sha1string == {}
8707         || ([info exists currentid] && $sha1string == $currentid)} {
8708         set state disabled
8709     } else {
8710         set state normal
8711     }
8712     if {[$sha1but cget -state] == $state} return
8713     if {$state == "normal"} {
8714         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8715     } else {
8716         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8717     }
8718 }
8719
8720 proc gotocommit {} {
8721     global sha1string tagids headids curview varcid
8722
8723     if {$sha1string == {}
8724         || ([info exists currentid] && $sha1string == $currentid)} return
8725     if {[info exists tagids($sha1string)]} {
8726         set id $tagids($sha1string)
8727     } elseif {[info exists headids($sha1string)]} {
8728         set id $headids($sha1string)
8729     } else {
8730         set id [string tolower $sha1string]
8731         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8732             set matches [longid $id]
8733             if {$matches ne {}} {
8734                 if {[llength $matches] > 1} {
8735                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8736                     return
8737                 }
8738                 set id [lindex $matches 0]
8739             }
8740         } else {
8741             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8742                 error_popup [mc "Revision %s is not known" $sha1string]
8743                 return
8744             }
8745         }
8746     }
8747     if {[commitinview $id $curview]} {
8748         selectline [rowofcommit $id] 1
8749         return
8750     }
8751     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8752         set msg [mc "SHA1 id %s is not known" $sha1string]
8753     } else {
8754         set msg [mc "Revision %s is not in the current view" $sha1string]
8755     }
8756     error_popup $msg
8757 }
8758
8759 proc lineenter {x y id} {
8760     global hoverx hovery hoverid hovertimer
8761     global commitinfo canv
8762
8763     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8764     set hoverx $x
8765     set hovery $y
8766     set hoverid $id
8767     if {[info exists hovertimer]} {
8768         after cancel $hovertimer
8769     }
8770     set hovertimer [after 500 linehover]
8771     $canv delete hover
8772 }
8773
8774 proc linemotion {x y id} {
8775     global hoverx hovery hoverid hovertimer
8776
8777     if {[info exists hoverid] && $id == $hoverid} {
8778         set hoverx $x
8779         set hovery $y
8780         if {[info exists hovertimer]} {
8781             after cancel $hovertimer
8782         }
8783         set hovertimer [after 500 linehover]
8784     }
8785 }
8786
8787 proc lineleave {id} {
8788     global hoverid hovertimer canv
8789
8790     if {[info exists hoverid] && $id == $hoverid} {
8791         $canv delete hover
8792         if {[info exists hovertimer]} {
8793             after cancel $hovertimer
8794             unset hovertimer
8795         }
8796         unset hoverid
8797     }
8798 }
8799
8800 proc linehover {} {
8801     global hoverx hovery hoverid hovertimer
8802     global canv linespc lthickness
8803     global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8804
8805     global commitinfo
8806
8807     set text [lindex $commitinfo($hoverid) 0]
8808     set ymax [lindex [$canv cget -scrollregion] 3]
8809     if {$ymax == {}} return
8810     set yfrac [lindex [$canv yview] 0]
8811     set x [expr {$hoverx + 2 * $linespc}]
8812     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8813     set x0 [expr {$x - 2 * $lthickness}]
8814     set y0 [expr {$y - 2 * $lthickness}]
8815     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8816     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8817     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8818                -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8819                -width 1 -tags hover]
8820     $canv raise $t
8821     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8822                -font mainfont -fill $linehoverfgcolor]
8823     $canv raise $t
8824 }
8825
8826 proc clickisonarrow {id y} {
8827     global lthickness
8828
8829     set ranges [rowranges $id]
8830     set thresh [expr {2 * $lthickness + 6}]
8831     set n [expr {[llength $ranges] - 1}]
8832     for {set i 1} {$i < $n} {incr i} {
8833         set row [lindex $ranges $i]
8834         if {abs([yc $row] - $y) < $thresh} {
8835             return $i
8836         }
8837     }
8838     return {}
8839 }
8840
8841 proc arrowjump {id n y} {
8842     global canv
8843
8844     # 1 <-> 2, 3 <-> 4, etc...
8845     set n [expr {(($n - 1) ^ 1) + 1}]
8846     set row [lindex [rowranges $id] $n]
8847     set yt [yc $row]
8848     set ymax [lindex [$canv cget -scrollregion] 3]
8849     if {$ymax eq {} || $ymax <= 0} return
8850     set view [$canv yview]
8851     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8852     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8853     if {$yfrac < 0} {
8854         set yfrac 0
8855     }
8856     allcanvs yview moveto $yfrac
8857 }
8858
8859 proc lineclick {x y id isnew} {
8860     global ctext commitinfo children canv thickerline curview
8861
8862     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8863     unmarkmatches
8864     unselectline
8865     normalline
8866     $canv delete hover
8867     # draw this line thicker than normal
8868     set thickerline $id
8869     drawlines $id
8870     if {$isnew} {
8871         set ymax [lindex [$canv cget -scrollregion] 3]
8872         if {$ymax eq {}} return
8873         set yfrac [lindex [$canv yview] 0]
8874         set y [expr {$y + $yfrac * $ymax}]
8875     }
8876     set dirn [clickisonarrow $id $y]
8877     if {$dirn ne {}} {
8878         arrowjump $id $dirn $y
8879         return
8880     }
8881
8882     if {$isnew} {
8883         addtohistory [list lineclick $x $y $id 0] savectextpos
8884     }
8885     # fill the details pane with info about this line
8886     $ctext conf -state normal
8887     clear_ctext
8888     settabs 0
8889     $ctext insert end "[mc "Parent"]:\t"
8890     $ctext insert end $id link0
8891     setlink $id link0
8892     set info $commitinfo($id)
8893     $ctext insert end "\n\t[lindex $info 0]\n"
8894     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8895     set date [formatdate [lindex $info 2]]
8896     $ctext insert end "\t[mc "Date"]:\t$date\n"
8897     set kids $children($curview,$id)
8898     if {$kids ne {}} {
8899         $ctext insert end "\n[mc "Children"]:"
8900         set i 0
8901         foreach child $kids {
8902             incr i
8903             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8904             set info $commitinfo($child)
8905             $ctext insert end "\n\t"
8906             $ctext insert end $child link$i
8907             setlink $child link$i
8908             $ctext insert end "\n\t[lindex $info 0]"
8909             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8910             set date [formatdate [lindex $info 2]]
8911             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8912         }
8913     }
8914     maybe_scroll_ctext 1
8915     $ctext conf -state disabled
8916     init_flist {}
8917 }
8918
8919 proc normalline {} {
8920     global thickerline
8921     if {[info exists thickerline]} {
8922         set id $thickerline
8923         unset thickerline
8924         drawlines $id
8925     }
8926 }
8927
8928 proc selbyid {id {isnew 1}} {
8929     global curview
8930     if {[commitinview $id $curview]} {
8931         selectline [rowofcommit $id] $isnew
8932     }
8933 }
8934
8935 proc mstime {} {
8936     global startmstime
8937     if {![info exists startmstime]} {
8938         set startmstime [clock clicks -milliseconds]
8939     }
8940     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8941 }
8942
8943 proc rowmenu {x y id} {
8944     global rowctxmenu selectedline rowmenuid curview
8945     global nullid nullid2 fakerowmenu mainhead markedid
8946
8947     stopfinding
8948     set rowmenuid $id
8949     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8950         set state disabled
8951     } else {
8952         set state normal
8953     }
8954     if {[info exists markedid] && $markedid ne $id} {
8955         set mstate normal
8956     } else {
8957         set mstate disabled
8958     }
8959     if {$id ne $nullid && $id ne $nullid2} {
8960         set menu $rowctxmenu
8961         if {$mainhead ne {}} {
8962             $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8963         } else {
8964             $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8965         }
8966         $menu entryconfigure 10 -state $mstate
8967         $menu entryconfigure 11 -state $mstate
8968         $menu entryconfigure 12 -state $mstate
8969     } else {
8970         set menu $fakerowmenu
8971     }
8972     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8973     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8974     $menu entryconfigure [mca "Make patch"] -state $state
8975     $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8976     $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8977     tk_popup $menu $x $y
8978 }
8979
8980 proc markhere {} {
8981     global rowmenuid markedid canv
8982
8983     set markedid $rowmenuid
8984     make_idmark $markedid
8985 }
8986
8987 proc gotomark {} {
8988     global markedid
8989
8990     if {[info exists markedid]} {
8991         selbyid $markedid
8992     }
8993 }
8994
8995 proc replace_by_kids {l r} {
8996     global curview children
8997
8998     set id [commitonrow $r]
8999     set l [lreplace $l 0 0]
9000     foreach kid $children($curview,$id) {
9001         lappend l [rowofcommit $kid]
9002     }
9003     return [lsort -integer -decreasing -unique $l]
9004 }
9005
9006 proc find_common_desc {} {
9007     global markedid rowmenuid curview children
9008
9009     if {![info exists markedid]} return
9010     if {![commitinview $markedid $curview] ||
9011         ![commitinview $rowmenuid $curview]} return
9012     #set t1 [clock clicks -milliseconds]
9013     set l1 [list [rowofcommit $markedid]]
9014     set l2 [list [rowofcommit $rowmenuid]]
9015     while 1 {
9016         set r1 [lindex $l1 0]
9017         set r2 [lindex $l2 0]
9018         if {$r1 eq {} || $r2 eq {}} break
9019         if {$r1 == $r2} {
9020             selectline $r1 1
9021             break
9022         }
9023         if {$r1 > $r2} {
9024             set l1 [replace_by_kids $l1 $r1]
9025         } else {
9026             set l2 [replace_by_kids $l2 $r2]
9027         }
9028     }
9029     #set t2 [clock clicks -milliseconds]
9030     #puts "took [expr {$t2-$t1}]ms"
9031 }
9032
9033 proc compare_commits {} {
9034     global markedid rowmenuid curview children
9035
9036     if {![info exists markedid]} return
9037     if {![commitinview $markedid $curview]} return
9038     addtohistory [list do_cmp_commits $markedid $rowmenuid]
9039     do_cmp_commits $markedid $rowmenuid
9040 }
9041
9042 proc getpatchid {id} {
9043     global patchids
9044
9045     if {![info exists patchids($id)]} {
9046         set cmd [diffcmd [list $id] {-p --root}]
9047         # trim off the initial "|"
9048         set cmd [lrange $cmd 1 end]
9049         if {[catch {
9050             set x [eval exec $cmd | git patch-id]
9051             set patchids($id) [lindex $x 0]
9052         }]} {
9053             set patchids($id) "error"
9054         }
9055     }
9056     return $patchids($id)
9057 }
9058
9059 proc do_cmp_commits {a b} {
9060     global ctext curview parents children patchids commitinfo
9061
9062     $ctext conf -state normal
9063     clear_ctext
9064     init_flist {}
9065     for {set i 0} {$i < 100} {incr i} {
9066         set skipa 0
9067         set skipb 0
9068         if {[llength $parents($curview,$a)] > 1} {
9069             appendshortlink $a [mc "Skipping merge commit "] "\n"
9070             set skipa 1
9071         } else {
9072             set patcha [getpatchid $a]
9073         }
9074         if {[llength $parents($curview,$b)] > 1} {
9075             appendshortlink $b [mc "Skipping merge commit "] "\n"
9076             set skipb 1
9077         } else {
9078             set patchb [getpatchid $b]
9079         }
9080         if {!$skipa && !$skipb} {
9081             set heada [lindex $commitinfo($a) 0]
9082             set headb [lindex $commitinfo($b) 0]
9083             if {$patcha eq "error"} {
9084                 appendshortlink $a [mc "Error getting patch ID for "] \
9085                     [mc " - stopping\n"]
9086                 break
9087             }
9088             if {$patchb eq "error"} {
9089                 appendshortlink $b [mc "Error getting patch ID for "] \
9090                     [mc " - stopping\n"]
9091                 break
9092             }
9093             if {$patcha eq $patchb} {
9094                 if {$heada eq $headb} {
9095                     appendshortlink $a [mc "Commit "]
9096                     appendshortlink $b " == " "  $heada\n"
9097                 } else {
9098                     appendshortlink $a [mc "Commit "] "  $heada\n"
9099                     appendshortlink $b [mc " is the same patch as\n       "] \
9100                         "  $headb\n"
9101                 }
9102                 set skipa 1
9103                 set skipb 1
9104             } else {
9105                 $ctext insert end "\n"
9106                 appendshortlink $a [mc "Commit "] "  $heada\n"
9107                 appendshortlink $b [mc " differs from\n       "] \
9108                     "  $headb\n"
9109                 $ctext insert end [mc "Diff of commits:\n\n"]
9110                 $ctext conf -state disabled
9111                 update
9112                 diffcommits $a $b
9113                 return
9114             }
9115         }
9116         if {$skipa} {
9117             set kids [real_children $curview,$a]
9118             if {[llength $kids] != 1} {
9119                 $ctext insert end "\n"
9120                 appendshortlink $a [mc "Commit "] \
9121                     [mc " has %s children - stopping\n" [llength $kids]]
9122                 break
9123             }
9124             set a [lindex $kids 0]
9125         }
9126         if {$skipb} {
9127             set kids [real_children $curview,$b]
9128             if {[llength $kids] != 1} {
9129                 appendshortlink $b [mc "Commit "] \
9130                     [mc " has %s children - stopping\n" [llength $kids]]
9131                 break
9132             }
9133             set b [lindex $kids 0]
9134         }
9135     }
9136     $ctext conf -state disabled
9137 }
9138
9139 proc diffcommits {a b} {
9140     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9141
9142     set tmpdir [gitknewtmpdir]
9143     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9144     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9145     if {[catch {
9146         exec git diff-tree -p --pretty $a >$fna
9147         exec git diff-tree -p --pretty $b >$fnb
9148     } err]} {
9149         error_popup [mc "Error writing commit to file: %s" $err]
9150         return
9151     }
9152     if {[catch {
9153         set fd [open "| diff -U$diffcontext $fna $fnb" r]
9154     } err]} {
9155         error_popup [mc "Error diffing commits: %s" $err]
9156         return
9157     }
9158     set diffids [list commits $a $b]
9159     set blobdifffd($diffids) $fd
9160     set diffinhdr 0
9161     set currdiffsubmod ""
9162     filerun $fd [list getblobdiffline $fd $diffids]
9163 }
9164
9165 proc diffvssel {dirn} {
9166     global rowmenuid selectedline
9167
9168     if {$selectedline eq {}} return
9169     if {$dirn} {
9170         set oldid [commitonrow $selectedline]
9171         set newid $rowmenuid
9172     } else {
9173         set oldid $rowmenuid
9174         set newid [commitonrow $selectedline]
9175     }
9176     addtohistory [list doseldiff $oldid $newid] savectextpos
9177     doseldiff $oldid $newid
9178 }
9179
9180 proc diffvsmark {dirn} {
9181     global rowmenuid markedid
9182
9183     if {![info exists markedid]} return
9184     if {$dirn} {
9185         set oldid $markedid
9186         set newid $rowmenuid
9187     } else {
9188         set oldid $rowmenuid
9189         set newid $markedid
9190     }
9191     addtohistory [list doseldiff $oldid $newid] savectextpos
9192     doseldiff $oldid $newid
9193 }
9194
9195 proc doseldiff {oldid newid} {
9196     global ctext
9197     global commitinfo
9198
9199     $ctext conf -state normal
9200     clear_ctext
9201     init_flist [mc "Top"]
9202     $ctext insert end "[mc "From"] "
9203     $ctext insert end $oldid link0
9204     setlink $oldid link0
9205     $ctext insert end "\n     "
9206     $ctext insert end [lindex $commitinfo($oldid) 0]
9207     $ctext insert end "\n\n[mc "To"]   "
9208     $ctext insert end $newid link1
9209     setlink $newid link1
9210     $ctext insert end "\n     "
9211     $ctext insert end [lindex $commitinfo($newid) 0]
9212     $ctext insert end "\n"
9213     $ctext conf -state disabled
9214     $ctext tag remove found 1.0 end
9215     startdiff [list $oldid $newid]
9216 }
9217
9218 proc mkpatch {} {
9219     global rowmenuid currentid commitinfo patchtop patchnum NS
9220
9221     if {![info exists currentid]} return
9222     set oldid $currentid
9223     set oldhead [lindex $commitinfo($oldid) 0]
9224     set newid $rowmenuid
9225     set newhead [lindex $commitinfo($newid) 0]
9226     set top .patch
9227     set patchtop $top
9228     catch {destroy $top}
9229     ttk_toplevel $top
9230     make_transient $top .
9231     ${NS}::label $top.title -text [mc "Generate patch"]
9232     grid $top.title - -pady 10
9233     ${NS}::label $top.from -text [mc "From:"]
9234     ${NS}::entry $top.fromsha1 -width 40
9235     $top.fromsha1 insert 0 $oldid
9236     $top.fromsha1 conf -state readonly
9237     grid $top.from $top.fromsha1 -sticky w
9238     ${NS}::entry $top.fromhead -width 60
9239     $top.fromhead insert 0 $oldhead
9240     $top.fromhead conf -state readonly
9241     grid x $top.fromhead -sticky w
9242     ${NS}::label $top.to -text [mc "To:"]
9243     ${NS}::entry $top.tosha1 -width 40
9244     $top.tosha1 insert 0 $newid
9245     $top.tosha1 conf -state readonly
9246     grid $top.to $top.tosha1 -sticky w
9247     ${NS}::entry $top.tohead -width 60
9248     $top.tohead insert 0 $newhead
9249     $top.tohead conf -state readonly
9250     grid x $top.tohead -sticky w
9251     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9252     grid $top.rev x -pady 10 -padx 5
9253     ${NS}::label $top.flab -text [mc "Output file:"]
9254     ${NS}::entry $top.fname -width 60
9255     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9256     incr patchnum
9257     grid $top.flab $top.fname -sticky w
9258     ${NS}::frame $top.buts
9259     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9260     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9261     bind $top <Key-Return> mkpatchgo
9262     bind $top <Key-Escape> mkpatchcan
9263     grid $top.buts.gen $top.buts.can
9264     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9265     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9266     grid $top.buts - -pady 10 -sticky ew
9267     focus $top.fname
9268 }
9269
9270 proc mkpatchrev {} {
9271     global patchtop
9272
9273     set oldid [$patchtop.fromsha1 get]
9274     set oldhead [$patchtop.fromhead get]
9275     set newid [$patchtop.tosha1 get]
9276     set newhead [$patchtop.tohead get]
9277     foreach e [list fromsha1 fromhead tosha1 tohead] \
9278             v [list $newid $newhead $oldid $oldhead] {
9279         $patchtop.$e conf -state normal
9280         $patchtop.$e delete 0 end
9281         $patchtop.$e insert 0 $v
9282         $patchtop.$e conf -state readonly
9283     }
9284 }
9285
9286 proc mkpatchgo {} {
9287     global patchtop nullid nullid2
9288
9289     set oldid [$patchtop.fromsha1 get]
9290     set newid [$patchtop.tosha1 get]
9291     set fname [$patchtop.fname get]
9292     set cmd [diffcmd [list $oldid $newid] -p]
9293     # trim off the initial "|"
9294     set cmd [lrange $cmd 1 end]
9295     lappend cmd >$fname &
9296     if {[catch {eval exec $cmd} err]} {
9297         error_popup "[mc "Error creating patch:"] $err" $patchtop
9298     }
9299     catch {destroy $patchtop}
9300     unset patchtop
9301 }
9302
9303 proc mkpatchcan {} {
9304     global patchtop
9305
9306     catch {destroy $patchtop}
9307     unset patchtop
9308 }
9309
9310 proc mktag {} {
9311     global rowmenuid mktagtop commitinfo NS
9312
9313     set top .maketag
9314     set mktagtop $top
9315     catch {destroy $top}
9316     ttk_toplevel $top
9317     make_transient $top .
9318     ${NS}::label $top.title -text [mc "Create tag"]
9319     grid $top.title - -pady 10
9320     ${NS}::label $top.id -text [mc "ID:"]
9321     ${NS}::entry $top.sha1 -width 40
9322     $top.sha1 insert 0 $rowmenuid
9323     $top.sha1 conf -state readonly
9324     grid $top.id $top.sha1 -sticky w
9325     ${NS}::entry $top.head -width 60
9326     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9327     $top.head conf -state readonly
9328     grid x $top.head -sticky w
9329     ${NS}::label $top.tlab -text [mc "Tag name:"]
9330     ${NS}::entry $top.tag -width 60
9331     grid $top.tlab $top.tag -sticky w
9332     ${NS}::label $top.op -text [mc "Tag message is optional"]
9333     grid $top.op -columnspan 2 -sticky we
9334     ${NS}::label $top.mlab -text [mc "Tag message:"]
9335     ${NS}::entry $top.msg -width 60
9336     grid $top.mlab $top.msg -sticky w
9337     ${NS}::frame $top.buts
9338     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9339     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9340     bind $top <Key-Return> mktaggo
9341     bind $top <Key-Escape> mktagcan
9342     grid $top.buts.gen $top.buts.can
9343     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9344     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9345     grid $top.buts - -pady 10 -sticky ew
9346     focus $top.tag
9347 }
9348
9349 proc domktag {} {
9350     global mktagtop env tagids idtags
9351
9352     set id [$mktagtop.sha1 get]
9353     set tag [$mktagtop.tag get]
9354     set msg [$mktagtop.msg get]
9355     if {$tag == {}} {
9356         error_popup [mc "No tag name specified"] $mktagtop
9357         return 0
9358     }
9359     if {[info exists tagids($tag)]} {
9360         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9361         return 0
9362     }
9363     if {[catch {
9364         if {$msg != {}} {
9365             exec git tag -a -m $msg $tag $id
9366         } else {
9367             exec git tag $tag $id
9368         }
9369     } err]} {
9370         error_popup "[mc "Error creating tag:"] $err" $mktagtop
9371         return 0
9372     }
9373
9374     set tagids($tag) $id
9375     lappend idtags($id) $tag
9376     redrawtags $id
9377     addedtag $id
9378     dispneartags 0
9379     run refill_reflist
9380     return 1
9381 }
9382
9383 proc redrawtags {id} {
9384     global canv linehtag idpos currentid curview cmitlisted markedid
9385     global canvxmax iddrawn circleitem mainheadid circlecolors
9386     global mainheadcirclecolor
9387
9388     if {![commitinview $id $curview]} return
9389     if {![info exists iddrawn($id)]} return
9390     set row [rowofcommit $id]
9391     if {$id eq $mainheadid} {
9392         set ofill $mainheadcirclecolor
9393     } else {
9394         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9395     }
9396     $canv itemconf $circleitem($row) -fill $ofill
9397     $canv delete tag.$id
9398     set xt [eval drawtags $id $idpos($id)]
9399     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9400     set text [$canv itemcget $linehtag($id) -text]
9401     set font [$canv itemcget $linehtag($id) -font]
9402     set xr [expr {$xt + [font measure $font $text]}]
9403     if {$xr > $canvxmax} {
9404         set canvxmax $xr
9405         setcanvscroll
9406     }
9407     if {[info exists currentid] && $currentid == $id} {
9408         make_secsel $id
9409     }
9410     if {[info exists markedid] && $markedid eq $id} {
9411         make_idmark $id
9412     }
9413 }
9414
9415 proc mktagcan {} {
9416     global mktagtop
9417
9418     catch {destroy $mktagtop}
9419     unset mktagtop
9420 }
9421
9422 proc mktaggo {} {
9423     if {![domktag]} return
9424     mktagcan
9425 }
9426
9427 proc copysummary {} {
9428     global rowmenuid autosellen
9429
9430     set format "%h (\"%s\", %ad)"
9431     set cmd [list git show -s --pretty=format:$format --date=short]
9432     if {$autosellen < 40} {
9433         lappend cmd --abbrev=$autosellen
9434     }
9435     set summary [eval exec $cmd $rowmenuid]
9436
9437     clipboard clear
9438     clipboard append $summary
9439 }
9440
9441 proc writecommit {} {
9442     global rowmenuid wrcomtop commitinfo wrcomcmd NS
9443
9444     set top .writecommit
9445     set wrcomtop $top
9446     catch {destroy $top}
9447     ttk_toplevel $top
9448     make_transient $top .
9449     ${NS}::label $top.title -text [mc "Write commit to file"]
9450     grid $top.title - -pady 10
9451     ${NS}::label $top.id -text [mc "ID:"]
9452     ${NS}::entry $top.sha1 -width 40
9453     $top.sha1 insert 0 $rowmenuid
9454     $top.sha1 conf -state readonly
9455     grid $top.id $top.sha1 -sticky w
9456     ${NS}::entry $top.head -width 60
9457     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9458     $top.head conf -state readonly
9459     grid x $top.head -sticky w
9460     ${NS}::label $top.clab -text [mc "Command:"]
9461     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9462     grid $top.clab $top.cmd -sticky w -pady 10
9463     ${NS}::label $top.flab -text [mc "Output file:"]
9464     ${NS}::entry $top.fname -width 60
9465     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9466     grid $top.flab $top.fname -sticky w
9467     ${NS}::frame $top.buts
9468     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9469     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9470     bind $top <Key-Return> wrcomgo
9471     bind $top <Key-Escape> wrcomcan
9472     grid $top.buts.gen $top.buts.can
9473     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9474     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9475     grid $top.buts - -pady 10 -sticky ew
9476     focus $top.fname
9477 }
9478
9479 proc wrcomgo {} {
9480     global wrcomtop
9481
9482     set id [$wrcomtop.sha1 get]
9483     set cmd "echo $id | [$wrcomtop.cmd get]"
9484     set fname [$wrcomtop.fname get]
9485     if {[catch {exec sh -c $cmd >$fname &} err]} {
9486         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9487     }
9488     catch {destroy $wrcomtop}
9489     unset wrcomtop
9490 }
9491
9492 proc wrcomcan {} {
9493     global wrcomtop
9494
9495     catch {destroy $wrcomtop}
9496     unset wrcomtop
9497 }
9498
9499 proc mkbranch {} {
9500     global NS rowmenuid
9501
9502     set top .branchdialog
9503
9504     set val(name) ""
9505     set val(id) $rowmenuid
9506     set val(command) [list mkbrgo $top]
9507
9508     set ui(title) [mc "Create branch"]
9509     set ui(accept) [mc "Create"]
9510
9511     branchdia $top val ui
9512 }
9513
9514 proc mvbranch {} {
9515     global NS
9516     global headmenuid headmenuhead
9517
9518     set top .branchdialog
9519
9520     set val(name) $headmenuhead
9521     set val(id) $headmenuid
9522     set val(command) [list mvbrgo $top $headmenuhead]
9523
9524     set ui(title) [mc "Rename branch %s" $headmenuhead]
9525     set ui(accept) [mc "Rename"]
9526
9527     branchdia $top val ui
9528 }
9529
9530 proc branchdia {top valvar uivar} {
9531     global NS commitinfo
9532     upvar $valvar val $uivar ui
9533
9534     catch {destroy $top}
9535     ttk_toplevel $top
9536     make_transient $top .
9537     ${NS}::label $top.title -text $ui(title)
9538     grid $top.title - -pady 10
9539     ${NS}::label $top.id -text [mc "ID:"]
9540     ${NS}::entry $top.sha1 -width 40
9541     $top.sha1 insert 0 $val(id)
9542     $top.sha1 conf -state readonly
9543     grid $top.id $top.sha1 -sticky w
9544     ${NS}::entry $top.head -width 60
9545     $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9546     $top.head conf -state readonly
9547     grid x $top.head -sticky ew
9548     grid columnconfigure $top 1 -weight 1
9549     ${NS}::label $top.nlab -text [mc "Name:"]
9550     ${NS}::entry $top.name -width 40
9551     $top.name insert 0 $val(name)
9552     grid $top.nlab $top.name -sticky w
9553     ${NS}::frame $top.buts
9554     ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9555     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9556     bind $top <Key-Return> $val(command)
9557     bind $top <Key-Escape> "catch {destroy $top}"
9558     grid $top.buts.go $top.buts.can
9559     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9560     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9561     grid $top.buts - -pady 10 -sticky ew
9562     focus $top.name
9563 }
9564
9565 proc mkbrgo {top} {
9566     global headids idheads
9567
9568     set name [$top.name get]
9569     set id [$top.sha1 get]
9570     set cmdargs {}
9571     set old_id {}
9572     if {$name eq {}} {
9573         error_popup [mc "Please specify a name for the new branch"] $top
9574         return
9575     }
9576     if {[info exists headids($name)]} {
9577         if {![confirm_popup [mc \
9578                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9579             return
9580         }
9581         set old_id $headids($name)
9582         lappend cmdargs -f
9583     }
9584     catch {destroy $top}
9585     lappend cmdargs $name $id
9586     nowbusy newbranch
9587     update
9588     if {[catch {
9589         eval exec git branch $cmdargs
9590     } err]} {
9591         notbusy newbranch
9592         error_popup $err
9593     } else {
9594         notbusy newbranch
9595         if {$old_id ne {}} {
9596             movehead $id $name
9597             movedhead $id $name
9598             redrawtags $old_id
9599             redrawtags $id
9600         } else {
9601             set headids($name) $id
9602             lappend idheads($id) $name
9603             addedhead $id $name
9604             redrawtags $id
9605         }
9606         dispneartags 0
9607         run refill_reflist
9608     }
9609 }
9610
9611 proc mvbrgo {top prevname} {
9612     global headids idheads mainhead mainheadid
9613
9614     set name [$top.name get]
9615     set id [$top.sha1 get]
9616     set cmdargs {}
9617     if {$name eq $prevname} {
9618         catch {destroy $top}
9619         return
9620     }
9621     if {$name eq {}} {
9622         error_popup [mc "Please specify a new name for the branch"] $top
9623         return
9624     }
9625     catch {destroy $top}
9626     lappend cmdargs -m $prevname $name
9627     nowbusy renamebranch
9628     update
9629     if {[catch {
9630         eval exec git branch $cmdargs
9631     } err]} {
9632         notbusy renamebranch
9633         error_popup $err
9634     } else {
9635         notbusy renamebranch
9636         removehead $id $prevname
9637         removedhead $id $prevname
9638         set headids($name) $id
9639         lappend idheads($id) $name
9640         addedhead $id $name
9641         if {$prevname eq $mainhead} {
9642             set mainhead $name
9643             set mainheadid $id
9644         }
9645         redrawtags $id
9646         dispneartags 0
9647         run refill_reflist
9648     }
9649 }
9650
9651 proc exec_citool {tool_args {baseid {}}} {
9652     global commitinfo env
9653
9654     set save_env [array get env GIT_AUTHOR_*]
9655
9656     if {$baseid ne {}} {
9657         if {![info exists commitinfo($baseid)]} {
9658             getcommit $baseid
9659         }
9660         set author [lindex $commitinfo($baseid) 1]
9661         set date [lindex $commitinfo($baseid) 2]
9662         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9663                     $author author name email]
9664             && $date ne {}} {
9665             set env(GIT_AUTHOR_NAME) $name
9666             set env(GIT_AUTHOR_EMAIL) $email
9667             set env(GIT_AUTHOR_DATE) $date
9668         }
9669     }
9670
9671     eval exec git citool $tool_args &
9672
9673     array unset env GIT_AUTHOR_*
9674     array set env $save_env
9675 }
9676
9677 proc cherrypick {} {
9678     global rowmenuid curview
9679     global mainhead mainheadid
9680     global gitdir
9681
9682     set oldhead [exec git rev-parse HEAD]
9683     set dheads [descheads $rowmenuid]
9684     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9685         set ok [confirm_popup [mc "Commit %s is already\
9686                 included in branch %s -- really re-apply it?" \
9687                                    [string range $rowmenuid 0 7] $mainhead]]
9688         if {!$ok} return
9689     }
9690     nowbusy cherrypick [mc "Cherry-picking"]
9691     update
9692     # Unfortunately git-cherry-pick writes stuff to stderr even when
9693     # no error occurs, and exec takes that as an indication of error...
9694     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9695         notbusy cherrypick
9696         if {[regexp -line \
9697                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9698                  $err msg fname]} {
9699             error_popup [mc "Cherry-pick failed because of local changes\
9700                         to file '%s'.\nPlease commit, reset or stash\
9701                         your changes and try again." $fname]
9702         } elseif {[regexp -line \
9703                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9704                        $err]} {
9705             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9706                         conflict.\nDo you wish to run git citool to\
9707                         resolve it?"]]} {
9708                 # Force citool to read MERGE_MSG
9709                 file delete [file join $gitdir "GITGUI_MSG"]
9710                 exec_citool {} $rowmenuid
9711             }
9712         } else {
9713             error_popup $err
9714         }
9715         run updatecommits
9716         return
9717     }
9718     set newhead [exec git rev-parse HEAD]
9719     if {$newhead eq $oldhead} {
9720         notbusy cherrypick
9721         error_popup [mc "No changes committed"]
9722         return
9723     }
9724     addnewchild $newhead $oldhead
9725     if {[commitinview $oldhead $curview]} {
9726         # XXX this isn't right if we have a path limit...
9727         insertrow $newhead $oldhead $curview
9728         if {$mainhead ne {}} {
9729             movehead $newhead $mainhead
9730             movedhead $newhead $mainhead
9731         }
9732         set mainheadid $newhead
9733         redrawtags $oldhead
9734         redrawtags $newhead
9735         selbyid $newhead
9736     }
9737     notbusy cherrypick
9738 }
9739
9740 proc revert {} {
9741     global rowmenuid curview
9742     global mainhead mainheadid
9743     global gitdir
9744
9745     set oldhead [exec git rev-parse HEAD]
9746     set dheads [descheads $rowmenuid]
9747     if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9748        set ok [confirm_popup [mc "Commit %s is not\
9749            included in branch %s -- really revert it?" \
9750                       [string range $rowmenuid 0 7] $mainhead]]
9751        if {!$ok} return
9752     }
9753     nowbusy revert [mc "Reverting"]
9754     update
9755
9756     if [catch {exec git revert --no-edit $rowmenuid} err] {
9757         notbusy revert
9758         if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9759                 $err match files] {
9760             regsub {\n( |\t)+} $files "\n" files
9761             error_popup [mc "Revert failed because of local changes to\
9762                 the following files:%s Please commit, reset or stash \
9763                 your changes and try again." $files]
9764         } elseif [regexp {error: could not revert} $err] {
9765             if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9766                 Do you wish to run git citool to resolve it?"]] {
9767                 # Force citool to read MERGE_MSG
9768                 file delete [file join $gitdir "GITGUI_MSG"]
9769                 exec_citool {} $rowmenuid
9770             }
9771         } else { error_popup $err }
9772         run updatecommits
9773         return
9774     }
9775
9776     set newhead [exec git rev-parse HEAD]
9777     if { $newhead eq $oldhead } {
9778         notbusy revert
9779         error_popup [mc "No changes committed"]
9780         return
9781     }
9782
9783     addnewchild $newhead $oldhead
9784
9785     if [commitinview $oldhead $curview] {
9786         # XXX this isn't right if we have a path limit...
9787         insertrow $newhead $oldhead $curview
9788         if {$mainhead ne {}} {
9789             movehead $newhead $mainhead
9790             movedhead $newhead $mainhead
9791         }
9792         set mainheadid $newhead
9793         redrawtags $oldhead
9794         redrawtags $newhead
9795         selbyid $newhead
9796     }
9797
9798     notbusy revert
9799 }
9800
9801 proc resethead {} {
9802     global mainhead rowmenuid confirm_ok resettype NS
9803
9804     set confirm_ok 0
9805     set w ".confirmreset"
9806     ttk_toplevel $w
9807     make_transient $w .
9808     wm title $w [mc "Confirm reset"]
9809     ${NS}::label $w.m -text \
9810         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9811     pack $w.m -side top -fill x -padx 20 -pady 20
9812     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9813     set resettype mixed
9814     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9815         -text [mc "Soft: Leave working tree and index untouched"]
9816     grid $w.f.soft -sticky w
9817     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9818         -text [mc "Mixed: Leave working tree untouched, reset index"]
9819     grid $w.f.mixed -sticky w
9820     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9821         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9822     grid $w.f.hard -sticky w
9823     pack $w.f -side top -fill x -padx 4
9824     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9825     pack $w.ok -side left -fill x -padx 20 -pady 20
9826     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9827     bind $w <Key-Escape> [list destroy $w]
9828     pack $w.cancel -side right -fill x -padx 20 -pady 20
9829     bind $w <Visibility> "grab $w; focus $w"
9830     tkwait window $w
9831     if {!$confirm_ok} return
9832     if {[catch {set fd [open \
9833             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9834         error_popup $err
9835     } else {
9836         dohidelocalchanges
9837         filerun $fd [list readresetstat $fd]
9838         nowbusy reset [mc "Resetting"]
9839         selbyid $rowmenuid
9840     }
9841 }
9842
9843 proc readresetstat {fd} {
9844     global mainhead mainheadid showlocalchanges rprogcoord
9845
9846     if {[gets $fd line] >= 0} {
9847         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9848             set rprogcoord [expr {1.0 * $m / $n}]
9849             adjustprogress
9850         }
9851         return 1
9852     }
9853     set rprogcoord 0
9854     adjustprogress
9855     notbusy reset
9856     if {[catch {close $fd} err]} {
9857         error_popup $err
9858     }
9859     set oldhead $mainheadid
9860     set newhead [exec git rev-parse HEAD]
9861     if {$newhead ne $oldhead} {
9862         movehead $newhead $mainhead
9863         movedhead $newhead $mainhead
9864         set mainheadid $newhead
9865         redrawtags $oldhead
9866         redrawtags $newhead
9867     }
9868     if {$showlocalchanges} {
9869         doshowlocalchanges
9870     }
9871     return 0
9872 }
9873
9874 # context menu for a head
9875 proc headmenu {x y id head} {
9876     global headmenuid headmenuhead headctxmenu mainhead headids
9877
9878     stopfinding
9879     set headmenuid $id
9880     set headmenuhead $head
9881     array set state {0 normal 1 normal 2 normal}
9882     if {[string match "remotes/*" $head]} {
9883         set localhead [string range $head [expr [string last / $head] + 1] end]
9884         if {[info exists headids($localhead)]} {
9885             set state(0) disabled
9886         }
9887         array set state {1 disabled 2 disabled}
9888     }
9889     if {$head eq $mainhead} {
9890         array set state {0 disabled 2 disabled}
9891     }
9892     foreach i {0 1 2} {
9893         $headctxmenu entryconfigure $i -state $state($i)
9894     }
9895     tk_popup $headctxmenu $x $y
9896 }
9897
9898 proc cobranch {} {
9899     global headmenuid headmenuhead headids
9900     global showlocalchanges
9901
9902     # check the tree is clean first??
9903     set newhead $headmenuhead
9904     set command [list | git checkout]
9905     if {[string match "remotes/*" $newhead]} {
9906         set remote $newhead
9907         set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9908         # The following check is redundant - the menu option should
9909         # be disabled to begin with...
9910         if {[info exists headids($newhead)]} {
9911             error_popup [mc "A local branch named %s exists already" $newhead]
9912             return
9913         }
9914         lappend command -b $newhead --track $remote
9915     } else {
9916         lappend command $newhead
9917     }
9918     lappend command 2>@1
9919     nowbusy checkout [mc "Checking out"]
9920     update
9921     dohidelocalchanges
9922     if {[catch {
9923         set fd [open $command r]
9924     } err]} {
9925         notbusy checkout
9926         error_popup $err
9927         if {$showlocalchanges} {
9928             dodiffindex
9929         }
9930     } else {
9931         filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9932     }
9933 }
9934
9935 proc readcheckoutstat {fd newhead newheadid} {
9936     global mainhead mainheadid headids idheads showlocalchanges progresscoords
9937     global viewmainheadid curview
9938
9939     if {[gets $fd line] >= 0} {
9940         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9941             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9942             adjustprogress
9943         }
9944         return 1
9945     }
9946     set progresscoords {0 0}
9947     adjustprogress
9948     notbusy checkout
9949     if {[catch {close $fd} err]} {
9950         error_popup $err
9951         return
9952     }
9953     set oldmainid $mainheadid
9954     if {! [info exists headids($newhead)]} {
9955         set headids($newhead) $newheadid
9956         lappend idheads($newheadid) $newhead
9957         addedhead $newheadid $newhead
9958     }
9959     set mainhead $newhead
9960     set mainheadid $newheadid
9961     set viewmainheadid($curview) $newheadid
9962     redrawtags $oldmainid
9963     redrawtags $newheadid
9964     selbyid $newheadid
9965     if {$showlocalchanges} {
9966         dodiffindex
9967     }
9968 }
9969
9970 proc rmbranch {} {
9971     global headmenuid headmenuhead mainhead
9972     global idheads
9973
9974     set head $headmenuhead
9975     set id $headmenuid
9976     # this check shouldn't be needed any more...
9977     if {$head eq $mainhead} {
9978         error_popup [mc "Cannot delete the currently checked-out branch"]
9979         return
9980     }
9981     set dheads [descheads $id]
9982     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9983         # the stuff on this branch isn't on any other branch
9984         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9985                         branch.\nReally delete branch %s?" $head $head]]} return
9986     }
9987     nowbusy rmbranch
9988     update
9989     if {[catch {exec git branch -D $head} err]} {
9990         notbusy rmbranch
9991         error_popup $err
9992         return
9993     }
9994     removehead $id $head
9995     removedhead $id $head
9996     redrawtags $id
9997     notbusy rmbranch
9998     dispneartags 0
9999     run refill_reflist
10000 }
10001
10002 # Display a list of tags and heads
10003 proc showrefs {} {
10004     global showrefstop bgcolor fgcolor selectbgcolor NS
10005     global bglist fglist reflistfilter reflist maincursor
10006
10007     set top .showrefs
10008     set showrefstop $top
10009     if {[winfo exists $top]} {
10010         raise $top
10011         refill_reflist
10012         return
10013     }
10014     ttk_toplevel $top
10015     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
10016     make_transient $top .
10017     text $top.list -background $bgcolor -foreground $fgcolor \
10018         -selectbackground $selectbgcolor -font mainfont \
10019         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
10020         -width 30 -height 20 -cursor $maincursor \
10021         -spacing1 1 -spacing3 1 -state disabled
10022     $top.list tag configure highlight -background $selectbgcolor
10023     if {![lsearch -exact $bglist $top.list]} {
10024         lappend bglist $top.list
10025         lappend fglist $top.list
10026     }
10027     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
10028     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
10029     grid $top.list $top.ysb -sticky nsew
10030     grid $top.xsb x -sticky ew
10031     ${NS}::frame $top.f
10032     ${NS}::label $top.f.l -text "[mc "Filter"]: "
10033     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
10034     set reflistfilter "*"
10035     trace add variable reflistfilter write reflistfilter_change
10036     pack $top.f.e -side right -fill x -expand 1
10037     pack $top.f.l -side left
10038     grid $top.f - -sticky ew -pady 2
10039     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
10040     bind $top <Key-Escape> [list destroy $top]
10041     grid $top.close -
10042     grid columnconfigure $top 0 -weight 1
10043     grid rowconfigure $top 0 -weight 1
10044     bind $top.list <1> {break}
10045     bind $top.list <B1-Motion> {break}
10046     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10047     set reflist {}
10048     refill_reflist
10049 }
10050
10051 proc sel_reflist {w x y} {
10052     global showrefstop reflist headids tagids otherrefids
10053
10054     if {![winfo exists $showrefstop]} return
10055     set l [lindex [split [$w index "@$x,$y"] "."] 0]
10056     set ref [lindex $reflist [expr {$l-1}]]
10057     set n [lindex $ref 0]
10058     switch -- [lindex $ref 1] {
10059         "H" {selbyid $headids($n)}
10060         "T" {selbyid $tagids($n)}
10061         "o" {selbyid $otherrefids($n)}
10062     }
10063     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10064 }
10065
10066 proc unsel_reflist {} {
10067     global showrefstop
10068
10069     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10070     $showrefstop.list tag remove highlight 0.0 end
10071 }
10072
10073 proc reflistfilter_change {n1 n2 op} {
10074     global reflistfilter
10075
10076     after cancel refill_reflist
10077     after 200 refill_reflist
10078 }
10079
10080 proc refill_reflist {} {
10081     global reflist reflistfilter showrefstop headids tagids otherrefids
10082     global curview
10083
10084     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10085     set refs {}
10086     foreach n [array names headids] {
10087         if {[string match $reflistfilter $n]} {
10088             if {[commitinview $headids($n) $curview]} {
10089                 lappend refs [list $n H]
10090             } else {
10091                 interestedin $headids($n) {run refill_reflist}
10092             }
10093         }
10094     }
10095     foreach n [array names tagids] {
10096         if {[string match $reflistfilter $n]} {
10097             if {[commitinview $tagids($n) $curview]} {
10098                 lappend refs [list $n T]
10099             } else {
10100                 interestedin $tagids($n) {run refill_reflist}
10101             }
10102         }
10103     }
10104     foreach n [array names otherrefids] {
10105         if {[string match $reflistfilter $n]} {
10106             if {[commitinview $otherrefids($n) $curview]} {
10107                 lappend refs [list $n o]
10108             } else {
10109                 interestedin $otherrefids($n) {run refill_reflist}
10110             }
10111         }
10112     }
10113     set refs [lsort -index 0 $refs]
10114     if {$refs eq $reflist} return
10115
10116     # Update the contents of $showrefstop.list according to the
10117     # differences between $reflist (old) and $refs (new)
10118     $showrefstop.list conf -state normal
10119     $showrefstop.list insert end "\n"
10120     set i 0
10121     set j 0
10122     while {$i < [llength $reflist] || $j < [llength $refs]} {
10123         if {$i < [llength $reflist]} {
10124             if {$j < [llength $refs]} {
10125                 set cmp [string compare [lindex $reflist $i 0] \
10126                              [lindex $refs $j 0]]
10127                 if {$cmp == 0} {
10128                     set cmp [string compare [lindex $reflist $i 1] \
10129                                  [lindex $refs $j 1]]
10130                 }
10131             } else {
10132                 set cmp -1
10133             }
10134         } else {
10135             set cmp 1
10136         }
10137         switch -- $cmp {
10138             -1 {
10139                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10140                 incr i
10141             }
10142             0 {
10143                 incr i
10144                 incr j
10145             }
10146             1 {
10147                 set l [expr {$j + 1}]
10148                 $showrefstop.list image create $l.0 -align baseline \
10149                     -image reficon-[lindex $refs $j 1] -padx 2
10150                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10151                 incr j
10152             }
10153         }
10154     }
10155     set reflist $refs
10156     # delete last newline
10157     $showrefstop.list delete end-2c end-1c
10158     $showrefstop.list conf -state disabled
10159 }
10160
10161 # Stuff for finding nearby tags
10162 proc getallcommits {} {
10163     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10164     global idheads idtags idotherrefs allparents tagobjid
10165     global gitdir
10166
10167     if {![info exists allcommits]} {
10168         set nextarc 0
10169         set allcommits 0
10170         set seeds {}
10171         set allcwait 0
10172         set cachedarcs 0
10173         set allccache [file join $gitdir "gitk.cache"]
10174         if {![catch {
10175             set f [open $allccache r]
10176             set allcwait 1
10177             getcache $f
10178         }]} return
10179     }
10180
10181     if {$allcwait} {
10182         return
10183     }
10184     set cmd [list | git rev-list --parents]
10185     set allcupdate [expr {$seeds ne {}}]
10186     if {!$allcupdate} {
10187         set ids "--all"
10188     } else {
10189         set refs [concat [array names idheads] [array names idtags] \
10190                       [array names idotherrefs]]
10191         set ids {}
10192         set tagobjs {}
10193         foreach name [array names tagobjid] {
10194             lappend tagobjs $tagobjid($name)
10195         }
10196         foreach id [lsort -unique $refs] {
10197             if {![info exists allparents($id)] &&
10198                 [lsearch -exact $tagobjs $id] < 0} {
10199                 lappend ids $id
10200             }
10201         }
10202         if {$ids ne {}} {
10203             foreach id $seeds {
10204                 lappend ids "^$id"
10205             }
10206         }
10207     }
10208     if {$ids ne {}} {
10209         set fd [open [concat $cmd $ids] r]
10210         fconfigure $fd -blocking 0
10211         incr allcommits
10212         nowbusy allcommits
10213         filerun $fd [list getallclines $fd]
10214     } else {
10215         dispneartags 0
10216     }
10217 }
10218
10219 # Since most commits have 1 parent and 1 child, we group strings of
10220 # such commits into "arcs" joining branch/merge points (BMPs), which
10221 # are commits that either don't have 1 parent or don't have 1 child.
10222 #
10223 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10224 # arcout(id) - outgoing arcs for BMP
10225 # arcids(a) - list of IDs on arc including end but not start
10226 # arcstart(a) - BMP ID at start of arc
10227 # arcend(a) - BMP ID at end of arc
10228 # growing(a) - arc a is still growing
10229 # arctags(a) - IDs out of arcids (excluding end) that have tags
10230 # archeads(a) - IDs out of arcids (excluding end) that have heads
10231 # The start of an arc is at the descendent end, so "incoming" means
10232 # coming from descendents, and "outgoing" means going towards ancestors.
10233
10234 proc getallclines {fd} {
10235     global allparents allchildren idtags idheads nextarc
10236     global arcnos arcids arctags arcout arcend arcstart archeads growing
10237     global seeds allcommits cachedarcs allcupdate
10238
10239     set nid 0
10240     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10241         set id [lindex $line 0]
10242         if {[info exists allparents($id)]} {
10243             # seen it already
10244             continue
10245         }
10246         set cachedarcs 0
10247         set olds [lrange $line 1 end]
10248         set allparents($id) $olds
10249         if {![info exists allchildren($id)]} {
10250             set allchildren($id) {}
10251             set arcnos($id) {}
10252             lappend seeds $id
10253         } else {
10254             set a $arcnos($id)
10255             if {[llength $olds] == 1 && [llength $a] == 1} {
10256                 lappend arcids($a) $id
10257                 if {[info exists idtags($id)]} {
10258                     lappend arctags($a) $id
10259                 }
10260                 if {[info exists idheads($id)]} {
10261                     lappend archeads($a) $id
10262                 }
10263                 if {[info exists allparents($olds)]} {
10264                     # seen parent already
10265                     if {![info exists arcout($olds)]} {
10266                         splitarc $olds
10267                     }
10268                     lappend arcids($a) $olds
10269                     set arcend($a) $olds
10270                     unset growing($a)
10271                 }
10272                 lappend allchildren($olds) $id
10273                 lappend arcnos($olds) $a
10274                 continue
10275             }
10276         }
10277         foreach a $arcnos($id) {
10278             lappend arcids($a) $id
10279             set arcend($a) $id
10280             unset growing($a)
10281         }
10282
10283         set ao {}
10284         foreach p $olds {
10285             lappend allchildren($p) $id
10286             set a [incr nextarc]
10287             set arcstart($a) $id
10288             set archeads($a) {}
10289             set arctags($a) {}
10290             set archeads($a) {}
10291             set arcids($a) {}
10292             lappend ao $a
10293             set growing($a) 1
10294             if {[info exists allparents($p)]} {
10295                 # seen it already, may need to make a new branch
10296                 if {![info exists arcout($p)]} {
10297                     splitarc $p
10298                 }
10299                 lappend arcids($a) $p
10300                 set arcend($a) $p
10301                 unset growing($a)
10302             }
10303             lappend arcnos($p) $a
10304         }
10305         set arcout($id) $ao
10306     }
10307     if {$nid > 0} {
10308         global cached_dheads cached_dtags cached_atags
10309         unset -nocomplain cached_dheads
10310         unset -nocomplain cached_dtags
10311         unset -nocomplain cached_atags
10312     }
10313     if {![eof $fd]} {
10314         return [expr {$nid >= 1000? 2: 1}]
10315     }
10316     set cacheok 1
10317     if {[catch {
10318         fconfigure $fd -blocking 1
10319         close $fd
10320     } err]} {
10321         # got an error reading the list of commits
10322         # if we were updating, try rereading the whole thing again
10323         if {$allcupdate} {
10324             incr allcommits -1
10325             dropcache $err
10326             return
10327         }
10328         error_popup "[mc "Error reading commit topology information;\
10329                 branch and preceding/following tag information\
10330                 will be incomplete."]\n($err)"
10331         set cacheok 0
10332     }
10333     if {[incr allcommits -1] == 0} {
10334         notbusy allcommits
10335         if {$cacheok} {
10336             run savecache
10337         }
10338     }
10339     dispneartags 0
10340     return 0
10341 }
10342
10343 proc recalcarc {a} {
10344     global arctags archeads arcids idtags idheads
10345
10346     set at {}
10347     set ah {}
10348     foreach id [lrange $arcids($a) 0 end-1] {
10349         if {[info exists idtags($id)]} {
10350             lappend at $id
10351         }
10352         if {[info exists idheads($id)]} {
10353             lappend ah $id
10354         }
10355     }
10356     set arctags($a) $at
10357     set archeads($a) $ah
10358 }
10359
10360 proc splitarc {p} {
10361     global arcnos arcids nextarc arctags archeads idtags idheads
10362     global arcstart arcend arcout allparents growing
10363
10364     set a $arcnos($p)
10365     if {[llength $a] != 1} {
10366         puts "oops splitarc called but [llength $a] arcs already"
10367         return
10368     }
10369     set a [lindex $a 0]
10370     set i [lsearch -exact $arcids($a) $p]
10371     if {$i < 0} {
10372         puts "oops splitarc $p not in arc $a"
10373         return
10374     }
10375     set na [incr nextarc]
10376     if {[info exists arcend($a)]} {
10377         set arcend($na) $arcend($a)
10378     } else {
10379         set l [lindex $allparents([lindex $arcids($a) end]) 0]
10380         set j [lsearch -exact $arcnos($l) $a]
10381         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10382     }
10383     set tail [lrange $arcids($a) [expr {$i+1}] end]
10384     set arcids($a) [lrange $arcids($a) 0 $i]
10385     set arcend($a) $p
10386     set arcstart($na) $p
10387     set arcout($p) $na
10388     set arcids($na) $tail
10389     if {[info exists growing($a)]} {
10390         set growing($na) 1
10391         unset growing($a)
10392     }
10393
10394     foreach id $tail {
10395         if {[llength $arcnos($id)] == 1} {
10396             set arcnos($id) $na
10397         } else {
10398             set j [lsearch -exact $arcnos($id) $a]
10399             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10400         }
10401     }
10402
10403     # reconstruct tags and heads lists
10404     if {$arctags($a) ne {} || $archeads($a) ne {}} {
10405         recalcarc $a
10406         recalcarc $na
10407     } else {
10408         set arctags($na) {}
10409         set archeads($na) {}
10410     }
10411 }
10412
10413 # Update things for a new commit added that is a child of one
10414 # existing commit.  Used when cherry-picking.
10415 proc addnewchild {id p} {
10416     global allparents allchildren idtags nextarc
10417     global arcnos arcids arctags arcout arcend arcstart archeads growing
10418     global seeds allcommits
10419
10420     if {![info exists allcommits] || ![info exists arcnos($p)]} return
10421     set allparents($id) [list $p]
10422     set allchildren($id) {}
10423     set arcnos($id) {}
10424     lappend seeds $id
10425     lappend allchildren($p) $id
10426     set a [incr nextarc]
10427     set arcstart($a) $id
10428     set archeads($a) {}
10429     set arctags($a) {}
10430     set arcids($a) [list $p]
10431     set arcend($a) $p
10432     if {![info exists arcout($p)]} {
10433         splitarc $p
10434     }
10435     lappend arcnos($p) $a
10436     set arcout($id) [list $a]
10437 }
10438
10439 # This implements a cache for the topology information.
10440 # The cache saves, for each arc, the start and end of the arc,
10441 # the ids on the arc, and the outgoing arcs from the end.
10442 proc readcache {f} {
10443     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10444     global idtags idheads allparents cachedarcs possible_seeds seeds growing
10445     global allcwait
10446
10447     set a $nextarc
10448     set lim $cachedarcs
10449     if {$lim - $a > 500} {
10450         set lim [expr {$a + 500}]
10451     }
10452     if {[catch {
10453         if {$a == $lim} {
10454             # finish reading the cache and setting up arctags, etc.
10455             set line [gets $f]
10456             if {$line ne "1"} {error "bad final version"}
10457             close $f
10458             foreach id [array names idtags] {
10459                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10460                     [llength $allparents($id)] == 1} {
10461                     set a [lindex $arcnos($id) 0]
10462                     if {$arctags($a) eq {}} {
10463                         recalcarc $a
10464                     }
10465                 }
10466             }
10467             foreach id [array names idheads] {
10468                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10469                     [llength $allparents($id)] == 1} {
10470                     set a [lindex $arcnos($id) 0]
10471                     if {$archeads($a) eq {}} {
10472                         recalcarc $a
10473                     }
10474                 }
10475             }
10476             foreach id [lsort -unique $possible_seeds] {
10477                 if {$arcnos($id) eq {}} {
10478                     lappend seeds $id
10479                 }
10480             }
10481             set allcwait 0
10482         } else {
10483             while {[incr a] <= $lim} {
10484                 set line [gets $f]
10485                 if {[llength $line] != 3} {error "bad line"}
10486                 set s [lindex $line 0]
10487                 set arcstart($a) $s
10488                 lappend arcout($s) $a
10489                 if {![info exists arcnos($s)]} {
10490                     lappend possible_seeds $s
10491                     set arcnos($s) {}
10492                 }
10493                 set e [lindex $line 1]
10494                 if {$e eq {}} {
10495                     set growing($a) 1
10496                 } else {
10497                     set arcend($a) $e
10498                     if {![info exists arcout($e)]} {
10499                         set arcout($e) {}
10500                     }
10501                 }
10502                 set arcids($a) [lindex $line 2]
10503                 foreach id $arcids($a) {
10504                     lappend allparents($s) $id
10505                     set s $id
10506                     lappend arcnos($id) $a
10507                 }
10508                 if {![info exists allparents($s)]} {
10509                     set allparents($s) {}
10510                 }
10511                 set arctags($a) {}
10512                 set archeads($a) {}
10513             }
10514             set nextarc [expr {$a - 1}]
10515         }
10516     } err]} {
10517         dropcache $err
10518         return 0
10519     }
10520     if {!$allcwait} {
10521         getallcommits
10522     }
10523     return $allcwait
10524 }
10525
10526 proc getcache {f} {
10527     global nextarc cachedarcs possible_seeds
10528
10529     if {[catch {
10530         set line [gets $f]
10531         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10532         # make sure it's an integer
10533         set cachedarcs [expr {int([lindex $line 1])}]
10534         if {$cachedarcs < 0} {error "bad number of arcs"}
10535         set nextarc 0
10536         set possible_seeds {}
10537         run readcache $f
10538     } err]} {
10539         dropcache $err
10540     }
10541     return 0
10542 }
10543
10544 proc dropcache {err} {
10545     global allcwait nextarc cachedarcs seeds
10546
10547     #puts "dropping cache ($err)"
10548     foreach v {arcnos arcout arcids arcstart arcend growing \
10549                    arctags archeads allparents allchildren} {
10550         global $v
10551         unset -nocomplain $v
10552     }
10553     set allcwait 0
10554     set nextarc 0
10555     set cachedarcs 0
10556     set seeds {}
10557     getallcommits
10558 }
10559
10560 proc writecache {f} {
10561     global cachearc cachedarcs allccache
10562     global arcstart arcend arcnos arcids arcout
10563
10564     set a $cachearc
10565     set lim $cachedarcs
10566     if {$lim - $a > 1000} {
10567         set lim [expr {$a + 1000}]
10568     }
10569     if {[catch {
10570         while {[incr a] <= $lim} {
10571             if {[info exists arcend($a)]} {
10572                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10573             } else {
10574                 puts $f [list $arcstart($a) {} $arcids($a)]
10575             }
10576         }
10577     } err]} {
10578         catch {close $f}
10579         catch {file delete $allccache}
10580         #puts "writing cache failed ($err)"
10581         return 0
10582     }
10583     set cachearc [expr {$a - 1}]
10584     if {$a > $cachedarcs} {
10585         puts $f "1"
10586         close $f
10587         return 0
10588     }
10589     return 1
10590 }
10591
10592 proc savecache {} {
10593     global nextarc cachedarcs cachearc allccache
10594
10595     if {$nextarc == $cachedarcs} return
10596     set cachearc 0
10597     set cachedarcs $nextarc
10598     catch {
10599         set f [open $allccache w]
10600         puts $f [list 1 $cachedarcs]
10601         run writecache $f
10602     }
10603 }
10604
10605 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10606 # or 0 if neither is true.
10607 proc anc_or_desc {a b} {
10608     global arcout arcstart arcend arcnos cached_isanc
10609
10610     if {$arcnos($a) eq $arcnos($b)} {
10611         # Both are on the same arc(s); either both are the same BMP,
10612         # or if one is not a BMP, the other is also not a BMP or is
10613         # the BMP at end of the arc (and it only has 1 incoming arc).
10614         # Or both can be BMPs with no incoming arcs.
10615         if {$a eq $b || $arcnos($a) eq {}} {
10616             return 0
10617         }
10618         # assert {[llength $arcnos($a)] == 1}
10619         set arc [lindex $arcnos($a) 0]
10620         set i [lsearch -exact $arcids($arc) $a]
10621         set j [lsearch -exact $arcids($arc) $b]
10622         if {$i < 0 || $i > $j} {
10623             return 1
10624         } else {
10625             return -1
10626         }
10627     }
10628
10629     if {![info exists arcout($a)]} {
10630         set arc [lindex $arcnos($a) 0]
10631         if {[info exists arcend($arc)]} {
10632             set aend $arcend($arc)
10633         } else {
10634             set aend {}
10635         }
10636         set a $arcstart($arc)
10637     } else {
10638         set aend $a
10639     }
10640     if {![info exists arcout($b)]} {
10641         set arc [lindex $arcnos($b) 0]
10642         if {[info exists arcend($arc)]} {
10643             set bend $arcend($arc)
10644         } else {
10645             set bend {}
10646         }
10647         set b $arcstart($arc)
10648     } else {
10649         set bend $b
10650     }
10651     if {$a eq $bend} {
10652         return 1
10653     }
10654     if {$b eq $aend} {
10655         return -1
10656     }
10657     if {[info exists cached_isanc($a,$bend)]} {
10658         if {$cached_isanc($a,$bend)} {
10659             return 1
10660         }
10661     }
10662     if {[info exists cached_isanc($b,$aend)]} {
10663         if {$cached_isanc($b,$aend)} {
10664             return -1
10665         }
10666         if {[info exists cached_isanc($a,$bend)]} {
10667             return 0
10668         }
10669     }
10670
10671     set todo [list $a $b]
10672     set anc($a) a
10673     set anc($b) b
10674     for {set i 0} {$i < [llength $todo]} {incr i} {
10675         set x [lindex $todo $i]
10676         if {$anc($x) eq {}} {
10677             continue
10678         }
10679         foreach arc $arcnos($x) {
10680             set xd $arcstart($arc)
10681             if {$xd eq $bend} {
10682                 set cached_isanc($a,$bend) 1
10683                 set cached_isanc($b,$aend) 0
10684                 return 1
10685             } elseif {$xd eq $aend} {
10686                 set cached_isanc($b,$aend) 1
10687                 set cached_isanc($a,$bend) 0
10688                 return -1
10689             }
10690             if {![info exists anc($xd)]} {
10691                 set anc($xd) $anc($x)
10692                 lappend todo $xd
10693             } elseif {$anc($xd) ne $anc($x)} {
10694                 set anc($xd) {}
10695             }
10696         }
10697     }
10698     set cached_isanc($a,$bend) 0
10699     set cached_isanc($b,$aend) 0
10700     return 0
10701 }
10702
10703 # This identifies whether $desc has an ancestor that is
10704 # a growing tip of the graph and which is not an ancestor of $anc
10705 # and returns 0 if so and 1 if not.
10706 # If we subsequently discover a tag on such a growing tip, and that
10707 # turns out to be a descendent of $anc (which it could, since we
10708 # don't necessarily see children before parents), then $desc
10709 # isn't a good choice to display as a descendent tag of
10710 # $anc (since it is the descendent of another tag which is
10711 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10712 # display as a ancestor tag of $desc.
10713 #
10714 proc is_certain {desc anc} {
10715     global arcnos arcout arcstart arcend growing problems
10716
10717     set certain {}
10718     if {[llength $arcnos($anc)] == 1} {
10719         # tags on the same arc are certain
10720         if {$arcnos($desc) eq $arcnos($anc)} {
10721             return 1
10722         }
10723         if {![info exists arcout($anc)]} {
10724             # if $anc is partway along an arc, use the start of the arc instead
10725             set a [lindex $arcnos($anc) 0]
10726             set anc $arcstart($a)
10727         }
10728     }
10729     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10730         set x $desc
10731     } else {
10732         set a [lindex $arcnos($desc) 0]
10733         set x $arcend($a)
10734     }
10735     if {$x == $anc} {
10736         return 1
10737     }
10738     set anclist [list $x]
10739     set dl($x) 1
10740     set nnh 1
10741     set ngrowanc 0
10742     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10743         set x [lindex $anclist $i]
10744         if {$dl($x)} {
10745             incr nnh -1
10746         }
10747         set done($x) 1
10748         foreach a $arcout($x) {
10749             if {[info exists growing($a)]} {
10750                 if {![info exists growanc($x)] && $dl($x)} {
10751                     set growanc($x) 1
10752                     incr ngrowanc
10753                 }
10754             } else {
10755                 set y $arcend($a)
10756                 if {[info exists dl($y)]} {
10757                     if {$dl($y)} {
10758                         if {!$dl($x)} {
10759                             set dl($y) 0
10760                             if {![info exists done($y)]} {
10761                                 incr nnh -1
10762                             }
10763                             if {[info exists growanc($x)]} {
10764                                 incr ngrowanc -1
10765                             }
10766                             set xl [list $y]
10767                             for {set k 0} {$k < [llength $xl]} {incr k} {
10768                                 set z [lindex $xl $k]
10769                                 foreach c $arcout($z) {
10770                                     if {[info exists arcend($c)]} {
10771                                         set v $arcend($c)
10772                                         if {[info exists dl($v)] && $dl($v)} {
10773                                             set dl($v) 0
10774                                             if {![info exists done($v)]} {
10775                                                 incr nnh -1
10776                                             }
10777                                             if {[info exists growanc($v)]} {
10778                                                 incr ngrowanc -1
10779                                             }
10780                                             lappend xl $v
10781                                         }
10782                                     }
10783                                 }
10784                             }
10785                         }
10786                     }
10787                 } elseif {$y eq $anc || !$dl($x)} {
10788                     set dl($y) 0
10789                     lappend anclist $y
10790                 } else {
10791                     set dl($y) 1
10792                     lappend anclist $y
10793                     incr nnh
10794                 }
10795             }
10796         }
10797     }
10798     foreach x [array names growanc] {
10799         if {$dl($x)} {
10800             return 0
10801         }
10802         return 0
10803     }
10804     return 1
10805 }
10806
10807 proc validate_arctags {a} {
10808     global arctags idtags
10809
10810     set i -1
10811     set na $arctags($a)
10812     foreach id $arctags($a) {
10813         incr i
10814         if {![info exists idtags($id)]} {
10815             set na [lreplace $na $i $i]
10816             incr i -1
10817         }
10818     }
10819     set arctags($a) $na
10820 }
10821
10822 proc validate_archeads {a} {
10823     global archeads idheads
10824
10825     set i -1
10826     set na $archeads($a)
10827     foreach id $archeads($a) {
10828         incr i
10829         if {![info exists idheads($id)]} {
10830             set na [lreplace $na $i $i]
10831             incr i -1
10832         }
10833     }
10834     set archeads($a) $na
10835 }
10836
10837 # Return the list of IDs that have tags that are descendents of id,
10838 # ignoring IDs that are descendents of IDs already reported.
10839 proc desctags {id} {
10840     global arcnos arcstart arcids arctags idtags allparents
10841     global growing cached_dtags
10842
10843     if {![info exists allparents($id)]} {
10844         return {}
10845     }
10846     set t1 [clock clicks -milliseconds]
10847     set argid $id
10848     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10849         # part-way along an arc; check that arc first
10850         set a [lindex $arcnos($id) 0]
10851         if {$arctags($a) ne {}} {
10852             validate_arctags $a
10853             set i [lsearch -exact $arcids($a) $id]
10854             set tid {}
10855             foreach t $arctags($a) {
10856                 set j [lsearch -exact $arcids($a) $t]
10857                 if {$j >= $i} break
10858                 set tid $t
10859             }
10860             if {$tid ne {}} {
10861                 return $tid
10862             }
10863         }
10864         set id $arcstart($a)
10865         if {[info exists idtags($id)]} {
10866             return $id
10867         }
10868     }
10869     if {[info exists cached_dtags($id)]} {
10870         return $cached_dtags($id)
10871     }
10872
10873     set origid $id
10874     set todo [list $id]
10875     set queued($id) 1
10876     set nc 1
10877     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10878         set id [lindex $todo $i]
10879         set done($id) 1
10880         set ta [info exists hastaggedancestor($id)]
10881         if {!$ta} {
10882             incr nc -1
10883         }
10884         # ignore tags on starting node
10885         if {!$ta && $i > 0} {
10886             if {[info exists idtags($id)]} {
10887                 set tagloc($id) $id
10888                 set ta 1
10889             } elseif {[info exists cached_dtags($id)]} {
10890                 set tagloc($id) $cached_dtags($id)
10891                 set ta 1
10892             }
10893         }
10894         foreach a $arcnos($id) {
10895             set d $arcstart($a)
10896             if {!$ta && $arctags($a) ne {}} {
10897                 validate_arctags $a
10898                 if {$arctags($a) ne {}} {
10899                     lappend tagloc($id) [lindex $arctags($a) end]
10900                 }
10901             }
10902             if {$ta || $arctags($a) ne {}} {
10903                 set tomark [list $d]
10904                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10905                     set dd [lindex $tomark $j]
10906                     if {![info exists hastaggedancestor($dd)]} {
10907                         if {[info exists done($dd)]} {
10908                             foreach b $arcnos($dd) {
10909                                 lappend tomark $arcstart($b)
10910                             }
10911                             if {[info exists tagloc($dd)]} {
10912                                 unset tagloc($dd)
10913                             }
10914                         } elseif {[info exists queued($dd)]} {
10915                             incr nc -1
10916                         }
10917                         set hastaggedancestor($dd) 1
10918                     }
10919                 }
10920             }
10921             if {![info exists queued($d)]} {
10922                 lappend todo $d
10923                 set queued($d) 1
10924                 if {![info exists hastaggedancestor($d)]} {
10925                     incr nc
10926                 }
10927             }
10928         }
10929     }
10930     set tags {}
10931     foreach id [array names tagloc] {
10932         if {![info exists hastaggedancestor($id)]} {
10933             foreach t $tagloc($id) {
10934                 if {[lsearch -exact $tags $t] < 0} {
10935                     lappend tags $t
10936                 }
10937             }
10938         }
10939     }
10940     set t2 [clock clicks -milliseconds]
10941     set loopix $i
10942
10943     # remove tags that are descendents of other tags
10944     for {set i 0} {$i < [llength $tags]} {incr i} {
10945         set a [lindex $tags $i]
10946         for {set j 0} {$j < $i} {incr j} {
10947             set b [lindex $tags $j]
10948             set r [anc_or_desc $a $b]
10949             if {$r == 1} {
10950                 set tags [lreplace $tags $j $j]
10951                 incr j -1
10952                 incr i -1
10953             } elseif {$r == -1} {
10954                 set tags [lreplace $tags $i $i]
10955                 incr i -1
10956                 break
10957             }
10958         }
10959     }
10960
10961     if {[array names growing] ne {}} {
10962         # graph isn't finished, need to check if any tag could get
10963         # eclipsed by another tag coming later.  Simply ignore any
10964         # tags that could later get eclipsed.
10965         set ctags {}
10966         foreach t $tags {
10967             if {[is_certain $t $origid]} {
10968                 lappend ctags $t
10969             }
10970         }
10971         if {$tags eq $ctags} {
10972             set cached_dtags($origid) $tags
10973         } else {
10974             set tags $ctags
10975         }
10976     } else {
10977         set cached_dtags($origid) $tags
10978     }
10979     set t3 [clock clicks -milliseconds]
10980     if {0 && $t3 - $t1 >= 100} {
10981         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10982             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10983     }
10984     return $tags
10985 }
10986
10987 proc anctags {id} {
10988     global arcnos arcids arcout arcend arctags idtags allparents
10989     global growing cached_atags
10990
10991     if {![info exists allparents($id)]} {
10992         return {}
10993     }
10994     set t1 [clock clicks -milliseconds]
10995     set argid $id
10996     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10997         # part-way along an arc; check that arc first
10998         set a [lindex $arcnos($id) 0]
10999         if {$arctags($a) ne {}} {
11000             validate_arctags $a
11001             set i [lsearch -exact $arcids($a) $id]
11002             foreach t $arctags($a) {
11003                 set j [lsearch -exact $arcids($a) $t]
11004                 if {$j > $i} {
11005                     return $t
11006                 }
11007             }
11008         }
11009         if {![info exists arcend($a)]} {
11010             return {}
11011         }
11012         set id $arcend($a)
11013         if {[info exists idtags($id)]} {
11014             return $id
11015         }
11016     }
11017     if {[info exists cached_atags($id)]} {
11018         return $cached_atags($id)
11019     }
11020
11021     set origid $id
11022     set todo [list $id]
11023     set queued($id) 1
11024     set taglist {}
11025     set nc 1
11026     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
11027         set id [lindex $todo $i]
11028         set done($id) 1
11029         set td [info exists hastaggeddescendent($id)]
11030         if {!$td} {
11031             incr nc -1
11032         }
11033         # ignore tags on starting node
11034         if {!$td && $i > 0} {
11035             if {[info exists idtags($id)]} {
11036                 set tagloc($id) $id
11037                 set td 1
11038             } elseif {[info exists cached_atags($id)]} {
11039                 set tagloc($id) $cached_atags($id)
11040                 set td 1
11041             }
11042         }
11043         foreach a $arcout($id) {
11044             if {!$td && $arctags($a) ne {}} {
11045                 validate_arctags $a
11046                 if {$arctags($a) ne {}} {
11047                     lappend tagloc($id) [lindex $arctags($a) 0]
11048                 }
11049             }
11050             if {![info exists arcend($a)]} continue
11051             set d $arcend($a)
11052             if {$td || $arctags($a) ne {}} {
11053                 set tomark [list $d]
11054                 for {set j 0} {$j < [llength $tomark]} {incr j} {
11055                     set dd [lindex $tomark $j]
11056                     if {![info exists hastaggeddescendent($dd)]} {
11057                         if {[info exists done($dd)]} {
11058                             foreach b $arcout($dd) {
11059                                 if {[info exists arcend($b)]} {
11060                                     lappend tomark $arcend($b)
11061                                 }
11062                             }
11063                             if {[info exists tagloc($dd)]} {
11064                                 unset tagloc($dd)
11065                             }
11066                         } elseif {[info exists queued($dd)]} {
11067                             incr nc -1
11068                         }
11069                         set hastaggeddescendent($dd) 1
11070                     }
11071                 }
11072             }
11073             if {![info exists queued($d)]} {
11074                 lappend todo $d
11075                 set queued($d) 1
11076                 if {![info exists hastaggeddescendent($d)]} {
11077                     incr nc
11078                 }
11079             }
11080         }
11081     }
11082     set t2 [clock clicks -milliseconds]
11083     set loopix $i
11084     set tags {}
11085     foreach id [array names tagloc] {
11086         if {![info exists hastaggeddescendent($id)]} {
11087             foreach t $tagloc($id) {
11088                 if {[lsearch -exact $tags $t] < 0} {
11089                     lappend tags $t
11090                 }
11091             }
11092         }
11093     }
11094
11095     # remove tags that are ancestors of other tags
11096     for {set i 0} {$i < [llength $tags]} {incr i} {
11097         set a [lindex $tags $i]
11098         for {set j 0} {$j < $i} {incr j} {
11099             set b [lindex $tags $j]
11100             set r [anc_or_desc $a $b]
11101             if {$r == -1} {
11102                 set tags [lreplace $tags $j $j]
11103                 incr j -1
11104                 incr i -1
11105             } elseif {$r == 1} {
11106                 set tags [lreplace $tags $i $i]
11107                 incr i -1
11108                 break
11109             }
11110         }
11111     }
11112
11113     if {[array names growing] ne {}} {
11114         # graph isn't finished, need to check if any tag could get
11115         # eclipsed by another tag coming later.  Simply ignore any
11116         # tags that could later get eclipsed.
11117         set ctags {}
11118         foreach t $tags {
11119             if {[is_certain $origid $t]} {
11120                 lappend ctags $t
11121             }
11122         }
11123         if {$tags eq $ctags} {
11124             set cached_atags($origid) $tags
11125         } else {
11126             set tags $ctags
11127         }
11128     } else {
11129         set cached_atags($origid) $tags
11130     }
11131     set t3 [clock clicks -milliseconds]
11132     if {0 && $t3 - $t1 >= 100} {
11133         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11134             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11135     }
11136     return $tags
11137 }
11138
11139 # Return the list of IDs that have heads that are descendents of id,
11140 # including id itself if it has a head.
11141 proc descheads {id} {
11142     global arcnos arcstart arcids archeads idheads cached_dheads
11143     global allparents arcout
11144
11145     if {![info exists allparents($id)]} {
11146         return {}
11147     }
11148     set aret {}
11149     if {![info exists arcout($id)]} {
11150         # part-way along an arc; check it first
11151         set a [lindex $arcnos($id) 0]
11152         if {$archeads($a) ne {}} {
11153             validate_archeads $a
11154             set i [lsearch -exact $arcids($a) $id]
11155             foreach t $archeads($a) {
11156                 set j [lsearch -exact $arcids($a) $t]
11157                 if {$j > $i} break
11158                 lappend aret $t
11159             }
11160         }
11161         set id $arcstart($a)
11162     }
11163     set origid $id
11164     set todo [list $id]
11165     set seen($id) 1
11166     set ret {}
11167     for {set i 0} {$i < [llength $todo]} {incr i} {
11168         set id [lindex $todo $i]
11169         if {[info exists cached_dheads($id)]} {
11170             set ret [concat $ret $cached_dheads($id)]
11171         } else {
11172             if {[info exists idheads($id)]} {
11173                 lappend ret $id
11174             }
11175             foreach a $arcnos($id) {
11176                 if {$archeads($a) ne {}} {
11177                     validate_archeads $a
11178                     if {$archeads($a) ne {}} {
11179                         set ret [concat $ret $archeads($a)]
11180                     }
11181                 }
11182                 set d $arcstart($a)
11183                 if {![info exists seen($d)]} {
11184                     lappend todo $d
11185                     set seen($d) 1
11186                 }
11187             }
11188         }
11189     }
11190     set ret [lsort -unique $ret]
11191     set cached_dheads($origid) $ret
11192     return [concat $ret $aret]
11193 }
11194
11195 proc addedtag {id} {
11196     global arcnos arcout cached_dtags cached_atags
11197
11198     if {![info exists arcnos($id)]} return
11199     if {![info exists arcout($id)]} {
11200         recalcarc [lindex $arcnos($id) 0]
11201     }
11202     unset -nocomplain cached_dtags
11203     unset -nocomplain cached_atags
11204 }
11205
11206 proc addedhead {hid head} {
11207     global arcnos arcout cached_dheads
11208
11209     if {![info exists arcnos($hid)]} return
11210     if {![info exists arcout($hid)]} {
11211         recalcarc [lindex $arcnos($hid) 0]
11212     }
11213     unset -nocomplain cached_dheads
11214 }
11215
11216 proc removedhead {hid head} {
11217     global cached_dheads
11218
11219     unset -nocomplain cached_dheads
11220 }
11221
11222 proc movedhead {hid head} {
11223     global arcnos arcout cached_dheads
11224
11225     if {![info exists arcnos($hid)]} return
11226     if {![info exists arcout($hid)]} {
11227         recalcarc [lindex $arcnos($hid) 0]
11228     }
11229     unset -nocomplain cached_dheads
11230 }
11231
11232 proc changedrefs {} {
11233     global cached_dheads cached_dtags cached_atags cached_tagcontent
11234     global arctags archeads arcnos arcout idheads idtags
11235
11236     foreach id [concat [array names idheads] [array names idtags]] {
11237         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11238             set a [lindex $arcnos($id) 0]
11239             if {![info exists donearc($a)]} {
11240                 recalcarc $a
11241                 set donearc($a) 1
11242             }
11243         }
11244     }
11245     unset -nocomplain cached_tagcontent
11246     unset -nocomplain cached_dtags
11247     unset -nocomplain cached_atags
11248     unset -nocomplain cached_dheads
11249 }
11250
11251 proc rereadrefs {} {
11252     global idtags idheads idotherrefs mainheadid
11253
11254     set refids [concat [array names idtags] \
11255                     [array names idheads] [array names idotherrefs]]
11256     foreach id $refids {
11257         if {![info exists ref($id)]} {
11258             set ref($id) [listrefs $id]
11259         }
11260     }
11261     set oldmainhead $mainheadid
11262     readrefs
11263     changedrefs
11264     set refids [lsort -unique [concat $refids [array names idtags] \
11265                         [array names idheads] [array names idotherrefs]]]
11266     foreach id $refids {
11267         set v [listrefs $id]
11268         if {![info exists ref($id)] || $ref($id) != $v} {
11269             redrawtags $id
11270         }
11271     }
11272     if {$oldmainhead ne $mainheadid} {
11273         redrawtags $oldmainhead
11274         redrawtags $mainheadid
11275     }
11276     run refill_reflist
11277 }
11278
11279 proc listrefs {id} {
11280     global idtags idheads idotherrefs
11281
11282     set x {}
11283     if {[info exists idtags($id)]} {
11284         set x $idtags($id)
11285     }
11286     set y {}
11287     if {[info exists idheads($id)]} {
11288         set y $idheads($id)
11289     }
11290     set z {}
11291     if {[info exists idotherrefs($id)]} {
11292         set z $idotherrefs($id)
11293     }
11294     return [list $x $y $z]
11295 }
11296
11297 proc add_tag_ctext {tag} {
11298     global ctext cached_tagcontent tagids
11299
11300     if {![info exists cached_tagcontent($tag)]} {
11301         catch {
11302             set cached_tagcontent($tag) [exec git cat-file -p $tag]
11303         }
11304     }
11305     $ctext insert end "[mc "Tag"]: $tag\n" bold
11306     if {[info exists cached_tagcontent($tag)]} {
11307         set text $cached_tagcontent($tag)
11308     } else {
11309         set text "[mc "Id"]:  $tagids($tag)"
11310     }
11311     appendwithlinks $text {}
11312 }
11313
11314 proc showtag {tag isnew} {
11315     global ctext cached_tagcontent tagids linknum tagobjid
11316
11317     if {$isnew} {
11318         addtohistory [list showtag $tag 0] savectextpos
11319     }
11320     $ctext conf -state normal
11321     clear_ctext
11322     settabs 0
11323     set linknum 0
11324     add_tag_ctext $tag
11325     maybe_scroll_ctext 1
11326     $ctext conf -state disabled
11327     init_flist {}
11328 }
11329
11330 proc showtags {id isnew} {
11331     global idtags ctext linknum
11332
11333     if {$isnew} {
11334         addtohistory [list showtags $id 0] savectextpos
11335     }
11336     $ctext conf -state normal
11337     clear_ctext
11338     settabs 0
11339     set linknum 0
11340     set sep {}
11341     foreach tag $idtags($id) {
11342         $ctext insert end $sep
11343         add_tag_ctext $tag
11344         set sep "\n\n"
11345     }
11346     maybe_scroll_ctext 1
11347     $ctext conf -state disabled
11348     init_flist {}
11349 }
11350
11351 proc doquit {} {
11352     global stopped
11353     global gitktmpdir
11354
11355     set stopped 100
11356     savestuff .
11357     destroy .
11358
11359     if {[info exists gitktmpdir]} {
11360         catch {file delete -force $gitktmpdir}
11361     }
11362 }
11363
11364 proc mkfontdisp {font top which} {
11365     global fontattr fontpref $font NS use_ttk
11366
11367     set fontpref($font) [set $font]
11368     ${NS}::button $top.${font}but -text $which \
11369         -command [list choosefont $font $which]
11370     ${NS}::label $top.$font -relief flat -font $font \
11371         -text $fontattr($font,family) -justify left
11372     grid x $top.${font}but $top.$font -sticky w
11373 }
11374
11375 proc choosefont {font which} {
11376     global fontparam fontlist fonttop fontattr
11377     global prefstop NS
11378
11379     set fontparam(which) $which
11380     set fontparam(font) $font
11381     set fontparam(family) [font actual $font -family]
11382     set fontparam(size) $fontattr($font,size)
11383     set fontparam(weight) $fontattr($font,weight)
11384     set fontparam(slant) $fontattr($font,slant)
11385     set top .gitkfont
11386     set fonttop $top
11387     if {![winfo exists $top]} {
11388         font create sample
11389         eval font config sample [font actual $font]
11390         ttk_toplevel $top
11391         make_transient $top $prefstop
11392         wm title $top [mc "Gitk font chooser"]
11393         ${NS}::label $top.l -textvariable fontparam(which)
11394         pack $top.l -side top
11395         set fontlist [lsort [font families]]
11396         ${NS}::frame $top.f
11397         listbox $top.f.fam -listvariable fontlist \
11398             -yscrollcommand [list $top.f.sb set]
11399         bind $top.f.fam <<ListboxSelect>> selfontfam
11400         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11401         pack $top.f.sb -side right -fill y
11402         pack $top.f.fam -side left -fill both -expand 1
11403         pack $top.f -side top -fill both -expand 1
11404         ${NS}::frame $top.g
11405         spinbox $top.g.size -from 4 -to 40 -width 4 \
11406             -textvariable fontparam(size) \
11407             -validatecommand {string is integer -strict %s}
11408         checkbutton $top.g.bold -padx 5 \
11409             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11410             -variable fontparam(weight) -onvalue bold -offvalue normal
11411         checkbutton $top.g.ital -padx 5 \
11412             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11413             -variable fontparam(slant) -onvalue italic -offvalue roman
11414         pack $top.g.size $top.g.bold $top.g.ital -side left
11415         pack $top.g -side top
11416         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11417             -background white
11418         $top.c create text 100 25 -anchor center -text $which -font sample \
11419             -fill black -tags text
11420         bind $top.c <Configure> [list centertext $top.c]
11421         pack $top.c -side top -fill x
11422         ${NS}::frame $top.buts
11423         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11424         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11425         bind $top <Key-Return> fontok
11426         bind $top <Key-Escape> fontcan
11427         grid $top.buts.ok $top.buts.can
11428         grid columnconfigure $top.buts 0 -weight 1 -uniform a
11429         grid columnconfigure $top.buts 1 -weight 1 -uniform a
11430         pack $top.buts -side bottom -fill x
11431         trace add variable fontparam write chg_fontparam
11432     } else {
11433         raise $top
11434         $top.c itemconf text -text $which
11435     }
11436     set i [lsearch -exact $fontlist $fontparam(family)]
11437     if {$i >= 0} {
11438         $top.f.fam selection set $i
11439         $top.f.fam see $i
11440     }
11441 }
11442
11443 proc centertext {w} {
11444     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11445 }
11446
11447 proc fontok {} {
11448     global fontparam fontpref prefstop
11449
11450     set f $fontparam(font)
11451     set fontpref($f) [list $fontparam(family) $fontparam(size)]
11452     if {$fontparam(weight) eq "bold"} {
11453         lappend fontpref($f) "bold"
11454     }
11455     if {$fontparam(slant) eq "italic"} {
11456         lappend fontpref($f) "italic"
11457     }
11458     set w $prefstop.notebook.fonts.$f
11459     $w conf -text $fontparam(family) -font $fontpref($f)
11460
11461     fontcan
11462 }
11463
11464 proc fontcan {} {
11465     global fonttop fontparam
11466
11467     if {[info exists fonttop]} {
11468         catch {destroy $fonttop}
11469         catch {font delete sample}
11470         unset fonttop
11471         unset fontparam
11472     }
11473 }
11474
11475 if {[package vsatisfies [package provide Tk] 8.6]} {
11476     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11477     # function to make use of it.
11478     proc choosefont {font which} {
11479         tk fontchooser configure -title $which -font $font \
11480             -command [list on_choosefont $font $which]
11481         tk fontchooser show
11482     }
11483     proc on_choosefont {font which newfont} {
11484         global fontparam
11485         puts stderr "$font $newfont"
11486         array set f [font actual $newfont]
11487         set fontparam(which) $which
11488         set fontparam(font) $font
11489         set fontparam(family) $f(-family)
11490         set fontparam(size) $f(-size)
11491         set fontparam(weight) $f(-weight)
11492         set fontparam(slant) $f(-slant)
11493         fontok
11494     }
11495 }
11496
11497 proc selfontfam {} {
11498     global fonttop fontparam
11499
11500     set i [$fonttop.f.fam curselection]
11501     if {$i ne {}} {
11502         set fontparam(family) [$fonttop.f.fam get $i]
11503     }
11504 }
11505
11506 proc chg_fontparam {v sub op} {
11507     global fontparam
11508
11509     font config sample -$sub $fontparam($sub)
11510 }
11511
11512 # Create a property sheet tab page
11513 proc create_prefs_page {w} {
11514     global NS
11515     set parent [join [lrange [split $w .] 0 end-1] .]
11516     if {[winfo class $parent] eq "TNotebook"} {
11517         ${NS}::frame $w
11518     } else {
11519         ${NS}::labelframe $w
11520     }
11521 }
11522
11523 proc prefspage_general {notebook} {
11524     global NS maxwidth maxgraphpct showneartags showlocalchanges
11525     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11526     global hideremotes want_ttk have_ttk maxrefs web_browser
11527
11528     set page [create_prefs_page $notebook.general]
11529
11530     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11531     grid $page.ldisp - -sticky w -pady 10
11532     ${NS}::label $page.spacer -text " "
11533     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11534     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11535     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11536                                          #xgettext:no-tcl-format
11537     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11538     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11539     grid x $page.maxpctl $page.maxpct -sticky w
11540     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11541         -variable showlocalchanges
11542     grid x $page.showlocal -sticky w
11543     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11544         -variable autoselect
11545     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11546     grid x $page.autoselect $page.autosellen -sticky w
11547     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11548         -variable hideremotes
11549     grid x $page.hideremotes -sticky w
11550
11551     ${NS}::label $page.ddisp -text [mc "Diff display options"]
11552     grid $page.ddisp - -sticky w -pady 10
11553     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11554     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11555     grid x $page.tabstopl $page.tabstop -sticky w
11556     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11557         -variable showneartags
11558     grid x $page.ntag -sticky w
11559     ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11560     spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11561     grid x $page.maxrefsl $page.maxrefs -sticky w
11562     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11563         -variable limitdiffs
11564     grid x $page.ldiff -sticky w
11565     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11566         -variable perfile_attrs
11567     grid x $page.lattr -sticky w
11568
11569     ${NS}::entry $page.extdifft -textvariable extdifftool
11570     ${NS}::frame $page.extdifff
11571     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11572     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11573     pack $page.extdifff.l $page.extdifff.b -side left
11574     pack configure $page.extdifff.l -padx 10
11575     grid x $page.extdifff $page.extdifft -sticky ew
11576
11577     ${NS}::entry $page.webbrowser -textvariable web_browser
11578     ${NS}::frame $page.webbrowserf
11579     ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
11580     pack $page.webbrowserf.l -side left
11581     pack configure $page.webbrowserf.l -padx 10
11582     grid x $page.webbrowserf $page.webbrowser -sticky ew
11583
11584     ${NS}::label $page.lgen -text [mc "General options"]
11585     grid $page.lgen - -sticky w -pady 10
11586     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11587         -text [mc "Use themed widgets"]
11588     if {$have_ttk} {
11589         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11590     } else {
11591         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11592     }
11593     grid x $page.want_ttk $page.ttk_note -sticky w
11594     return $page
11595 }
11596
11597 proc prefspage_colors {notebook} {
11598     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11599
11600     set page [create_prefs_page $notebook.colors]
11601
11602     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11603     grid $page.cdisp - -sticky w -pady 10
11604     label $page.ui -padx 40 -relief sunk -background $uicolor
11605     ${NS}::button $page.uibut -text [mc "Interface"] \
11606        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11607     grid x $page.uibut $page.ui -sticky w
11608     label $page.bg -padx 40 -relief sunk -background $bgcolor
11609     ${NS}::button $page.bgbut -text [mc "Background"] \
11610         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11611     grid x $page.bgbut $page.bg -sticky w
11612     label $page.fg -padx 40 -relief sunk -background $fgcolor
11613     ${NS}::button $page.fgbut -text [mc "Foreground"] \
11614         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11615     grid x $page.fgbut $page.fg -sticky w
11616     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11617     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11618         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11619                       [list $ctext tag conf d0 -foreground]]
11620     grid x $page.diffoldbut $page.diffold -sticky w
11621     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11622     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11623         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11624                       [list $ctext tag conf dresult -foreground]]
11625     grid x $page.diffnewbut $page.diffnew -sticky w
11626     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11627     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11628         -command [list choosecolor diffcolors 2 $page.hunksep \
11629                       [mc "diff hunk header"] \
11630                       [list $ctext tag conf hunksep -foreground]]
11631     grid x $page.hunksepbut $page.hunksep -sticky w
11632     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11633     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11634         -command [list choosecolor markbgcolor {} $page.markbgsep \
11635                       [mc "marked line background"] \
11636                       [list $ctext tag conf omark -background]]
11637     grid x $page.markbgbut $page.markbgsep -sticky w
11638     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11639     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11640         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11641     grid x $page.selbgbut $page.selbgsep -sticky w
11642     return $page
11643 }
11644
11645 proc prefspage_fonts {notebook} {
11646     global NS
11647     set page [create_prefs_page $notebook.fonts]
11648     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11649     grid $page.cfont - -sticky w -pady 10
11650     mkfontdisp mainfont $page [mc "Main font"]
11651     mkfontdisp textfont $page [mc "Diff display font"]
11652     mkfontdisp uifont $page [mc "User interface font"]
11653     return $page
11654 }
11655
11656 proc doprefs {} {
11657     global maxwidth maxgraphpct use_ttk NS
11658     global oldprefs prefstop showneartags showlocalchanges
11659     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11660     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11661     global hideremotes want_ttk have_ttk
11662
11663     set top .gitkprefs
11664     set prefstop $top
11665     if {[winfo exists $top]} {
11666         raise $top
11667         return
11668     }
11669     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11670                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11671         set oldprefs($v) [set $v]
11672     }
11673     ttk_toplevel $top
11674     wm title $top [mc "Gitk preferences"]
11675     make_transient $top .
11676
11677     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11678         set notebook [ttk::notebook $top.notebook]
11679     } else {
11680         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11681     }
11682
11683     lappend pages [prefspage_general $notebook] [mc "General"]
11684     lappend pages [prefspage_colors $notebook] [mc "Colors"]
11685     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11686     set col 0
11687     foreach {page title} $pages {
11688         if {$use_notebook} {
11689             $notebook add $page -text $title
11690         } else {
11691             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11692                          -text $title -command [list raise $page]]
11693             $page configure -text $title
11694             grid $btn -row 0 -column [incr col] -sticky w
11695             grid $page -row 1 -column 0 -sticky news -columnspan 100
11696         }
11697     }
11698
11699     if {!$use_notebook} {
11700         grid columnconfigure $notebook 0 -weight 1
11701         grid rowconfigure $notebook 1 -weight 1
11702         raise [lindex $pages 0]
11703     }
11704
11705     grid $notebook -sticky news -padx 2 -pady 2
11706     grid rowconfigure $top 0 -weight 1
11707     grid columnconfigure $top 0 -weight 1
11708
11709     ${NS}::frame $top.buts
11710     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11711     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11712     bind $top <Key-Return> prefsok
11713     bind $top <Key-Escape> prefscan
11714     grid $top.buts.ok $top.buts.can
11715     grid columnconfigure $top.buts 0 -weight 1 -uniform a
11716     grid columnconfigure $top.buts 1 -weight 1 -uniform a
11717     grid $top.buts - - -pady 10 -sticky ew
11718     grid columnconfigure $top 2 -weight 1
11719     bind $top <Visibility> [list focus $top.buts.ok]
11720 }
11721
11722 proc choose_extdiff {} {
11723     global extdifftool
11724
11725     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11726     if {$prog ne {}} {
11727         set extdifftool $prog
11728     }
11729 }
11730
11731 proc choosecolor {v vi w x cmd} {
11732     global $v
11733
11734     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11735                -title [mc "Gitk: choose color for %s" $x]]
11736     if {$c eq {}} return
11737     $w conf -background $c
11738     lset $v $vi $c
11739     eval $cmd $c
11740 }
11741
11742 proc setselbg {c} {
11743     global bglist cflist
11744     foreach w $bglist {
11745         if {[winfo exists $w]} {
11746             $w configure -selectbackground $c
11747         }
11748     }
11749     $cflist tag configure highlight \
11750         -background [$cflist cget -selectbackground]
11751     allcanvs itemconf secsel -fill $c
11752 }
11753
11754 # This sets the background color and the color scheme for the whole UI.
11755 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11756 # if we don't specify one ourselves, which makes the checkbuttons and
11757 # radiobuttons look bad.  This chooses white for selectColor if the
11758 # background color is light, or black if it is dark.
11759 proc setui {c} {
11760     if {[tk windowingsystem] eq "win32"} { return }
11761     set bg [winfo rgb . $c]
11762     set selc black
11763     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11764         set selc white
11765     }
11766     tk_setPalette background $c selectColor $selc
11767 }
11768
11769 proc setbg {c} {
11770     global bglist
11771
11772     foreach w $bglist {
11773         if {[winfo exists $w]} {
11774             $w conf -background $c
11775         }
11776     }
11777 }
11778
11779 proc setfg {c} {
11780     global fglist canv
11781
11782     foreach w $fglist {
11783         if {[winfo exists $w]} {
11784             $w conf -foreground $c
11785         }
11786     }
11787     allcanvs itemconf text -fill $c
11788     $canv itemconf circle -outline $c
11789     $canv itemconf markid -outline $c
11790 }
11791
11792 proc prefscan {} {
11793     global oldprefs prefstop
11794
11795     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11796                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11797         global $v
11798         set $v $oldprefs($v)
11799     }
11800     catch {destroy $prefstop}
11801     unset prefstop
11802     fontcan
11803 }
11804
11805 proc prefsok {} {
11806     global maxwidth maxgraphpct
11807     global oldprefs prefstop showneartags showlocalchanges
11808     global fontpref mainfont textfont uifont
11809     global limitdiffs treediffs perfile_attrs
11810     global hideremotes
11811
11812     catch {destroy $prefstop}
11813     unset prefstop
11814     fontcan
11815     set fontchanged 0
11816     if {$mainfont ne $fontpref(mainfont)} {
11817         set mainfont $fontpref(mainfont)
11818         parsefont mainfont $mainfont
11819         eval font configure mainfont [fontflags mainfont]
11820         eval font configure mainfontbold [fontflags mainfont 1]
11821         setcoords
11822         set fontchanged 1
11823     }
11824     if {$textfont ne $fontpref(textfont)} {
11825         set textfont $fontpref(textfont)
11826         parsefont textfont $textfont
11827         eval font configure textfont [fontflags textfont]
11828         eval font configure textfontbold [fontflags textfont 1]
11829     }
11830     if {$uifont ne $fontpref(uifont)} {
11831         set uifont $fontpref(uifont)
11832         parsefont uifont $uifont
11833         eval font configure uifont [fontflags uifont]
11834     }
11835     settabs
11836     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11837         if {$showlocalchanges} {
11838             doshowlocalchanges
11839         } else {
11840             dohidelocalchanges
11841         }
11842     }
11843     if {$limitdiffs != $oldprefs(limitdiffs) ||
11844         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11845         # treediffs elements are limited by path;
11846         # won't have encodings cached if perfile_attrs was just turned on
11847         unset -nocomplain treediffs
11848     }
11849     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11850         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11851         redisplay
11852     } elseif {$showneartags != $oldprefs(showneartags) ||
11853           $limitdiffs != $oldprefs(limitdiffs)} {
11854         reselectline
11855     }
11856     if {$hideremotes != $oldprefs(hideremotes)} {
11857         rereadrefs
11858     }
11859 }
11860
11861 proc formatdate {d} {
11862     global datetimeformat
11863     if {$d ne {}} {
11864         # If $datetimeformat includes a timezone, display in the
11865         # timezone of the argument.  Otherwise, display in local time.
11866         if {[string match {*%[zZ]*} $datetimeformat]} {
11867             if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11868                 # Tcl < 8.5 does not support -timezone.  Emulate it by
11869                 # setting TZ (e.g. TZ=<-0430>+04:30).
11870                 global env
11871                 if {[info exists env(TZ)]} {
11872                     set savedTZ $env(TZ)
11873                 }
11874                 set zone [lindex $d 1]
11875                 set sign [string map {+ - - +} [string index $zone 0]]
11876                 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11877                 set d [clock format [lindex $d 0] -format $datetimeformat]
11878                 if {[info exists savedTZ]} {
11879                     set env(TZ) $savedTZ
11880                 } else {
11881                     unset env(TZ)
11882                 }
11883             }
11884         } else {
11885             set d [clock format [lindex $d 0] -format $datetimeformat]
11886         }
11887     }
11888     return $d
11889 }
11890
11891 # This list of encoding names and aliases is distilled from
11892 # http://www.iana.org/assignments/character-sets.
11893 # Not all of them are supported by Tcl.
11894 set encoding_aliases {
11895     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11896       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11897     { ISO-10646-UTF-1 csISO10646UTF1 }
11898     { ISO_646.basic:1983 ref csISO646basic1983 }
11899     { INVARIANT csINVARIANT }
11900     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11901     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11902     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11903     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11904     { NATS-DANO iso-ir-9-1 csNATSDANO }
11905     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11906     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11907     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11908     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11909     { ISO-2022-KR csISO2022KR }
11910     { EUC-KR csEUCKR }
11911     { ISO-2022-JP csISO2022JP }
11912     { ISO-2022-JP-2 csISO2022JP2 }
11913     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11914       csISO13JISC6220jp }
11915     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11916     { IT iso-ir-15 ISO646-IT csISO15Italian }
11917     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11918     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11919     { greek7-old iso-ir-18 csISO18Greek7Old }
11920     { latin-greek iso-ir-19 csISO19LatinGreek }
11921     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11922     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11923     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11924     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11925     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11926     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11927     { INIS iso-ir-49 csISO49INIS }
11928     { INIS-8 iso-ir-50 csISO50INIS8 }
11929     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11930     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11931     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11932     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11933     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11934     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11935       csISO60Norwegian1 }
11936     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11937     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11938     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11939     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11940     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11941     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11942     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11943     { greek7 iso-ir-88 csISO88Greek7 }
11944     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11945     { iso-ir-90 csISO90 }
11946     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11947     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11948       csISO92JISC62991984b }
11949     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11950     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11951     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11952       csISO95JIS62291984handadd }
11953     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11954     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11955     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11956     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11957       CP819 csISOLatin1 }
11958     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11959     { T.61-7bit iso-ir-102 csISO102T617bit }
11960     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11961     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11962     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11963     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11964     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11965     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11966     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11967     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11968       arabic csISOLatinArabic }
11969     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11970     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11971     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11972       greek greek8 csISOLatinGreek }
11973     { T.101-G2 iso-ir-128 csISO128T101G2 }
11974     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11975       csISOLatinHebrew }
11976     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11977     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11978     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11979     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11980     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11981     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11982     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11983       csISOLatinCyrillic }
11984     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11985     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11986     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11987     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11988     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11989     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11990     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11991     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11992     { ISO_10367-box iso-ir-155 csISO10367Box }
11993     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11994     { latin-lap lap iso-ir-158 csISO158Lap }
11995     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11996     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11997     { us-dk csUSDK }
11998     { dk-us csDKUS }
11999     { JIS_X0201 X0201 csHalfWidthKatakana }
12000     { KSC5636 ISO646-KR csKSC5636 }
12001     { ISO-10646-UCS-2 csUnicode }
12002     { ISO-10646-UCS-4 csUCS4 }
12003     { DEC-MCS dec csDECMCS }
12004     { hp-roman8 roman8 r8 csHPRoman8 }
12005     { macintosh mac csMacintosh }
12006     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
12007       csIBM037 }
12008     { IBM038 EBCDIC-INT cp038 csIBM038 }
12009     { IBM273 CP273 csIBM273 }
12010     { IBM274 EBCDIC-BE CP274 csIBM274 }
12011     { IBM275 EBCDIC-BR cp275 csIBM275 }
12012     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
12013     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
12014     { IBM280 CP280 ebcdic-cp-it csIBM280 }
12015     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
12016     { IBM284 CP284 ebcdic-cp-es csIBM284 }
12017     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
12018     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
12019     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
12020     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
12021     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
12022     { IBM424 cp424 ebcdic-cp-he csIBM424 }
12023     { IBM437 cp437 437 csPC8CodePage437 }
12024     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
12025     { IBM775 cp775 csPC775Baltic }
12026     { IBM850 cp850 850 csPC850Multilingual }
12027     { IBM851 cp851 851 csIBM851 }
12028     { IBM852 cp852 852 csPCp852 }
12029     { IBM855 cp855 855 csIBM855 }
12030     { IBM857 cp857 857 csIBM857 }
12031     { IBM860 cp860 860 csIBM860 }
12032     { IBM861 cp861 861 cp-is csIBM861 }
12033     { IBM862 cp862 862 csPC862LatinHebrew }
12034     { IBM863 cp863 863 csIBM863 }
12035     { IBM864 cp864 csIBM864 }
12036     { IBM865 cp865 865 csIBM865 }
12037     { IBM866 cp866 866 csIBM866 }
12038     { IBM868 CP868 cp-ar csIBM868 }
12039     { IBM869 cp869 869 cp-gr csIBM869 }
12040     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
12041     { IBM871 CP871 ebcdic-cp-is csIBM871 }
12042     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12043     { IBM891 cp891 csIBM891 }
12044     { IBM903 cp903 csIBM903 }
12045     { IBM904 cp904 904 csIBBM904 }
12046     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12047     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12048     { IBM1026 CP1026 csIBM1026 }
12049     { EBCDIC-AT-DE csIBMEBCDICATDE }
12050     { EBCDIC-AT-DE-A csEBCDICATDEA }
12051     { EBCDIC-CA-FR csEBCDICCAFR }
12052     { EBCDIC-DK-NO csEBCDICDKNO }
12053     { EBCDIC-DK-NO-A csEBCDICDKNOA }
12054     { EBCDIC-FI-SE csEBCDICFISE }
12055     { EBCDIC-FI-SE-A csEBCDICFISEA }
12056     { EBCDIC-FR csEBCDICFR }
12057     { EBCDIC-IT csEBCDICIT }
12058     { EBCDIC-PT csEBCDICPT }
12059     { EBCDIC-ES csEBCDICES }
12060     { EBCDIC-ES-A csEBCDICESA }
12061     { EBCDIC-ES-S csEBCDICESS }
12062     { EBCDIC-UK csEBCDICUK }
12063     { EBCDIC-US csEBCDICUS }
12064     { UNKNOWN-8BIT csUnknown8BiT }
12065     { MNEMONIC csMnemonic }
12066     { MNEM csMnem }
12067     { VISCII csVISCII }
12068     { VIQR csVIQR }
12069     { KOI8-R csKOI8R }
12070     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12071     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12072     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12073     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12074     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12075     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12076     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12077     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12078     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12079     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12080     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12081     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12082     { IBM1047 IBM-1047 }
12083     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12084     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12085     { UNICODE-1-1 csUnicode11 }
12086     { CESU-8 csCESU-8 }
12087     { BOCU-1 csBOCU-1 }
12088     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12089     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12090       l8 }
12091     { ISO-8859-15 ISO_8859-15 Latin-9 }
12092     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12093     { GBK CP936 MS936 windows-936 }
12094     { JIS_Encoding csJISEncoding }
12095     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12096     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12097       EUC-JP }
12098     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12099     { ISO-10646-UCS-Basic csUnicodeASCII }
12100     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12101     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12102     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12103     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12104     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12105     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12106     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12107     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12108     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12109     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12110     { Adobe-Standard-Encoding csAdobeStandardEncoding }
12111     { Ventura-US csVenturaUS }
12112     { Ventura-International csVenturaInternational }
12113     { PC8-Danish-Norwegian csPC8DanishNorwegian }
12114     { PC8-Turkish csPC8Turkish }
12115     { IBM-Symbols csIBMSymbols }
12116     { IBM-Thai csIBMThai }
12117     { HP-Legal csHPLegal }
12118     { HP-Pi-font csHPPiFont }
12119     { HP-Math8 csHPMath8 }
12120     { Adobe-Symbol-Encoding csHPPSMath }
12121     { HP-DeskTop csHPDesktop }
12122     { Ventura-Math csVenturaMath }
12123     { Microsoft-Publishing csMicrosoftPublishing }
12124     { Windows-31J csWindows31J }
12125     { GB2312 csGB2312 }
12126     { Big5 csBig5 }
12127 }
12128
12129 proc tcl_encoding {enc} {
12130     global encoding_aliases tcl_encoding_cache
12131     if {[info exists tcl_encoding_cache($enc)]} {
12132         return $tcl_encoding_cache($enc)
12133     }
12134     set names [encoding names]
12135     set lcnames [string tolower $names]
12136     set enc [string tolower $enc]
12137     set i [lsearch -exact $lcnames $enc]
12138     if {$i < 0} {
12139         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12140         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12141             set i [lsearch -exact $lcnames $encx]
12142         }
12143     }
12144     if {$i < 0} {
12145         foreach l $encoding_aliases {
12146             set ll [string tolower $l]
12147             if {[lsearch -exact $ll $enc] < 0} continue
12148             # look through the aliases for one that tcl knows about
12149             foreach e $ll {
12150                 set i [lsearch -exact $lcnames $e]
12151                 if {$i < 0} {
12152                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12153                         set i [lsearch -exact $lcnames $ex]
12154                     }
12155                 }
12156                 if {$i >= 0} break
12157             }
12158             break
12159         }
12160     }
12161     set tclenc {}
12162     if {$i >= 0} {
12163         set tclenc [lindex $names $i]
12164     }
12165     set tcl_encoding_cache($enc) $tclenc
12166     return $tclenc
12167 }
12168
12169 proc gitattr {path attr default} {
12170     global path_attr_cache
12171     if {[info exists path_attr_cache($attr,$path)]} {
12172         set r $path_attr_cache($attr,$path)
12173     } else {
12174         set r "unspecified"
12175         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12176             regexp "(.*): $attr: (.*)" $line m f r
12177         }
12178         set path_attr_cache($attr,$path) $r
12179     }
12180     if {$r eq "unspecified"} {
12181         return $default
12182     }
12183     return $r
12184 }
12185
12186 proc cache_gitattr {attr pathlist} {
12187     global path_attr_cache
12188     set newlist {}
12189     foreach path $pathlist {
12190         if {![info exists path_attr_cache($attr,$path)]} {
12191             lappend newlist $path
12192         }
12193     }
12194     set lim 1000
12195     if {[tk windowingsystem] == "win32"} {
12196         # windows has a 32k limit on the arguments to a command...
12197         set lim 30
12198     }
12199     while {$newlist ne {}} {
12200         set head [lrange $newlist 0 [expr {$lim - 1}]]
12201         set newlist [lrange $newlist $lim end]
12202         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12203             foreach row [split $rlist "\n"] {
12204                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12205                     if {[string index $path 0] eq "\""} {
12206                         set path [encoding convertfrom [lindex $path 0]]
12207                     }
12208                     set path_attr_cache($attr,$path) $value
12209                 }
12210             }
12211         }
12212     }
12213 }
12214
12215 proc get_path_encoding {path} {
12216     global gui_encoding perfile_attrs
12217     set tcl_enc $gui_encoding
12218     if {$path ne {} && $perfile_attrs} {
12219         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12220         if {$enc2 ne {}} {
12221             set tcl_enc $enc2
12222         }
12223     }
12224     return $tcl_enc
12225 }
12226
12227 ## For msgcat loading, first locate the installation location.
12228 if { [info exists ::env(GITK_MSGSDIR)] } {
12229     ## Msgsdir was manually set in the environment.
12230     set gitk_msgsdir $::env(GITK_MSGSDIR)
12231 } else {
12232     ## Let's guess the prefix from argv0.
12233     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12234     set gitk_libdir [file join $gitk_prefix share gitk lib]
12235     set gitk_msgsdir [file join $gitk_libdir msgs]
12236     unset gitk_prefix
12237 }
12238
12239 ## Internationalization (i18n) through msgcat and gettext. See
12240 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12241 package require msgcat
12242 namespace import ::msgcat::mc
12243 ## And eventually load the actual message catalog
12244 ::msgcat::mcload $gitk_msgsdir
12245
12246 # First check that Tcl/Tk is recent enough
12247 if {[catch {package require Tk 8.4} err]} {
12248     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12249                          Gitk requires at least Tcl/Tk 8.4."]
12250     exit 1
12251 }
12252
12253 # on OSX bring the current Wish process window to front
12254 if {[tk windowingsystem] eq "aqua"} {
12255     exec osascript -e [format {
12256         tell application "System Events"
12257             set frontmost of processes whose unix id is %d to true
12258         end tell
12259     } [pid] ]
12260 }
12261
12262 # Unset GIT_TRACE var if set
12263 if { [info exists ::env(GIT_TRACE)] } {
12264     unset ::env(GIT_TRACE)
12265 }
12266
12267 # defaults...
12268 set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12269
12270 set gitencoding {}
12271 catch {
12272     set gitencoding [exec git config --get i18n.commitencoding]
12273 }
12274 catch {
12275     set gitencoding [exec git config --get i18n.logoutputencoding]
12276 }
12277 if {$gitencoding == ""} {
12278     set gitencoding "utf-8"
12279 }
12280 set tclencoding [tcl_encoding $gitencoding]
12281 if {$tclencoding == {}} {
12282     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12283 }
12284
12285 set gui_encoding [encoding system]
12286 catch {
12287     set enc [exec git config --get gui.encoding]
12288     if {$enc ne {}} {
12289         set tclenc [tcl_encoding $enc]
12290         if {$tclenc ne {}} {
12291             set gui_encoding $tclenc
12292         } else {
12293             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12294         }
12295     }
12296 }
12297
12298 set log_showroot true
12299 catch {
12300     set log_showroot [exec git config --bool --get log.showroot]
12301 }
12302
12303 if {[tk windowingsystem] eq "aqua"} {
12304     set mainfont {{Lucida Grande} 9}
12305     set textfont {Monaco 9}
12306     set uifont {{Lucida Grande} 9 bold}
12307 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12308     # fontconfig!
12309     set mainfont {sans 9}
12310     set textfont {monospace 9}
12311     set uifont {sans 9 bold}
12312 } else {
12313     set mainfont {Helvetica 9}
12314     set textfont {Courier 9}
12315     set uifont {Helvetica 9 bold}
12316 }
12317 set tabstop 8
12318 set findmergefiles 0
12319 set maxgraphpct 50
12320 set maxwidth 16
12321 set revlistorder 0
12322 set fastdate 0
12323 set uparrowlen 5
12324 set downarrowlen 5
12325 set mingaplen 100
12326 set cmitmode "patch"
12327 set wrapcomment "none"
12328 set showneartags 1
12329 set hideremotes 0
12330 set maxrefs 20
12331 set visiblerefs {"master"}
12332 set maxlinelen 200
12333 set showlocalchanges 1
12334 set limitdiffs 1
12335 set datetimeformat "%Y-%m-%d %H:%M:%S"
12336 set autoselect 1
12337 set autosellen 40
12338 set perfile_attrs 0
12339 set want_ttk 1
12340
12341 if {[tk windowingsystem] eq "aqua"} {
12342     set extdifftool "opendiff"
12343 } else {
12344     set extdifftool "meld"
12345 }
12346
12347 set colors {"#00ff00" red blue magenta darkgrey brown orange}
12348 if {[tk windowingsystem] eq "win32"} {
12349     set uicolor SystemButtonFace
12350     set uifgcolor SystemButtonText
12351     set uifgdisabledcolor SystemDisabledText
12352     set bgcolor SystemWindow
12353     set fgcolor SystemWindowText
12354     set selectbgcolor SystemHighlight
12355     set web_browser "cmd /c start"
12356 } else {
12357     set uicolor grey85
12358     set uifgcolor black
12359     set uifgdisabledcolor "#999"
12360     set bgcolor white
12361     set fgcolor black
12362     set selectbgcolor gray85
12363     if {[tk windowingsystem] eq "aqua"} {
12364         set web_browser "open"
12365     } else {
12366         set web_browser "xdg-open"
12367     }
12368 }
12369 set diffcolors {red "#00a000" blue}
12370 set diffcontext 3
12371 set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12372 set ignorespace 0
12373 set worddiff ""
12374 set markbgcolor "#e0e0ff"
12375
12376 set headbgcolor "#00ff00"
12377 set headfgcolor black
12378 set headoutlinecolor black
12379 set remotebgcolor #ffddaa
12380 set tagbgcolor yellow
12381 set tagfgcolor black
12382 set tagoutlinecolor black
12383 set reflinecolor black
12384 set filesepbgcolor #aaaaaa
12385 set filesepfgcolor black
12386 set linehoverbgcolor #ffff80
12387 set linehoverfgcolor black
12388 set linehoveroutlinecolor black
12389 set mainheadcirclecolor yellow
12390 set workingfilescirclecolor red
12391 set indexcirclecolor "#00ff00"
12392 set circlecolors {white blue gray blue blue}
12393 set linkfgcolor blue
12394 set circleoutlinecolor $fgcolor
12395 set foundbgcolor yellow
12396 set currentsearchhitbgcolor orange
12397
12398 # button for popping up context menus
12399 if {[tk windowingsystem] eq "aqua"} {
12400     set ctxbut <Button-2>
12401 } else {
12402     set ctxbut <Button-3>
12403 }
12404
12405 catch {
12406     # follow the XDG base directory specification by default. See
12407     # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12408     if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12409         # XDG_CONFIG_HOME environment variable is set
12410         set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12411         set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12412     } else {
12413         # default XDG_CONFIG_HOME
12414         set config_file "~/.config/git/gitk"
12415         set config_file_tmp "~/.config/git/gitk-tmp"
12416     }
12417     if {![file exists $config_file]} {
12418         # for backward compatibility use the old config file if it exists
12419         if {[file exists "~/.gitk"]} {
12420             set config_file "~/.gitk"
12421             set config_file_tmp "~/.gitk-tmp"
12422         } elseif {![file exists [file dirname $config_file]]} {
12423             file mkdir [file dirname $config_file]
12424         }
12425     }
12426     source $config_file
12427 }
12428 config_check_tmp_exists 50
12429
12430 set config_variables {
12431     mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12432     cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12433     hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12434     bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12435     markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12436     extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12437     remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12438     filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12439     linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12440     indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12441     web_browser
12442 }
12443 foreach var $config_variables {
12444     config_init_trace $var
12445     trace add variable $var write config_variable_change_cb
12446 }
12447
12448 parsefont mainfont $mainfont
12449 eval font create mainfont [fontflags mainfont]
12450 eval font create mainfontbold [fontflags mainfont 1]
12451
12452 parsefont textfont $textfont
12453 eval font create textfont [fontflags textfont]
12454 eval font create textfontbold [fontflags textfont 1]
12455
12456 parsefont uifont $uifont
12457 eval font create uifont [fontflags uifont]
12458
12459 setui $uicolor
12460
12461 setoptions
12462
12463 # check that we can find a .git directory somewhere...
12464 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12465     show_error {} . [mc "Cannot find a git repository here."]
12466     exit 1
12467 }
12468
12469 set selecthead {}
12470 set selectheadid {}
12471
12472 set revtreeargs {}
12473 set cmdline_files {}
12474 set i 0
12475 set revtreeargscmd {}
12476 foreach arg $argv {
12477     switch -glob -- $arg {
12478         "" { }
12479         "--" {
12480             set cmdline_files [lrange $argv [expr {$i + 1}] end]
12481             break
12482         }
12483         "--select-commit=*" {
12484             set selecthead [string range $arg 16 end]
12485         }
12486         "--argscmd=*" {
12487             set revtreeargscmd [string range $arg 10 end]
12488         }
12489         default {
12490             lappend revtreeargs $arg
12491         }
12492     }
12493     incr i
12494 }
12495
12496 if {$selecthead eq "HEAD"} {
12497     set selecthead {}
12498 }
12499
12500 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12501     # no -- on command line, but some arguments (other than --argscmd)
12502     if {[catch {
12503         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12504         set cmdline_files [split $f "\n"]
12505         set n [llength $cmdline_files]
12506         set revtreeargs [lrange $revtreeargs 0 end-$n]
12507         # Unfortunately git rev-parse doesn't produce an error when
12508         # something is both a revision and a filename.  To be consistent
12509         # with git log and git rev-list, check revtreeargs for filenames.
12510         foreach arg $revtreeargs {
12511             if {[file exists $arg]} {
12512                 show_error {} . [mc "Ambiguous argument '%s': both revision\
12513                                  and filename" $arg]
12514                 exit 1
12515             }
12516         }
12517     } err]} {
12518         # unfortunately we get both stdout and stderr in $err,
12519         # so look for "fatal:".
12520         set i [string first "fatal:" $err]
12521         if {$i > 0} {
12522             set err [string range $err [expr {$i + 6}] end]
12523         }
12524         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12525         exit 1
12526     }
12527 }
12528
12529 set nullid "0000000000000000000000000000000000000000"
12530 set nullid2 "0000000000000000000000000000000000000001"
12531 set nullfile "/dev/null"
12532
12533 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12534 if {![info exists have_ttk]} {
12535     set have_ttk [llength [info commands ::ttk::style]]
12536 }
12537 set use_ttk [expr {$have_ttk && $want_ttk}]
12538 set NS [expr {$use_ttk ? "ttk" : ""}]
12539
12540 if {$use_ttk} {
12541     setttkstyle
12542 }
12543
12544 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12545
12546 set show_notes {}
12547 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12548     set show_notes "--show-notes"
12549 }
12550
12551 set appname "gitk"
12552
12553 set runq {}
12554 set history {}
12555 set historyindex 0
12556 set fh_serial 0
12557 set nhl_names {}
12558 set highlight_paths {}
12559 set findpattern {}
12560 set searchdirn -forwards
12561 set boldids {}
12562 set boldnameids {}
12563 set diffelide {0 0}
12564 set markingmatches 0
12565 set linkentercount 0
12566 set need_redisplay 0
12567 set nrows_drawn 0
12568 set firsttabstop 0
12569
12570 set nextviewnum 1
12571 set curview 0
12572 set selectedview 0
12573 set selectedhlview [mc "None"]
12574 set highlight_related [mc "None"]
12575 set highlight_files {}
12576 set viewfiles(0) {}
12577 set viewperm(0) 0
12578 set viewchanged(0) 0
12579 set viewargs(0) {}
12580 set viewargscmd(0) {}
12581
12582 set selectedline {}
12583 set numcommits 0
12584 set loginstance 0
12585 set cmdlineok 0
12586 set stopped 0
12587 set stuffsaved 0
12588 set patchnum 0
12589 set lserial 0
12590 set hasworktree [hasworktree]
12591 set cdup {}
12592 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12593     set cdup [exec git rev-parse --show-cdup]
12594 }
12595 set worktree [exec git rev-parse --show-toplevel]
12596 setcoords
12597 makewindow
12598 catch {
12599     image create photo gitlogo      -width 16 -height 16
12600
12601     image create photo gitlogominus -width  4 -height  2
12602     gitlogominus put #C00000 -to 0 0 4 2
12603     gitlogo copy gitlogominus -to  1 5
12604     gitlogo copy gitlogominus -to  6 5
12605     gitlogo copy gitlogominus -to 11 5
12606     image delete gitlogominus
12607
12608     image create photo gitlogoplus  -width  4 -height  4
12609     gitlogoplus  put #008000 -to 1 0 3 4
12610     gitlogoplus  put #008000 -to 0 1 4 3
12611     gitlogo copy gitlogoplus  -to  1 9
12612     gitlogo copy gitlogoplus  -to  6 9
12613     gitlogo copy gitlogoplus  -to 11 9
12614     image delete gitlogoplus
12615
12616     image create photo gitlogo32    -width 32 -height 32
12617     gitlogo32 copy gitlogo -zoom 2 2
12618
12619     wm iconphoto . -default gitlogo gitlogo32
12620 }
12621 # wait for the window to become visible
12622 tkwait visibility .
12623 set_window_title
12624 update
12625 readrefs
12626
12627 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12628     # create a view for the files/dirs specified on the command line
12629     set curview 1
12630     set selectedview 1
12631     set nextviewnum 2
12632     set viewname(1) [mc "Command line"]
12633     set viewfiles(1) $cmdline_files
12634     set viewargs(1) $revtreeargs
12635     set viewargscmd(1) $revtreeargscmd
12636     set viewperm(1) 0
12637     set viewchanged(1) 0
12638     set vdatemode(1) 0
12639     addviewmenu 1
12640     .bar.view entryconf [mca "&Edit view..."] -state normal
12641     .bar.view entryconf [mca "&Delete view"] -state normal
12642 }
12643
12644 if {[info exists permviews]} {
12645     foreach v $permviews {
12646         set n $nextviewnum
12647         incr nextviewnum
12648         set viewname($n) [lindex $v 0]
12649         set viewfiles($n) [lindex $v 1]
12650         set viewargs($n) [lindex $v 2]
12651         set viewargscmd($n) [lindex $v 3]
12652         set viewperm($n) 1
12653         set viewchanged($n) 0
12654         addviewmenu $n
12655     }
12656 }
12657
12658 if {[tk windowingsystem] eq "win32"} {
12659     focus -force .
12660 }
12661
12662 getcommits {}
12663
12664 # Local variables:
12665 # mode: tcl
12666 # indent-tabs-mode: t
12667 # tab-width: 8
12668 # End: