Code

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