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