2 # Tcl ignores the next line -*- tcl -*- \
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.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
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.
28 if {[info exists isonrunq
($script)]} return
32 lappend runq
[list
{} $script]
33 set isonrunq
($script) 1
36 proc filerun
{fd
script} {
37 fileevent
$fd readable
[list filereadable
$fd $script]
40 proc filereadable
{fd
script} {
43 fileevent
$fd readable
{}
47 lappend runq
[list
$fd $script]
53 for {set i
0} {$i < [llength
$runq]} {} {
54 if {[lindex
$runq $i 0] eq
$fd} {
55 set runq
[lreplace
$runq $i $i]
65 set tstart
[clock clicks
-milliseconds]
67 while {[llength
$runq] > 0} {
68 set fd
[lindex
$runq 0 0]
69 set script [lindex
$runq 0 1]
70 set repeat
[eval $script]
71 set t1
[clock clicks
-milliseconds]
72 set t
[expr {$t1 - $t0}]
73 set runq
[lrange
$runq 1 end
]
74 if {$repeat ne
{} && $repeat} {
75 if {$fd eq
{} ||
$repeat == 2} {
76 # script returns 1 if it wants to be readded
77 # file readers return 2 if they could do more straight away
78 lappend runq
[list
$fd $script]
80 fileevent
$fd readable
[list filereadable
$fd $script]
82 } elseif
{$fd eq
{}} {
83 unset isonrunq
($script)
86 if {$t1 - $tstart >= 80} break
93 proc unmerged_files
{files
} {
96 # find the list of unmerged files
100 set fd
[open
"| git ls-files -u" r
]
102 show_error
{} .
"[mc "Couldn
't get list of unmerged files:"] $err"
105 while {[gets $fd line] >= 0} {
106 set i [string first "\t" $line]
108 set fname [string range $line [expr {$i+1}] end]
109 if {[lsearch -exact $mlist $fname] >= 0} continue
111 if {$files eq {} || [path_filter $files $fname]} {
119 proc parseviewargs {n arglist} {
120 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
128 set origargs $arglist
132 foreach arg $arglist {
139 switch -glob -- $arg {
143 # remove from origargs in case we hit an unknown option
144 set origargs [lreplace $origargs $i $i]
147 # These request or affect diff output, which we don't want.
148 # Some could be used to set our defaults for diff display.
150 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
151 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
152 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
153 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
154 "--ignore-space-change" - "-U*" - "--unified=*" {
155 lappend diffargs
$arg
157 # These cause our parsing of git log's output to fail, or else
158 # they're options we want to set ourselves, so ignore them.
159 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
160 "--name-only" - "--name-status" - "--color" - "--color-words" -
161 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
162 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
163 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
164 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
165 "--objects" - "--objects-edge" - "--reverse" {
167 # These are harmless, and some are even useful
168 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
169 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
170 "--full-history" - "--dense" - "--sparse" -
171 "--follow" - "--left-right" - "--encoding=*" {
174 # These mean that we get a subset of the commits
175 "--diff-filter=*" - "--no-merges" - "--unpacked" -
176 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
177 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
178 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
179 "--remove-empty" - "--first-parent" - "--cherry-pick" -
180 "-S*" - "--pickaxe-all" - "--pickaxe-regex" - {
184 # This appears to be the only one that has a value as a
185 # separate word following it
192 set notflag
[expr {!$notflag}]
200 # git rev-parse doesn't understand --merge
201 lappend revargs
--gitk-symmetric-diff-marker MERGE_HEAD...HEAD
203 # Other flag arguments including -<n>
205 if {[string is digit
-strict [string range
$arg 1 end
]]} {
208 # a flag argument that we don't recognize;
209 # that means we can't optimize
214 # Non-flag arguments specify commits or ranges of commits
216 if {[string match
"*...*" $arg]} {
217 lappend revargs
--gitk-symmetric-diff-marker
223 set vdflags
($n) $diffargs
224 set vflags
($n) $glflags
225 set vrevs
($n) $revargs
226 set vfiltered
($n) $filtered
227 set vorigargs
($n) $origargs
231 proc parseviewrevs
{view revs
} {
232 global vposids vnegids
237 if {[catch
{set ids
[eval exec git rev-parse
$revs]} err
]} {
238 # we get stdout followed by stderr in $err
239 # for an unknown rev, git rev-parse echoes it and then errors out
240 set errlines
[split $err "\n"]
242 for {set l
0} {$l < [llength
$errlines]} {incr l
} {
243 set line
[lindex
$errlines $l]
244 if {!([string length
$line] == 40 && [string is xdigit
$line])} {
245 if {[string match
"fatal:*" $line]} {
246 if {[string match
"fatal: ambiguous argument*" $line]
248 if {[llength
$badrev] == 1} {
249 set err
"unknown revision $badrev"
251 set err
"unknown revisions: [join $badrev ", "]"
254 set err
[join [lrange
$errlines $l end
] "\n"]
261 error_popup
"Error parsing revisions: $err"
268 foreach id
[split $ids "\n"] {
269 if {$id eq
"--gitk-symmetric-diff-marker"} {
271 } elseif
{[string match
"^*" $id]} {
278 lappend neg
[string range
$id 1 end
]
283 lset ret end
[lindex
$ret end
]...
$id
289 set vposids
($view) $pos
290 set vnegids
($view) $neg
294 # Start off a git log process and arrange to read its output
295 proc start_rev_list
{view
} {
296 global startmsecs commitidx viewcomplete curview
297 global commfd leftover tclencoding
298 global viewargs viewargscmd viewfiles vfilelimit
299 global showlocalchanges commitinterest
300 global viewactive loginstance viewinstances vmergeonly
301 global pending_select mainheadid
302 global vcanopt vflags vrevs vorigargs
304 set startmsecs
[clock clicks
-milliseconds]
305 set commitidx
($view) 0
306 # these are set this way for the error exits
307 set viewcomplete
($view) 1
308 set viewactive
($view) 0
311 set args
$viewargs($view)
312 if {$viewargscmd($view) ne
{}} {
314 set str
[exec sh
-c $viewargscmd($view)]
316 error_popup
"Error executing --argscmd command: $err"
319 set args
[concat
$args [split $str "\n"]]
321 set vcanopt
($view) [parseviewargs
$view $args]
323 set files
$viewfiles($view)
324 if {$vmergeonly($view)} {
325 set files
[unmerged_files
$files]
328 if {$nr_unmerged == 0} {
329 error_popup
[mc
"No files selected: --merge specified but\
330 no files are unmerged."]
332 error_popup
[mc
"No files selected: --merge specified but\
333 no unmerged files are within file limit."]
338 set vfilelimit
($view) $files
340 if {$vcanopt($view)} {
341 set revs
[parseviewrevs
$view $vrevs($view)]
345 set args
[concat
$vflags($view) $revs]
347 set args
$vorigargs($view)
351 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
352 --boundary $args "--" $files] r
]
354 error_popup
"[mc "Error executing git log
:"] $err"
357 set i
[incr loginstance
]
358 set viewinstances
($view) [list
$i]
361 if {$showlocalchanges && $mainheadid ne
{}} {
362 lappend commitinterest
($mainheadid) {dodiffindex
}
364 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
365 if {$tclencoding != {}} {
366 fconfigure
$fd -encoding $tclencoding
368 filerun
$fd [list getcommitlines
$fd $i $view 0]
369 nowbusy
$view [mc
"Reading"]
370 if {$view == $curview} {
371 set pending_select
$mainheadid
373 set viewcomplete
($view) 0
374 set viewactive
($view) 1
378 proc stop_rev_list
{view
} {
379 global commfd viewinstances leftover
381 foreach inst
$viewinstances($view) {
382 set fd
$commfd($inst)
390 unset leftover
($inst)
392 set viewinstances
($view) {}
396 global canv curview need_redisplay viewactive
399 if {[start_rev_list
$curview]} {
400 show_status
[mc
"Reading commits..."]
403 show_status
[mc
"No commits selected"]
407 proc updatecommits
{} {
408 global curview vcanopt vorigargs vfilelimit viewinstances
409 global viewactive viewcomplete loginstance tclencoding
410 global startmsecs commfd showneartags showlocalchanges leftover
411 global mainheadid pending_select
413 global varcid vposids vnegids vflags vrevs
415 set isworktree
[expr {[exec git rev-parse
--is-inside-work-tree] == "true"}]
416 set oldmainid
$mainheadid
418 if {$showlocalchanges} {
419 if {$mainheadid ne
$oldmainid} {
422 if {[commitinview
$mainheadid $curview]} {
427 if {$vcanopt($view)} {
428 set oldpos
$vposids($view)
429 set oldneg
$vnegids($view)
430 set revs
[parseviewrevs
$view $vrevs($view)]
434 # note: getting the delta when negative refs change is hard,
435 # and could require multiple git log invocations, so in that
436 # case we ask git log for all the commits (not just the delta)
437 if {$oldneg eq
$vnegids($view)} {
440 # take out positive refs that we asked for before or
441 # that we have already seen
443 if {[string length
$rev] == 40} {
444 if {[lsearch
-exact $oldpos $rev] < 0
445 && ![info exists varcid
($view,$rev)]} {
450 lappend
$newrevs $rev
453 if {$npos == 0} return
455 set vposids
($view) [lsort
-unique [concat
$oldpos $vposids($view)]]
457 set args
[concat
$vflags($view) $revs --not $oldpos]
459 set args
$vorigargs($view)
462 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
463 --boundary $args "--" $vfilelimit($view)] r
]
465 error_popup
"Error executing git log: $err"
468 if {$viewactive($view) == 0} {
469 set startmsecs
[clock clicks
-milliseconds]
471 set i
[incr loginstance
]
472 lappend viewinstances
($view) $i
475 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
476 if {$tclencoding != {}} {
477 fconfigure
$fd -encoding $tclencoding
479 filerun
$fd [list getcommitlines
$fd $i $view 1]
480 incr viewactive
($view)
481 set viewcomplete
($view) 0
482 set pending_select
$mainheadid
483 nowbusy
$view "Reading"
489 proc reloadcommits
{} {
490 global curview viewcomplete selectedline currentid thickerline
491 global showneartags treediffs commitinterest cached_commitrow
494 if {!$viewcomplete($curview)} {
495 stop_rev_list
$curview
499 catch
{unset currentid
}
500 catch
{unset thickerline
}
501 catch
{unset treediffs
}
508 catch
{unset commitinterest
}
509 catch
{unset cached_commitrow
}
510 catch
{unset targetid
}
516 # This makes a string representation of a positive integer which
517 # sorts as a string in numerical order
520 return [format
"%x" $n]
521 } elseif
{$n < 256} {
522 return [format
"x%.2x" $n]
523 } elseif
{$n < 65536} {
524 return [format
"y%.4x" $n]
526 return [format
"z%.8x" $n]
529 # Procedures used in reordering commits from git log (without
530 # --topo-order) into the order for display.
532 proc varcinit
{view
} {
533 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
534 global vtokmod varcmod vrowmod varcix vlastins
536 set varcstart
($view) {{}}
537 set vupptr
($view) {0}
538 set vdownptr
($view) {0}
539 set vleftptr
($view) {0}
540 set vbackptr
($view) {0}
541 set varctok
($view) {{}}
542 set varcrow
($view) {{}}
543 set vtokmod
($view) {}
546 set varcix
($view) {{}}
547 set vlastins
($view) {0}
550 proc resetvarcs
{view
} {
551 global varcid varccommits parents children vseedcount ordertok
553 foreach vid
[array names varcid
$view,*] {
558 # some commits might have children but haven't been seen yet
559 foreach vid
[array names children
$view,*] {
562 foreach va
[array names varccommits
$view,*] {
563 unset varccommits
($va)
565 foreach vd
[array names vseedcount
$view,*] {
566 unset vseedcount
($vd)
568 catch
{unset ordertok
}
571 # returns a list of the commits with no children
573 global vdownptr vleftptr varcstart
576 set a
[lindex
$vdownptr($v) 0]
578 lappend ret
[lindex
$varcstart($v) $a]
579 set a
[lindex
$vleftptr($v) $a]
584 proc newvarc
{view id
} {
585 global varcid varctok parents children vdatemode
586 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
587 global commitdata commitinfo vseedcount varccommits vlastins
589 set a
[llength
$varctok($view)]
591 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
592 if {![info exists commitinfo
($id)]} {
593 parsecommit
$id $commitdata($id) 1
595 set cdate
[lindex
$commitinfo($id) 4]
596 if {![string is integer
-strict $cdate]} {
599 if {![info exists vseedcount
($view,$cdate)]} {
600 set vseedcount
($view,$cdate) -1
602 set c
[incr vseedcount
($view,$cdate)]
603 set cdate
[expr {$cdate ^
0xffffffff}]
604 set tok
"s[strrep $cdate][strrep $c]"
609 if {[llength
$children($vid)] > 0} {
610 set kid
[lindex
$children($vid) end
]
611 set k
$varcid($view,$kid)
612 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
615 set tok
[lindex
$varctok($view) $k]
619 set i
[lsearch
-exact $parents($view,$ki) $id]
620 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
621 append tok
[strrep
$j]
623 set c
[lindex
$vlastins($view) $ka]
624 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
626 set b
[lindex
$vdownptr($view) $ka]
628 set b
[lindex
$vleftptr($view) $c]
630 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
632 set b
[lindex
$vleftptr($view) $c]
635 lset vdownptr
($view) $ka $a
636 lappend vbackptr
($view) 0
638 lset vleftptr
($view) $c $a
639 lappend vbackptr
($view) $c
641 lset vlastins
($view) $ka $a
642 lappend vupptr
($view) $ka
643 lappend vleftptr
($view) $b
645 lset vbackptr
($view) $b $a
647 lappend varctok
($view) $tok
648 lappend varcstart
($view) $id
649 lappend vdownptr
($view) 0
650 lappend varcrow
($view) {}
651 lappend varcix
($view) {}
652 set varccommits
($view,$a) {}
653 lappend vlastins
($view) 0
657 proc splitvarc
{p v
} {
658 global varcid varcstart varccommits varctok
659 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
661 set oa
$varcid($v,$p)
662 set ac
$varccommits($v,$oa)
663 set i
[lsearch
-exact $varccommits($v,$oa) $p]
665 set na
[llength
$varctok($v)]
666 # "%" sorts before "0"...
667 set tok
"[lindex $varctok($v) $oa]%[strrep $i]"
668 lappend varctok
($v) $tok
669 lappend varcrow
($v) {}
670 lappend varcix
($v) {}
671 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
672 set varccommits
($v,$na) [lrange
$ac $i end
]
673 lappend varcstart
($v) $p
674 foreach id
$varccommits($v,$na) {
675 set varcid
($v,$id) $na
677 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
678 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
679 lset vdownptr
($v) $oa $na
680 lset vlastins
($v) $oa 0
681 lappend vupptr
($v) $oa
682 lappend vleftptr
($v) 0
683 lappend vbackptr
($v) 0
684 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
685 lset vupptr
($v) $b $na
689 proc renumbervarc
{a v
} {
690 global parents children varctok varcstart varccommits
691 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
693 set t1
[clock clicks
-milliseconds]
699 if {[info exists isrelated
($a)]} {
701 set id
[lindex
$varccommits($v,$a) end
]
702 foreach p
$parents($v,$id) {
703 if {[info exists varcid
($v,$p)]} {
704 set isrelated
($varcid($v,$p)) 1
709 set b
[lindex
$vdownptr($v) $a]
712 set b
[lindex
$vleftptr($v) $a]
714 set a
[lindex
$vupptr($v) $a]
720 if {![info exists kidchanged
($a)]} continue
721 set id
[lindex
$varcstart($v) $a]
722 if {[llength
$children($v,$id)] > 1} {
723 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
726 set oldtok
[lindex
$varctok($v) $a]
727 if {!$vdatemode($v)} {
733 set kid
[last_real_child
$v,$id]
735 set k
$varcid($v,$kid)
736 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
739 set tok
[lindex
$varctok($v) $k]
743 set i
[lsearch
-exact $parents($v,$ki) $id]
744 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
745 append tok
[strrep
$j]
747 if {$tok eq
$oldtok} {
750 set id
[lindex
$varccommits($v,$a) end
]
751 foreach p
$parents($v,$id) {
752 if {[info exists varcid
($v,$p)]} {
753 set kidchanged
($varcid($v,$p)) 1
758 lset varctok
($v) $a $tok
759 set b
[lindex
$vupptr($v) $a]
761 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
764 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
767 set c
[lindex
$vbackptr($v) $a]
768 set d
[lindex
$vleftptr($v) $a]
770 lset vdownptr
($v) $b $d
772 lset vleftptr
($v) $c $d
775 lset vbackptr
($v) $d $c
777 if {[lindex
$vlastins($v) $b] == $a} {
778 lset vlastins
($v) $b $c
780 lset vupptr
($v) $a $ka
781 set c
[lindex
$vlastins($v) $ka]
783 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
785 set b
[lindex
$vdownptr($v) $ka]
787 set b
[lindex
$vleftptr($v) $c]
790 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
792 set b
[lindex
$vleftptr($v) $c]
795 lset vdownptr
($v) $ka $a
796 lset vbackptr
($v) $a 0
798 lset vleftptr
($v) $c $a
799 lset vbackptr
($v) $a $c
801 lset vleftptr
($v) $a $b
803 lset vbackptr
($v) $b $a
805 lset vlastins
($v) $ka $a
808 foreach id
[array names sortkids
] {
809 if {[llength
$children($v,$id)] > 1} {
810 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
814 set t2
[clock clicks
-milliseconds]
815 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
818 # Fix up the graph after we have found out that in view $v,
819 # $p (a commit that we have already seen) is actually the parent
820 # of the last commit in arc $a.
821 proc fix_reversal
{p a v
} {
822 global varcid varcstart varctok vupptr
824 set pa
$varcid($v,$p)
825 if {$p ne
[lindex
$varcstart($v) $pa]} {
827 set pa
$varcid($v,$p)
829 # seeds always need to be renumbered
830 if {[lindex
$vupptr($v) $pa] == 0 ||
831 [string compare
[lindex
$varctok($v) $a] \
832 [lindex
$varctok($v) $pa]] > 0} {
837 proc insertrow
{id p v
} {
838 global cmitlisted children parents varcid varctok vtokmod
839 global varccommits ordertok commitidx numcommits curview
840 global targetid targetrow
844 set cmitlisted
($vid) 1
845 set children
($vid) {}
846 set parents
($vid) [list
$p]
847 set a
[newvarc
$v $id]
849 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
852 lappend varccommits
($v,$a) $id
854 if {[llength
[lappend children
($vp) $id]] > 1} {
855 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
856 catch
{unset ordertok
}
858 fix_reversal
$p $a $v
860 if {$v == $curview} {
861 set numcommits
$commitidx($v)
863 if {[info exists targetid
]} {
864 if {![comes_before
$targetid $p]} {
871 proc insertfakerow
{id p
} {
872 global varcid varccommits parents children cmitlisted
873 global commitidx varctok vtokmod targetid targetrow curview numcommits
877 set i
[lsearch
-exact $varccommits($v,$a) $p]
879 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
882 set children
($v,$id) {}
883 set parents
($v,$id) [list
$p]
884 set varcid
($v,$id) $a
885 lappend children
($v,$p) $id
886 set cmitlisted
($v,$id) 1
887 set numcommits
[incr commitidx
($v)]
888 # note we deliberately don't update varcstart($v) even if $i == 0
889 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
891 if {[info exists targetid
]} {
892 if {![comes_before
$targetid $p]} {
900 proc removefakerow
{id
} {
901 global varcid varccommits parents children commitidx
902 global varctok vtokmod cmitlisted currentid selectedline
903 global targetid curview numcommits
906 if {[llength
$parents($v,$id)] != 1} {
907 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
910 set p
[lindex
$parents($v,$id) 0]
911 set a
$varcid($v,$id)
912 set i
[lsearch
-exact $varccommits($v,$a) $id]
914 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
918 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
919 unset parents
($v,$id)
920 unset children
($v,$id)
921 unset cmitlisted
($v,$id)
922 set numcommits
[incr commitidx
($v) -1]
923 set j
[lsearch
-exact $children($v,$p) $id]
925 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
928 if {[info exist currentid
] && $id eq
$currentid} {
932 if {[info exists targetid
] && $targetid eq
$id} {
939 proc first_real_child
{vp
} {
940 global children nullid nullid2
942 foreach id
$children($vp) {
943 if {$id ne
$nullid && $id ne
$nullid2} {
950 proc last_real_child
{vp
} {
951 global children nullid nullid2
953 set kids
$children($vp)
954 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
955 set id
[lindex
$kids $i]
956 if {$id ne
$nullid && $id ne
$nullid2} {
963 proc vtokcmp
{v a b
} {
964 global varctok varcid
966 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
967 [lindex
$varctok($v) $varcid($v,$b)]]
970 # This assumes that if lim is not given, the caller has checked that
971 # arc a's token is less than $vtokmod($v)
972 proc modify_arc
{v a
{lim
{}}} {
973 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
976 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
979 set r
[lindex
$varcrow($v) $a]
980 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
983 set vtokmod
($v) [lindex
$varctok($v) $a]
985 if {$v == $curview} {
986 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
987 set a
[lindex
$vupptr($v) $a]
993 set lim
[llength
$varccommits($v,$a)]
995 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
1002 proc update_arcrows
{v
} {
1003 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1004 global varcid vrownum varcorder varcix varccommits
1005 global vupptr vdownptr vleftptr varctok
1006 global displayorder parentlist curview cached_commitrow
1008 if {$vrowmod($v) == $commitidx($v)} return
1009 if {$v == $curview} {
1010 if {[llength
$displayorder] > $vrowmod($v)} {
1011 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
1012 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
1014 catch
{unset cached_commitrow
}
1016 set narctot
[expr {[llength
$varctok($v)] - 1}]
1018 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
1019 # go up the tree until we find something that has a row number,
1020 # or we get to a seed
1021 set a
[lindex
$vupptr($v) $a]
1024 set a
[lindex
$vdownptr($v) 0]
1027 set varcorder
($v) [list
$a]
1028 lset varcix
($v) $a 0
1029 lset varcrow
($v) $a 0
1033 set arcn
[lindex
$varcix($v) $a]
1034 if {[llength
$vrownum($v)] > $arcn + 1} {
1035 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
1036 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
1038 set row
[lindex
$varcrow($v) $a]
1042 incr row
[llength
$varccommits($v,$a)]
1043 # go down if possible
1044 set b
[lindex
$vdownptr($v) $a]
1046 # if not, go left, or go up until we can go left
1048 set b
[lindex
$vleftptr($v) $a]
1050 set a
[lindex
$vupptr($v) $a]
1056 lappend vrownum
($v) $row
1057 lappend varcorder
($v) $a
1058 lset varcix
($v) $a $arcn
1059 lset varcrow
($v) $a $row
1061 set vtokmod
($v) [lindex
$varctok($v) $p]
1063 set vrowmod
($v) $row
1064 if {[info exists currentid
]} {
1065 set selectedline
[rowofcommit
$currentid]
1069 # Test whether view $v contains commit $id
1070 proc commitinview
{id v
} {
1073 return [info exists varcid
($v,$id)]
1076 # Return the row number for commit $id in the current view
1077 proc rowofcommit
{id
} {
1078 global varcid varccommits varcrow curview cached_commitrow
1079 global varctok vtokmod
1082 if {![info exists varcid
($v,$id)]} {
1083 puts
"oops rowofcommit no arc for [shortids $id]"
1086 set a
$varcid($v,$id)
1087 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
1090 if {[info exists cached_commitrow
($id)]} {
1091 return $cached_commitrow($id)
1093 set i
[lsearch
-exact $varccommits($v,$a) $id]
1095 puts
"oops didn't find commit [shortids $id] in arc $a"
1098 incr i
[lindex
$varcrow($v) $a]
1099 set cached_commitrow
($id) $i
1103 # Returns 1 if a is on an earlier row than b, otherwise 0
1104 proc comes_before
{a b
} {
1105 global varcid varctok curview
1108 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
1109 ![info exists varcid
($v,$b)]} {
1112 if {$varcid($v,$a) != $varcid($v,$b)} {
1113 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1114 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
1116 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
1119 proc bsearch
{l elt
} {
1120 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
1125 while {$hi - $lo > 1} {
1126 set mid
[expr {int
(($lo + $hi) / 2)}]
1127 set t
[lindex
$l $mid]
1130 } elseif
{$elt > $t} {
1139 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1140 proc make_disporder
{start end
} {
1141 global vrownum curview commitidx displayorder parentlist
1142 global varccommits varcorder parents vrowmod varcrow
1143 global d_valid_start d_valid_end
1145 if {$end > $vrowmod($curview)} {
1146 update_arcrows
$curview
1148 set ai
[bsearch
$vrownum($curview) $start]
1149 set start
[lindex
$vrownum($curview) $ai]
1150 set narc
[llength
$vrownum($curview)]
1151 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
1152 set a
[lindex
$varcorder($curview) $ai]
1153 set l
[llength
$displayorder]
1154 set al
[llength
$varccommits($curview,$a)]
1155 if {$l < $r + $al} {
1157 set pad
[ntimes
[expr {$r - $l}] {}]
1158 set displayorder
[concat
$displayorder $pad]
1159 set parentlist
[concat
$parentlist $pad]
1160 } elseif
{$l > $r} {
1161 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
1162 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
1164 foreach id
$varccommits($curview,$a) {
1165 lappend displayorder
$id
1166 lappend parentlist
$parents($curview,$id)
1168 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
1170 foreach id
$varccommits($curview,$a) {
1171 lset displayorder
$i $id
1172 lset parentlist
$i $parents($curview,$id)
1180 proc commitonrow
{row
} {
1183 set id
[lindex
$displayorder $row]
1185 make_disporder
$row [expr {$row + 1}]
1186 set id
[lindex
$displayorder $row]
1191 proc closevarcs
{v
} {
1192 global varctok varccommits varcid parents children
1193 global cmitlisted commitidx commitinterest vtokmod
1195 set missing_parents
0
1197 set narcs
[llength
$varctok($v)]
1198 for {set a
1} {$a < $narcs} {incr a
} {
1199 set id
[lindex
$varccommits($v,$a) end
]
1200 foreach p
$parents($v,$id) {
1201 if {[info exists varcid
($v,$p)]} continue
1202 # add p as a new commit
1203 incr missing_parents
1204 set cmitlisted
($v,$p) 0
1205 set parents
($v,$p) {}
1206 if {[llength
$children($v,$p)] == 1 &&
1207 [llength
$parents($v,$id)] == 1} {
1210 set b
[newvarc
$v $p]
1212 set varcid
($v,$p) $b
1213 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1216 lappend varccommits
($v,$b) $p
1218 if {[info exists commitinterest
($p)]} {
1219 foreach
script $commitinterest($p) {
1220 lappend scripts
[string map
[list
"%I" $p] $script]
1222 unset commitinterest
($id)
1226 if {$missing_parents > 0} {
1227 foreach s
$scripts {
1233 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1234 # Assumes we already have an arc for $rwid.
1235 proc rewrite_commit
{v id rwid
} {
1236 global children parents varcid varctok vtokmod varccommits
1238 foreach ch
$children($v,$id) {
1239 # make $rwid be $ch's parent in place of $id
1240 set i
[lsearch
-exact $parents($v,$ch) $id]
1242 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1244 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1245 # add $ch to $rwid's children and sort the list if necessary
1246 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1247 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1248 $children($v,$rwid)]
1250 # fix the graph after joining $id to $rwid
1251 set a
$varcid($v,$ch)
1252 fix_reversal
$rwid $a $v
1253 # parentlist is wrong for the last element of arc $a
1254 # even if displayorder is right, hence the 3rd arg here
1255 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1259 proc getcommitlines
{fd inst view updating
} {
1260 global cmitlisted commitinterest leftover
1261 global commitidx commitdata vdatemode
1262 global parents children curview hlview
1263 global idpending ordertok
1264 global varccommits varcid varctok vtokmod vfilelimit
1266 set stuff
[read $fd 500000]
1267 # git log doesn't terminate the last commit with a null...
1268 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1275 global commfd viewcomplete viewactive viewname
1276 global viewinstances
1278 set i
[lsearch
-exact $viewinstances($view) $inst]
1280 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1282 # set it blocking so we wait for the process to terminate
1283 fconfigure
$fd -blocking 1
1284 if {[catch
{close
$fd} err
]} {
1286 if {$view != $curview} {
1287 set fv
" for the \"$viewname($view)\" view"
1289 if {[string range
$err 0 4] == "usage"} {
1290 set err
"Gitk: error reading commits$fv:\
1291 bad arguments to git log."
1292 if {$viewname($view) eq
"Command line"} {
1294 " (Note: arguments to gitk are passed to git log\
1295 to allow selection of commits to be displayed.)"
1298 set err
"Error reading commits$fv: $err"
1302 if {[incr viewactive
($view) -1] <= 0} {
1303 set viewcomplete
($view) 1
1304 # Check if we have seen any ids listed as parents that haven't
1305 # appeared in the list
1309 if {$view == $curview} {
1318 set i
[string first
"\0" $stuff $start]
1320 append leftover
($inst) [string range
$stuff $start end
]
1324 set cmit
$leftover($inst)
1325 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1326 set leftover
($inst) {}
1328 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1330 set start
[expr {$i + 1}]
1331 set j
[string first
"\n" $cmit]
1334 if {$j >= 0 && [string match
"commit *" $cmit]} {
1335 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1336 if {[string match
{[-^
<>]*} $ids]} {
1337 switch
-- [string index
$ids 0] {
1343 set ids
[string range
$ids 1 end
]
1347 if {[string length
$id] != 40} {
1355 if {[string length
$shortcmit] > 80} {
1356 set shortcmit
"[string range $shortcmit 0 80]..."
1358 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1361 set id [lindex $ids 0]
1364 if {!$listed && $updating && ![info exists varcid($vid)] &&
1365 $vfilelimit($view) ne {}} {
1366 # git log doesn't rewrite parents
for unlisted commits
1367 # when doing path limiting, so work around that here
1368 # by working out the rewritten parent with git rev-list
1369 # and if we already know about it, using the rewritten
1370 # parent as a substitute parent for $id's children.
1372 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1373 $id -- $vfilelimit($view)]
1375 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1376 # use $rwid in place of $id
1377 rewrite_commit
$view $id $rwid
1384 if {[info exists varcid
($vid)]} {
1385 if {$cmitlisted($vid) ||
!$listed} continue
1389 set olds
[lrange
$ids 1 end
]
1393 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1394 set cmitlisted
($vid) $listed
1395 set parents
($vid) $olds
1396 if {![info exists children
($vid)]} {
1397 set children
($vid) {}
1398 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1399 set k
[lindex
$children($vid) 0]
1400 if {[llength
$parents($view,$k)] == 1 &&
1401 (!$vdatemode($view) ||
1402 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1403 set a
$varcid($view,$k)
1408 set a
[newvarc
$view $id]
1410 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1413 if {![info exists varcid
($vid)]} {
1415 lappend varccommits
($view,$a) $id
1416 incr commitidx
($view)
1421 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1423 if {[llength
[lappend children
($vp) $id]] > 1 &&
1424 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1425 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1427 catch
{unset ordertok
}
1429 if {[info exists varcid
($view,$p)]} {
1430 fix_reversal
$p $a $view
1436 if {[info exists commitinterest
($id)]} {
1437 foreach
script $commitinterest($id) {
1438 lappend scripts
[string map
[list
"%I" $id] $script]
1440 unset commitinterest
($id)
1445 global numcommits hlview
1447 if {$view == $curview} {
1448 set numcommits
$commitidx($view)
1451 if {[info exists hlview
] && $view == $hlview} {
1452 # we never actually get here...
1455 foreach s
$scripts {
1462 proc chewcommits
{} {
1463 global curview hlview viewcomplete
1464 global pending_select
1467 if {$viewcomplete($curview)} {
1468 global commitidx varctok
1469 global numcommits startmsecs
1471 if {[info exists pending_select
]} {
1472 set row
[first_real_row
]
1475 if {$commitidx($curview) > 0} {
1476 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1477 #puts "overall $ms ms for $numcommits commits"
1478 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1480 show_status
[mc
"No commits selected"]
1487 proc readcommit
{id
} {
1488 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
1489 parsecommit
$id $contents 0
1492 proc parsecommit
{id contents listed
} {
1493 global commitinfo cdate
1502 set hdrend
[string first
"\n\n" $contents]
1504 # should never happen...
1505 set hdrend
[string length
$contents]
1507 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1508 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1509 foreach line
[split $header "\n"] {
1510 set tag
[lindex
$line 0]
1511 if {$tag == "author"} {
1512 set audate
[lindex
$line end-1
]
1513 set auname
[lrange
$line 1 end-2
]
1514 } elseif
{$tag == "committer"} {
1515 set comdate
[lindex
$line end-1
]
1516 set comname
[lrange
$line 1 end-2
]
1520 # take the first non-blank line of the comment as the headline
1521 set headline
[string trimleft
$comment]
1522 set i
[string first
"\n" $headline]
1524 set headline
[string range
$headline 0 $i]
1526 set headline
[string trimright
$headline]
1527 set i
[string first
"\r" $headline]
1529 set headline
[string trimright
[string range
$headline 0 $i]]
1532 # git log indents the comment by 4 spaces;
1533 # if we got this via git cat-file, add the indentation
1535 foreach line
[split $comment "\n"] {
1536 append newcomment
" "
1537 append newcomment
$line
1538 append newcomment
"\n"
1540 set comment
$newcomment
1542 if {$comdate != {}} {
1543 set cdate
($id) $comdate
1545 set commitinfo
($id) [list
$headline $auname $audate \
1546 $comname $comdate $comment]
1549 proc getcommit
{id
} {
1550 global commitdata commitinfo
1552 if {[info exists commitdata
($id)]} {
1553 parsecommit
$id $commitdata($id) 1
1556 if {![info exists commitinfo
($id)]} {
1557 set commitinfo
($id) [list
[mc
"No commit information available"]]
1564 global tagids idtags headids idheads tagobjid
1565 global otherrefids idotherrefs mainhead mainheadid
1567 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1570 set refd
[open
[list | git show-ref
-d] r
]
1571 while {[gets
$refd line
] >= 0} {
1572 if {[string index
$line 40] ne
" "} continue
1573 set id
[string range
$line 0 39]
1574 set ref
[string range
$line 41 end
]
1575 if {![string match
"refs/*" $ref]} continue
1576 set name
[string range
$ref 5 end
]
1577 if {[string match
"remotes/*" $name]} {
1578 if {![string match
"*/HEAD" $name]} {
1579 set headids
($name) $id
1580 lappend idheads
($id) $name
1582 } elseif
{[string match
"heads/*" $name]} {
1583 set name
[string range
$name 6 end
]
1584 set headids
($name) $id
1585 lappend idheads
($id) $name
1586 } elseif
{[string match
"tags/*" $name]} {
1587 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1588 # which is what we want since the former is the commit ID
1589 set name
[string range
$name 5 end
]
1590 if {[string match
"*^{}" $name]} {
1591 set name
[string range
$name 0 end-3
]
1593 set tagobjid
($name) $id
1595 set tagids
($name) $id
1596 lappend idtags
($id) $name
1598 set otherrefids
($name) $id
1599 lappend idotherrefs
($id) $name
1606 set mainheadid
[exec git rev-parse HEAD
]
1607 set thehead
[exec git symbolic-ref HEAD
]
1608 if {[string match
"refs/heads/*" $thehead]} {
1609 set mainhead
[string range
$thehead 11 end
]
1614 # skip over fake commits
1615 proc first_real_row
{} {
1616 global nullid nullid2 numcommits
1618 for {set row
0} {$row < $numcommits} {incr row
} {
1619 set id
[commitonrow
$row]
1620 if {$id ne
$nullid && $id ne
$nullid2} {
1627 # update things for a head moved to a child of its previous location
1628 proc movehead
{id name
} {
1629 global headids idheads
1631 removehead
$headids($name) $name
1632 set headids
($name) $id
1633 lappend idheads
($id) $name
1636 # update things when a head has been removed
1637 proc removehead
{id name
} {
1638 global headids idheads
1640 if {$idheads($id) eq
$name} {
1643 set i
[lsearch
-exact $idheads($id) $name]
1645 set idheads
($id) [lreplace
$idheads($id) $i $i]
1648 unset headids
($name)
1651 proc show_error
{w top msg
} {
1652 message
$w.m
-text $msg -justify center
-aspect 400
1653 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1654 button
$w.ok
-text [mc OK
] -command "destroy $top"
1655 pack
$w.ok
-side bottom
-fill x
1656 bind $top <Visibility
> "grab $top; focus $top"
1657 bind $top <Key-Return
> "destroy $top"
1661 proc error_popup msg
{
1665 show_error
$w $w $msg
1668 proc confirm_popup msg
{
1674 message
$w.m
-text $msg -justify center
-aspect 400
1675 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1676 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1677 pack
$w.ok
-side left
-fill x
1678 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1679 pack
$w.cancel
-side right
-fill x
1680 bind $w <Visibility
> "grab $w; focus $w"
1685 proc setoptions
{} {
1686 option add
*Panedwindow.showHandle
1 startupFile
1687 option add
*Panedwindow.sashRelief raised startupFile
1688 option add
*Button.font uifont startupFile
1689 option add
*Checkbutton.font uifont startupFile
1690 option add
*Radiobutton.font uifont startupFile
1691 option add
*Menu.font uifont startupFile
1692 option add
*Menubutton.font uifont startupFile
1693 option add
*Label.font uifont startupFile
1694 option add
*Message.font uifont startupFile
1695 option add
*Entry.font uifont startupFile
1698 proc makewindow
{} {
1699 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1701 global findtype findtypemenu findloc findstring fstring geometry
1702 global entries sha1entry sha1string sha1but
1703 global diffcontextstring diffcontext
1705 global maincursor textcursor curtextcursor
1706 global rowctxmenu fakerowmenu mergemax wrapcomment
1707 global highlight_files gdttype
1708 global searchstring sstring
1709 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1710 global headctxmenu progresscanv progressitem progresscoords statusw
1711 global fprogitem fprogcoord lastprogupdate progupdatepending
1712 global rprogitem rprogcoord rownumsel numcommits
1716 .bar add cascade
-label [mc
"File"] -menu .bar.
file
1718 .bar.
file add
command -label [mc
"Update"] -command updatecommits
1719 .bar.
file add
command -label [mc
"Reload"] -command reloadcommits
1720 .bar.
file add
command -label [mc
"Reread references"] -command rereadrefs
1721 .bar.
file add
command -label [mc
"List references"] -command showrefs
1722 .bar.
file add
command -label [mc
"Quit"] -command doquit
1724 .bar add cascade
-label [mc
"Edit"] -menu .bar.edit
1725 .bar.edit add
command -label [mc
"Preferences"] -command doprefs
1728 .bar add cascade
-label [mc
"View"] -menu .bar.view
1729 .bar.view add
command -label [mc
"New view..."] -command {newview
0}
1730 .bar.view add
command -label [mc
"Edit view..."] -command editview \
1732 .bar.view add
command -label [mc
"Delete view"] -command delview
-state disabled
1733 .bar.view add separator
1734 .bar.view add radiobutton
-label [mc
"All files"] -command {showview
0} \
1735 -variable selectedview
-value 0
1738 .bar add cascade
-label [mc
"Help"] -menu .bar.
help
1739 .bar.
help add
command -label [mc
"About gitk"] -command about
1740 .bar.
help add
command -label [mc
"Key bindings"] -command keys
1742 . configure
-menu .bar
1744 # the gui has upper and lower half, parts of a paned window.
1745 panedwindow .ctop
-orient vertical
1747 # possibly use assumed geometry
1748 if {![info exists geometry
(pwsash0
)]} {
1749 set geometry
(topheight
) [expr {15 * $linespc}]
1750 set geometry
(topwidth
) [expr {80 * $charspc}]
1751 set geometry
(botheight
) [expr {15 * $linespc}]
1752 set geometry
(botwidth
) [expr {50 * $charspc}]
1753 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1754 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1757 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1758 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1760 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1762 # create three canvases
1763 set cscroll .tf.histframe.csb
1764 set canv .tf.histframe.pwclist.canv
1766 -selectbackground $selectbgcolor \
1767 -background $bgcolor -bd 0 \
1768 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1769 .tf.histframe.pwclist add
$canv
1770 set canv2 .tf.histframe.pwclist.canv2
1772 -selectbackground $selectbgcolor \
1773 -background $bgcolor -bd 0 -yscrollincr $linespc
1774 .tf.histframe.pwclist add
$canv2
1775 set canv3 .tf.histframe.pwclist.canv3
1777 -selectbackground $selectbgcolor \
1778 -background $bgcolor -bd 0 -yscrollincr $linespc
1779 .tf.histframe.pwclist add
$canv3
1780 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
1781 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
1783 # a scroll bar to rule them
1784 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
1785 pack
$cscroll -side right
-fill y
1786 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
1787 lappend bglist
$canv $canv2 $canv3
1788 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
1790 # we have two button bars at bottom of top frame. Bar 1
1792 frame .tf.lbar
-height 15
1794 set sha1entry .tf.bar.sha1
1795 set entries
$sha1entry
1796 set sha1but .tf.bar.sha1label
1797 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
1798 -command gotocommit
-width 8
1799 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
1800 pack .tf.bar.sha1label
-side left
1801 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
1802 trace add variable sha1string
write sha1change
1803 pack
$sha1entry -side left
-pady 2
1805 image create bitmap bm-left
-data {
1806 #define left_width 16
1807 #define left_height 16
1808 static unsigned char left_bits
[] = {
1809 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1810 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1811 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1813 image create bitmap bm-right
-data {
1814 #define right_width 16
1815 #define right_height 16
1816 static unsigned char right_bits
[] = {
1817 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1818 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1819 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1821 button .tf.bar.leftbut
-image bm-left
-command goback \
1822 -state disabled
-width 26
1823 pack .tf.bar.leftbut
-side left
-fill y
1824 button .tf.bar.rightbut
-image bm-right
-command goforw \
1825 -state disabled
-width 26
1826 pack .tf.bar.rightbut
-side left
-fill y
1828 label .tf.bar.rowlabel
-text [mc
"Row"]
1830 label .tf.bar.rownum
-width 7 -font textfont
-textvariable rownumsel \
1831 -relief sunken
-anchor e
1832 label .tf.bar.rowlabel2
-text "/"
1833 label .tf.bar.numcommits
-width 7 -font textfont
-textvariable numcommits \
1834 -relief sunken
-anchor e
1835 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
1838 trace add variable selectedline
write selectedline_change
1840 # Status label and progress bar
1841 set statusw .tf.bar.status
1842 label
$statusw -width 15 -relief sunken
1843 pack
$statusw -side left
-padx 5
1844 set h
[expr {[font metrics uifont
-linespace] + 2}]
1845 set progresscanv .tf.bar.progress
1846 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
1847 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
1848 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
1849 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
1850 pack
$progresscanv -side right
-expand 1 -fill x
1851 set progresscoords
{0 0}
1854 bind $progresscanv <Configure
> adjustprogress
1855 set lastprogupdate
[clock clicks
-milliseconds]
1856 set progupdatepending
0
1858 # build up the bottom bar of upper window
1859 label .tf.lbar.flabel
-text "[mc "Find
"] "
1860 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
1861 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
1862 label .tf.lbar.flab2
-text " [mc "commit
"] "
1863 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1865 set gdttype
[mc
"containing:"]
1866 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
1867 [mc
"containing:"] \
1868 [mc
"touching paths:"] \
1869 [mc
"adding/removing string:"]]
1870 trace add variable gdttype
write gdttype_change
1871 pack .tf.lbar.gdttype
-side left
-fill y
1874 set fstring .tf.lbar.findstring
1875 lappend entries
$fstring
1876 entry
$fstring -width 30 -font textfont
-textvariable findstring
1877 trace add variable findstring
write find_change
1878 set findtype
[mc
"Exact"]
1879 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
1880 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
1881 trace add variable findtype
write findcom_change
1882 set findloc
[mc
"All fields"]
1883 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
1884 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
1885 trace add variable findloc
write find_change
1886 pack .tf.lbar.findloc
-side right
1887 pack .tf.lbar.findtype
-side right
1888 pack
$fstring -side left
-expand 1 -fill x
1890 # Finish putting the upper half of the viewer together
1891 pack .tf.lbar
-in .tf
-side bottom
-fill x
1892 pack .tf.bar
-in .tf
-side bottom
-fill x
1893 pack .tf.histframe
-fill both
-side top
-expand 1
1895 .ctop paneconfigure .tf
-height $geometry(topheight
)
1896 .ctop paneconfigure .tf
-width $geometry(topwidth
)
1898 # now build up the bottom
1899 panedwindow .pwbottom
-orient horizontal
1901 # lower left, a text box over search bar, scroll bar to the right
1902 # if we know window height, then that will set the lower text height, otherwise
1903 # we set lower text height which will drive window height
1904 if {[info exists geometry
(main
)]} {
1905 frame .bleft
-width $geometry(botwidth
)
1907 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
1913 button .bleft.top.search
-text [mc
"Search"] -command dosearch
1914 pack .bleft.top.search
-side left
-padx 5
1915 set sstring .bleft.top.sstring
1916 entry
$sstring -width 20 -font textfont
-textvariable searchstring
1917 lappend entries
$sstring
1918 trace add variable searchstring
write incrsearch
1919 pack
$sstring -side left
-expand 1 -fill x
1920 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
1921 -command changediffdisp
-variable diffelide
-value {0 0}
1922 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
1923 -command changediffdisp
-variable diffelide
-value {0 1}
1924 radiobutton .bleft.mid.new
-text [mc
"New version"] \
1925 -command changediffdisp
-variable diffelide
-value {1 0}
1926 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
1927 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
1928 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
1929 -from 1 -increment 1 -to 10000000 \
1930 -validate all
-validatecommand "diffcontextvalidate %P" \
1931 -textvariable diffcontextstring
1932 .bleft.mid.diffcontext
set $diffcontext
1933 trace add variable diffcontextstring
write diffcontextchange
1934 lappend entries .bleft.mid.diffcontext
1935 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
1936 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
1937 -command changeignorespace
-variable ignorespace
1938 pack .bleft.mid.ignspace
-side left
-padx 5
1939 set ctext .bleft.bottom.ctext
1940 text
$ctext -background $bgcolor -foreground $fgcolor \
1941 -state disabled
-font textfont \
1942 -yscrollcommand scrolltext
-wrap none \
1943 -xscrollcommand ".bleft.bottom.sbhorizontal set"
1945 $ctext conf
-tabstyle wordprocessor
1947 scrollbar .bleft.bottom.sb
-command "$ctext yview"
1948 scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h \
1950 pack .bleft.top
-side top
-fill x
1951 pack .bleft.mid
-side top
-fill x
1952 grid
$ctext .bleft.bottom.sb
-sticky nsew
1953 grid .bleft.bottom.sbhorizontal
-sticky ew
1954 grid columnconfigure .bleft.bottom
0 -weight 1
1955 grid rowconfigure .bleft.bottom
0 -weight 1
1956 grid rowconfigure .bleft.bottom
1 -weight 0
1957 pack .bleft.bottom
-side top
-fill both
-expand 1
1958 lappend bglist
$ctext
1959 lappend fglist
$ctext
1961 $ctext tag conf comment
-wrap $wrapcomment
1962 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
1963 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
1964 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
1965 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
1966 $ctext tag conf m0
-fore red
1967 $ctext tag conf m1
-fore blue
1968 $ctext tag conf m2
-fore green
1969 $ctext tag conf m3
-fore purple
1970 $ctext tag conf
m4 -fore brown
1971 $ctext tag conf m5
-fore "#009090"
1972 $ctext tag conf m6
-fore magenta
1973 $ctext tag conf m7
-fore "#808000"
1974 $ctext tag conf m8
-fore "#009000"
1975 $ctext tag conf m9
-fore "#ff0080"
1976 $ctext tag conf m10
-fore cyan
1977 $ctext tag conf m11
-fore "#b07070"
1978 $ctext tag conf m12
-fore "#70b0f0"
1979 $ctext tag conf m13
-fore "#70f0b0"
1980 $ctext tag conf m14
-fore "#f0b070"
1981 $ctext tag conf m15
-fore "#ff70b0"
1982 $ctext tag conf mmax
-fore darkgrey
1984 $ctext tag conf mresult
-font textfontbold
1985 $ctext tag conf msep
-font textfontbold
1986 $ctext tag conf found
-back yellow
1988 .pwbottom add .bleft
1989 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
1994 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
1995 -command reselectline
-variable cmitmode
-value "patch"
1996 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
1997 -command reselectline
-variable cmitmode
-value "tree"
1998 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
1999 pack .bright.mode
-side top
-fill x
2000 set cflist .bright.cfiles
2001 set indent
[font measure mainfont
"nn"]
2003 -selectbackground $selectbgcolor \
2004 -background $bgcolor -foreground $fgcolor \
2006 -tabs [list
$indent [expr {2 * $indent}]] \
2007 -yscrollcommand ".bright.sb set" \
2008 -cursor [. cget
-cursor] \
2009 -spacing1 1 -spacing3 1
2010 lappend bglist
$cflist
2011 lappend fglist
$cflist
2012 scrollbar .bright.sb
-command "$cflist yview"
2013 pack .bright.sb
-side right
-fill y
2014 pack
$cflist -side left
-fill both
-expand 1
2015 $cflist tag configure highlight \
2016 -background [$cflist cget
-selectbackground]
2017 $cflist tag configure bold
-font mainfontbold
2019 .pwbottom add .bright
2022 # restore window width & height if known
2023 if {[info exists geometry
(main
)]} {
2024 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
2025 if {$w > [winfo screenwidth .
]} {
2026 set w
[winfo screenwidth .
]
2028 if {$h > [winfo screenheight .
]} {
2029 set h
[winfo screenheight .
]
2031 wm geometry .
"${w}x$h"
2035 if {[tk windowingsystem
] eq
{aqua
}} {
2041 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2042 pack .ctop
-fill both
-expand 1
2043 bindall
<1> {selcanvline
%W
%x
%y
}
2044 #bindall <B1-Motion> {selcanvline %W %x %y}
2045 if {[tk windowingsystem
] == "win32"} {
2046 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2047 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2049 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2050 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2051 if {[tk windowingsystem
] eq
"aqua"} {
2052 bindall
<MouseWheel
> {
2053 set delta
[expr {- (%D
)}]
2054 allcanvs yview scroll
$delta units
2058 bindall
<2> "canvscan mark %W %x %y"
2059 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
2060 bindkey
<Home
> selfirstline
2061 bindkey
<End
> sellastline
2062 bind .
<Key-Up
> "selnextline -1"
2063 bind .
<Key-Down
> "selnextline 1"
2064 bind .
<Shift-Key-Up
> "dofind -1 0"
2065 bind .
<Shift-Key-Down
> "dofind 1 0"
2066 bindkey
<Key-Right
> "goforw"
2067 bindkey
<Key-Left
> "goback"
2068 bind .
<Key-Prior
> "selnextpage -1"
2069 bind .
<Key-Next
> "selnextpage 1"
2070 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2071 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2072 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2073 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2074 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2075 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2076 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2077 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2078 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2079 bindkey p
"selnextline -1"
2080 bindkey n
"selnextline 1"
2083 bindkey i
"selnextline -1"
2084 bindkey k
"selnextline 1"
2088 bindkey d
"$ctext yview scroll 18 units"
2089 bindkey u
"$ctext yview scroll -18 units"
2090 bindkey
/ {dofind
1 1}
2091 bindkey
<Key-Return
> {dofind
1 1}
2092 bindkey ?
{dofind
-1 1}
2094 bindkey
<F5
> updatecommits
2095 bind .
<$M1B-q> doquit
2096 bind .
<$M1B-f> {dofind
1 1}
2097 bind .
<$M1B-g> {dofind
1 0}
2098 bind .
<$M1B-r> dosearchback
2099 bind .
<$M1B-s> dosearch
2100 bind .
<$M1B-equal> {incrfont
1}
2101 bind .
<$M1B-plus> {incrfont
1}
2102 bind .
<$M1B-KP_Add> {incrfont
1}
2103 bind .
<$M1B-minus> {incrfont
-1}
2104 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2105 wm protocol . WM_DELETE_WINDOW doquit
2106 bind .
<Button-1
> "click %W"
2107 bind $fstring <Key-Return
> {dofind
1 1}
2108 bind $sha1entry <Key-Return
> gotocommit
2109 bind $sha1entry <<PasteSelection>> clearsha1
2110 bind $cflist <1> {sel_flist %W %x %y; break}
2111 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2112 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2113 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
2115 set maincursor [. cget -cursor]
2116 set textcursor [$ctext cget -cursor]
2117 set curtextcursor $textcursor
2119 set rowctxmenu .rowctxmenu
2120 menu $rowctxmenu -tearoff 0
2121 $rowctxmenu add command -label [mc "Diff this -> selected"] \
2122 -command {diffvssel 0}
2123 $rowctxmenu add command -label [mc "Diff selected -> this"] \
2124 -command {diffvssel 1}
2125 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
2126 $rowctxmenu add command -label [mc "Create tag"] -command mktag
2127 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
2128 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
2129 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
2131 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
2134 set fakerowmenu .fakerowmenu
2135 menu $fakerowmenu -tearoff 0
2136 $fakerowmenu add command -label [mc "Diff this -> selected"] \
2137 -command {diffvssel 0}
2138 $fakerowmenu add command -label [mc "Diff selected -> this"] \
2139 -command {diffvssel 1}
2140 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
2141 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
2142 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
2143 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
2145 set headctxmenu .headctxmenu
2146 menu $headctxmenu -tearoff 0
2147 $headctxmenu add command -label [mc "Check out this branch"] \
2149 $headctxmenu add command -label [mc "Remove this branch"] \
2153 set flist_menu .flistctxmenu
2154 menu $flist_menu -tearoff 0
2155 $flist_menu add command -label [mc "Highlight this too"] \
2156 -command {flist_hl 0}
2157 $flist_menu add command -label [mc "Highlight this only"] \
2158 -command {flist_hl 1}
2159 $flist_menu add command -label [mc "External diff"] \
2160 -command {external_diff}
2163 # Windows sends all mouse wheel events to the current focused window, not
2164 # the one where the mouse hovers, so bind those events here and redirect
2165 # to the correct window
2166 proc windows_mousewheel_redirector {W X Y D} {
2167 global canv canv2 canv3
2168 set w [winfo containing -displayof $W $X $Y]
2170 set u [expr {$D < 0 ? 5 : -5}]
2171 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2172 allcanvs yview scroll $u units
2175 $w yview scroll $u units
2181 # Update row number label when selectedline changes
2182 proc selectedline_change {n1 n2 op} {
2183 global selectedline rownumsel
2185 if {$selectedline eq {}} {
2188 set rownumsel [expr {$selectedline + 1}]
2192 # mouse-2 makes all windows scan vertically, but only the one
2193 # the cursor is in scans horizontally
2194 proc canvscan {op w x y} {
2195 global canv canv2 canv3
2196 foreach c [list $canv $canv2 $canv3] {
2205 proc scrollcanv {cscroll f0 f1} {
2206 $cscroll set $f0 $f1
2211 # when we make a key binding for the toplevel, make sure
2212 # it doesn't get triggered when that key is pressed in the
2213 # find string entry widget.
2214 proc bindkey {ev script} {
2217 set escript [bind Entry $ev]
2218 if {$escript == {}} {
2219 set escript [bind Entry <Key>]
2221 foreach e $entries {
2222 bind $e $ev "$escript; break"
2226 # set the focus back to the toplevel for any click outside
2229 global ctext entries
2230 foreach e [concat $entries $ctext] {
2231 if {$w == $e} return
2236 # Adjust the progress bar for a change in requested extent or canvas size
2237 proc adjustprogress {} {
2238 global progresscanv progressitem progresscoords
2239 global fprogitem fprogcoord lastprogupdate progupdatepending
2240 global rprogitem rprogcoord
2242 set w [expr {[winfo width $progresscanv] - 4}]
2243 set x0 [expr {$w * [lindex $progresscoords 0]}]
2244 set x1 [expr {$w * [lindex $progresscoords 1]}]
2245 set h [winfo height $progresscanv]
2246 $progresscanv coords $progressitem $x0 0 $x1 $h
2247 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2248 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2249 set now [clock clicks -milliseconds]
2250 if {$now >= $lastprogupdate + 100} {
2251 set progupdatepending 0
2253 } elseif {!$progupdatepending} {
2254 set progupdatepending 1
2255 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2259 proc doprogupdate {} {
2260 global lastprogupdate progupdatepending
2262 if {$progupdatepending} {
2263 set progupdatepending 0
2264 set lastprogupdate [clock clicks -milliseconds]
2269 proc savestuff {w} {
2270 global canv canv2 canv3 mainfont textfont uifont tabstop
2271 global stuffsaved findmergefiles maxgraphpct
2272 global maxwidth showneartags showlocalchanges
2273 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2274 global cmitmode wrapcomment datetimeformat limitdiffs
2275 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2276 global autoselect extdifftool
2278 if {$stuffsaved} return
2279 if {![winfo viewable .]} return
2281 set f [open "~/.gitk-new" w]
2282 puts $f [list set mainfont $mainfont]
2283 puts $f [list set textfont $textfont]
2284 puts $f [list set uifont $uifont]
2285 puts $f [list set tabstop $tabstop]
2286 puts $f [list set findmergefiles $findmergefiles]
2287 puts $f [list set maxgraphpct $maxgraphpct]
2288 puts $f [list set maxwidth $maxwidth]
2289 puts $f [list set cmitmode $cmitmode]
2290 puts $f [list set wrapcomment $wrapcomment]
2291 puts $f [list set autoselect $autoselect]
2292 puts $f [list set showneartags $showneartags]
2293 puts $f [list set showlocalchanges $showlocalchanges]
2294 puts $f [list set datetimeformat $datetimeformat]
2295 puts $f [list set limitdiffs $limitdiffs]
2296 puts $f [list set bgcolor $bgcolor]
2297 puts $f [list set fgcolor $fgcolor]
2298 puts $f [list set colors $colors]
2299 puts $f [list set diffcolors $diffcolors]
2300 puts $f [list set diffcontext $diffcontext]
2301 puts $f [list set selectbgcolor $selectbgcolor]
2302 puts $f [list set extdifftool $extdifftool]
2304 puts $f "set geometry(main) [wm geometry .]"
2305 puts $f "set geometry(topwidth) [winfo width .tf]"
2306 puts $f "set geometry(topheight) [winfo height .tf]"
2307 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2308 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2309 puts $f "set geometry(botwidth) [winfo width .bleft]"
2310 puts $f "set geometry(botheight) [winfo height .bleft]"
2312 puts -nonewline $f "set permviews {"
2313 for {set v 0} {$v < $nextviewnum} {incr v} {
2314 if {$viewperm($v)} {
2315 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2320 file rename -force "~/.gitk-new" "~/.gitk"
2325 proc resizeclistpanes {win w} {
2327 if {[info exists oldwidth($win)]} {
2328 set s0 [$win sash coord 0]
2329 set s1 [$win sash coord 1]
2331 set sash0 [expr {int($w/2 - 2)}]
2332 set sash1 [expr {int($w*5/6 - 2)}]
2334 set factor [expr {1.0 * $w / $oldwidth($win)}]
2335 set sash0 [expr {int($factor * [lindex $s0 0])}]
2336 set sash1 [expr {int($factor * [lindex $s1 0])}]
2340 if {$sash1 < $sash0 + 20} {
2341 set sash1 [expr {$sash0 + 20}]
2343 if {$sash1 > $w - 10} {
2344 set sash1 [expr {$w - 10}]
2345 if {$sash0 > $sash1 - 20} {
2346 set sash0 [expr {$sash1 - 20}]
2350 $win sash place 0 $sash0 [lindex $s0 1]
2351 $win sash place 1 $sash1 [lindex $s1 1]
2353 set oldwidth($win) $w
2356 proc resizecdetpanes {win w} {
2358 if {[info exists oldwidth($win)]} {
2359 set s0 [$win sash coord 0]
2361 set sash0 [expr {int($w*3/4 - 2)}]
2363 set factor [expr {1.0 * $w / $oldwidth($win)}]
2364 set sash0 [expr {int($factor * [lindex $s0 0])}]
2368 if {$sash0 > $w - 15} {
2369 set sash0 [expr {$w - 15}]
2372 $win sash place 0 $sash0 [lindex $s0 1]
2374 set oldwidth($win) $w
2377 proc allcanvs args {
2378 global canv canv2 canv3
2384 proc bindall {event action} {
2385 global canv canv2 canv3
2386 bind $canv $event $action
2387 bind $canv2 $event $action
2388 bind $canv3 $event $action
2394 if {[winfo exists $w]} {
2399 wm title $w [mc "About gitk"]
2400 message $w.m -text [mc "
2401 Gitk - a commit viewer for git
2403 Copyright © 2005-2008 Paul Mackerras
2405 Use and redistribute under the terms of the GNU General Public License"] \
2406 -justify center -aspect 400 -border 2 -bg white -relief groove
2407 pack $w.m -side top -fill x -padx 2 -pady 2
2408 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2409 pack $w.ok -side bottom
2410 bind $w <Visibility> "focus $w.ok"
2411 bind $w <Key-Escape> "destroy $w"
2412 bind $w <Key-Return> "destroy $w"
2417 if {[winfo exists $w]} {
2421 if {[tk windowingsystem] eq {aqua}} {
2427 wm title $w [mc "Gitk key bindings"]
2428 message $w.m -text "
2429 [mc "Gitk key bindings:"]
2431 [mc "<%s-Q> Quit" $M1T]
2432 [mc "<Home> Move to first commit"]
2433 [mc "<End> Move to last commit"]
2434 [mc "<Up>, p, i Move up one commit"]
2435 [mc "<Down>, n, k Move down one commit"]
2436 [mc "<Left>, z, j Go back in history list"]
2437 [mc "<Right>, x, l Go forward in history list"]
2438 [mc "<PageUp> Move up one page in commit list"]
2439 [mc "<PageDown> Move down one page in commit list"]
2440 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2441 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2442 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2443 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2444 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2445 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2446 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2447 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2448 [mc "<Delete>, b Scroll diff view up one page"]
2449 [mc "<Backspace> Scroll diff view up one page"]
2450 [mc "<Space> Scroll diff view down one page"]
2451 [mc "u Scroll diff view up 18 lines"]
2452 [mc "d Scroll diff view down 18 lines"]
2453 [mc "<%s-F> Find" $M1T]
2454 [mc "<%s-G> Move to next find hit" $M1T]
2455 [mc "<Return> Move to next find hit"]
2456 [mc "/ Move to next find hit, or redo find"]
2457 [mc "? Move to previous find hit"]
2458 [mc "f Scroll diff view to next file"]
2459 [mc "<%s-S> Search for next hit in diff view" $M1T]
2460 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2461 [mc "<%s-KP+> Increase font size" $M1T]
2462 [mc "<%s-plus> Increase font size" $M1T]
2463 [mc "<%s-KP-> Decrease font size" $M1T]
2464 [mc "<%s-minus> Decrease font size" $M1T]
2467 -justify left -bg white -border 2 -relief groove
2468 pack $w.m -side top -fill both -padx 2 -pady 2
2469 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2470 pack $w.ok -side bottom
2471 bind $w <Visibility> "focus $w.ok"
2472 bind $w <Key-Escape> "destroy $w"
2473 bind $w <Key-Return> "destroy $w"
2476 # Procedures for manipulating the file list window at the
2477 # bottom right of the overall window.
2479 proc treeview {w l openlevs} {
2480 global treecontents treediropen treeheight treeparent treeindex
2490 set treecontents() {}
2491 $w conf -state normal
2493 while {[string range $f 0 $prefixend] ne $prefix} {
2494 if {$lev <= $openlevs} {
2495 $w mark set e:$treeindex($prefix) "end -1c"
2496 $w mark gravity e:$treeindex($prefix) left
2498 set treeheight($prefix) $ht
2499 incr ht [lindex $htstack end]
2500 set htstack [lreplace $htstack end end]
2501 set prefixend [lindex $prefendstack end]
2502 set prefendstack [lreplace $prefendstack end end]
2503 set prefix [string range $prefix 0 $prefixend]
2506 set tail [string range $f [expr {$prefixend+1}] end]
2507 while {[set slash [string first "/" $tail]] >= 0} {
2510 lappend prefendstack $prefixend
2511 incr prefixend [expr {$slash + 1}]
2512 set d [string range $tail 0 $slash]
2513 lappend treecontents($prefix) $d
2514 set oldprefix $prefix
2516 set treecontents($prefix) {}
2517 set treeindex($prefix) [incr ix]
2518 set treeparent($prefix) $oldprefix
2519 set tail [string range $tail [expr {$slash+1}] end]
2520 if {$lev <= $openlevs} {
2522 set treediropen($prefix) [expr {$lev < $openlevs}]
2523 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2524 $w mark set d:$ix "end -1c"
2525 $w mark gravity d:$ix left
2527 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2529 $w image create end -align center -image $bm -padx 1 \
2531 $w insert end $d [highlight_tag $prefix]
2532 $w mark set s:$ix "end -1c"
2533 $w mark gravity s:$ix left
2538 if {$lev <= $openlevs} {
2541 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2543 $w insert end $tail [highlight_tag $f]
2545 lappend treecontents($prefix) $tail
2548 while {$htstack ne {}} {
2549 set treeheight($prefix) $ht
2550 incr ht [lindex $htstack end]
2551 set htstack [lreplace $htstack end end]
2552 set prefixend [lindex $prefendstack end]
2553 set prefendstack [lreplace $prefendstack end end]
2554 set prefix [string range $prefix 0 $prefixend]
2556 $w conf -state disabled
2559 proc linetoelt {l} {
2560 global treeheight treecontents
2565 foreach e $treecontents($prefix) {
2570 if {[string index $e end] eq "/"} {
2571 set n $treeheight($prefix$e)
2583 proc highlight_tree {y prefix} {
2584 global treeheight treecontents cflist
2586 foreach e $treecontents($prefix) {
2588 if {[highlight_tag $path] ne {}} {
2589 $cflist tag add bold $y.0 "$y.0 lineend"
2592 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2593 set y [highlight_tree $y $path]
2599 proc treeclosedir {w dir} {
2600 global treediropen treeheight treeparent treeindex
2602 set ix $treeindex($dir)
2603 $w conf -state normal
2604 $w delete s:$ix e:$ix
2605 set treediropen($dir) 0
2606 $w image configure a:$ix -image tri-rt
2607 $w conf -state disabled
2608 set n [expr {1 - $treeheight($dir)}]
2609 while {$dir ne {}} {
2610 incr treeheight($dir) $n
2611 set dir $treeparent($dir)
2615 proc treeopendir {w dir} {
2616 global treediropen treeheight treeparent treecontents treeindex
2618 set ix $treeindex($dir)
2619 $w conf -state normal
2620 $w image configure a:$ix -image tri-dn
2621 $w mark set e:$ix s:$ix
2622 $w mark gravity e:$ix right
2625 set n [llength $treecontents($dir)]
2626 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2629 incr treeheight($x) $n
2631 foreach e $treecontents($dir) {
2633 if {[string index $e end] eq "/"} {
2634 set iy $treeindex($de)
2635 $w mark set d:$iy e:$ix
2636 $w mark gravity d:$iy left
2637 $w insert e:$ix $str
2638 set treediropen($de) 0
2639 $w image create e:$ix -align center -image tri-rt -padx 1 \
2641 $w insert e:$ix $e [highlight_tag $de]
2642 $w mark set s:$iy e:$ix
2643 $w mark gravity s:$iy left
2644 set treeheight($de) 1
2646 $w insert e:$ix $str
2647 $w insert e:$ix $e [highlight_tag $de]
2650 $w mark gravity e:$ix left
2651 $w conf -state disabled
2652 set treediropen($dir) 1
2653 set top [lindex [split [$w index @0,0] .] 0]
2654 set ht [$w cget -height]
2655 set l [lindex [split [$w index s:$ix] .] 0]
2658 } elseif {$l + $n + 1 > $top + $ht} {
2659 set top [expr {$l + $n + 2 - $ht}]
2667 proc treeclick {w x y} {
2668 global treediropen cmitmode ctext cflist cflist_top
2670 if {$cmitmode ne "tree"} return
2671 if {![info exists cflist_top]} return
2672 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2673 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2674 $cflist tag add highlight $l.0 "$l.0 lineend"
2680 set e [linetoelt $l]
2681 if {[string index $e end] ne "/"} {
2683 } elseif {$treediropen($e)} {
2690 proc setfilelist {id} {
2691 global treefilelist cflist
2693 treeview $cflist $treefilelist($id) 0
2696 image create bitmap tri-rt -background black -foreground blue -data {
2697 #define tri-rt_width 13
2698 #define tri-rt_height 13
2699 static unsigned char tri-rt_bits[] = {
2700 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2701 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2704 #define tri-rt-mask_width 13
2705 #define tri-rt-mask_height 13
2706 static unsigned char tri-rt-mask_bits[] = {
2707 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2708 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2711 image create bitmap tri-dn -background black -foreground blue -data {
2712 #define tri-dn_width 13
2713 #define tri-dn_height 13
2714 static unsigned char tri-dn_bits[] = {
2715 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2716 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2719 #define tri-dn-mask_width 13
2720 #define tri-dn-mask_height 13
2721 static unsigned char tri-dn-mask_bits[] = {
2722 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2723 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2727 image create bitmap reficon-T -background black -foreground yellow -data {
2728 #define tagicon_width 13
2729 #define tagicon_height 9
2730 static unsigned char tagicon_bits[] = {
2731 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2732 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2734 #define tagicon-mask_width 13
2735 #define tagicon-mask_height 9
2736 static unsigned char tagicon-mask_bits[] = {
2737 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2738 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2741 #define headicon_width 13
2742 #define headicon_height 9
2743 static unsigned char headicon_bits[] = {
2744 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2745 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2748 #define headicon-mask_width 13
2749 #define headicon-mask_height 9
2750 static unsigned char headicon-mask_bits[] = {
2751 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2752 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2754 image create bitmap reficon-H -background black -foreground green \
2755 -data $rectdata -maskdata $rectmask
2756 image create bitmap reficon-o -background black -foreground "#ddddff" \
2757 -data $rectdata -maskdata $rectmask
2759 proc init_flist {first} {
2760 global cflist cflist_top difffilestart
2762 $cflist conf -state normal
2763 $cflist delete 0.0 end
2765 $cflist insert end $first
2767 $cflist tag add highlight 1.0 "1.0 lineend"
2769 catch {unset cflist_top}
2771 $cflist conf -state disabled
2772 set difffilestart {}
2775 proc highlight_tag {f} {
2776 global highlight_paths
2778 foreach p $highlight_paths {
2779 if {[string match $p $f]} {
2786 proc highlight_filelist {} {
2787 global cmitmode cflist
2789 $cflist conf -state normal
2790 if {$cmitmode ne "tree"} {
2791 set end [lindex [split [$cflist index end] .] 0]
2792 for {set l 2} {$l < $end} {incr l} {
2793 set line [$cflist get $l.0 "$l.0 lineend"]
2794 if {[highlight_tag $line] ne {}} {
2795 $cflist tag add bold $l.0 "$l.0 lineend"
2801 $cflist conf -state disabled
2804 proc unhighlight_filelist {} {
2807 $cflist conf -state normal
2808 $cflist tag remove bold 1.0 end
2809 $cflist conf -state disabled
2812 proc add_flist {fl} {
2815 $cflist conf -state normal
2817 $cflist insert end "\n"
2818 $cflist insert end $f [highlight_tag $f]
2820 $cflist conf -state disabled
2823 proc sel_flist {w x y} {
2824 global ctext difffilestart cflist cflist_top cmitmode
2826 if {$cmitmode eq "tree"} return
2827 if {![info exists cflist_top]} return
2828 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2829 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2830 $cflist tag add highlight $l.0 "$l.0 lineend"
2835 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2839 proc pop_flist_menu {w X Y x y} {
2840 global ctext cflist cmitmode flist_menu flist_menu_file
2841 global treediffs diffids
2844 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2846 if {$cmitmode eq "tree"} {
2847 set e [linetoelt $l]
2848 if {[string index $e end] eq "/"} return
2850 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2852 set flist_menu_file $e
2853 set xdiffstate "normal"
2854 if {$cmitmode eq "tree"} {
2855 set xdiffstate "disabled"
2857 # Disable "External diff" item in tree mode
2858 $flist_menu entryconf 2 -state $xdiffstate
2859 tk_popup $flist_menu $X $Y
2862 proc flist_hl {only} {
2863 global flist_menu_file findstring gdttype
2865 set x [shellquote $flist_menu_file]
2866 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2869 append findstring " " $x
2871 set gdttype [mc "touching paths:"]
2874 proc save_file_from_commit {filename output what} {
2877 if {[catch {exec git show $filename -- > $output} err]} {
2878 if {[string match "fatal: bad revision *" $err]} {
2881 error_popup "Error getting \"$filename\" from $what: $err"
2887 proc external_diff_get_one_file {diffid filename diffdir} {
2888 global nullid nullid2 nullfile
2891 if {$diffid == $nullid} {
2892 set difffile [file join [file dirname $gitdir] $filename]
2893 if {[file exists $difffile]} {
2898 if {$diffid == $nullid2} {
2899 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
2900 return [save_file_from_commit :$filename $difffile index]
2902 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
2903 return [save_file_from_commit $diffid:$filename $difffile \
2907 proc external_diff {} {
2908 global gitktmpdir nullid nullid2
2909 global flist_menu_file
2912 global gitdir extdifftool
2914 if {[llength $diffids] == 1} {
2915 # no reference commit given
2916 set diffidto [lindex $diffids 0]
2917 if {$diffidto eq $nullid} {
2918 # diffing working copy with index
2919 set diffidfrom $nullid2
2920 } elseif {$diffidto eq $nullid2} {
2921 # diffing index with HEAD
2922 set diffidfrom "HEAD"
2924 # use first parent commit
2925 global parentlist selectedline
2926 set diffidfrom [lindex $parentlist $selectedline 0]
2929 set diffidfrom [lindex $diffids 0]
2930 set diffidto [lindex $diffids 1]
2933 # make sure that several diffs wont collide
2934 if {![info exists gitktmpdir]} {
2935 set gitktmpdir [file join [file dirname $gitdir] \
2936 [format ".gitk-tmp.%s" [pid]]]
2937 if {[catch {file mkdir $gitktmpdir} err]} {
2938 error_popup "Error creating temporary directory $gitktmpdir: $err"
2945 set diffdir [file join $gitktmpdir $diffnum]
2946 if {[catch {file mkdir $diffdir} err]} {
2947 error_popup "Error creating temporary directory $diffdir: $err"
2951 # gather files to diff
2952 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
2953 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
2955 if {$difffromfile ne {} && $difftofile ne {}} {
2956 set cmd [concat | [shellsplit $extdifftool] \
2957 [list $difffromfile $difftofile]]
2958 if {[catch {set fl [open $cmd r]} err]} {
2959 file delete -force $diffdir
2960 error_popup [mc "$extdifftool: command failed: $err"]
2962 fconfigure $fl -blocking 0
2963 filerun $fl [list delete_at_eof $fl $diffdir]
2968 # delete $dir when we see eof on $f (presumably because the child has exited)
2969 proc delete_at_eof {f dir} {
2970 while {[gets $f line] >= 0} {}
2972 if {[catch {close $f} err]} {
2973 error_popup "External diff viewer failed: $err"
2975 file delete -force $dir
2981 # Functions for adding and removing shell-type quoting
2983 proc shellquote {str} {
2984 if {![string match "*\['\"\\ \t]*" $str]} {
2987 if {![string match "*\['\"\\]*" $str]} {
2990 if {![string match "*'*" $str]} {
2993 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2996 proc shellarglist {l} {
3002 append str [shellquote $a]
3007 proc shelldequote {str} {
3012 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3013 append ret [string range $str $used end]
3014 set used [string length $str]
3017 set first [lindex $first 0]
3018 set ch [string index $str $first]
3019 if {$first > $used} {
3020 append ret [string range $str $used [expr {$first - 1}]]
3023 if {$ch eq " " || $ch eq "\t"} break
3026 set first [string first "'" $str $used]
3028 error "unmatched single-quote"
3030 append ret [string range $str $used [expr {$first - 1}]]
3035 if {$used >= [string length $str]} {
3036 error "trailing backslash"
3038 append ret [string index $str $used]
3043 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3044 error "unmatched double-quote"
3046 set first [lindex $first 0]
3047 set ch [string index $str $first]
3048 if {$first > $used} {
3049 append ret [string range $str $used [expr {$first - 1}]]
3052 if {$ch eq "\""} break
3054 append ret [string index $str $used]
3058 return [list $used $ret]
3061 proc shellsplit {str} {
3064 set str [string trimleft $str]
3065 if {$str eq {}} break
3066 set dq [shelldequote $str]
3067 set n [lindex $dq 0]
3068 set word [lindex $dq 1]
3069 set str [string range $str $n end]
3075 # Code to implement multiple views
3077 proc newview {ishighlight} {
3078 global nextviewnum newviewname newviewperm newishighlight
3079 global newviewargs revtreeargs viewargscmd newviewargscmd curview
3081 set newishighlight $ishighlight
3083 if {[winfo exists $top]} {
3087 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3088 set newviewperm($nextviewnum) 0
3089 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
3090 set newviewargscmd($nextviewnum) $viewargscmd($curview)
3091 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3096 global viewname viewperm newviewname newviewperm
3097 global viewargs newviewargs viewargscmd newviewargscmd
3099 set top .gitkvedit-$curview
3100 if {[winfo exists $top]} {
3104 set newviewname($curview) $viewname($curview)
3105 set newviewperm($curview) $viewperm($curview)
3106 set newviewargs($curview) [shellarglist $viewargs($curview)]
3107 set newviewargscmd($curview) $viewargscmd($curview)
3108 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
3111 proc vieweditor {top n title} {
3112 global newviewname newviewperm viewfiles bgcolor
3115 wm title $top $title
3116 label $top.nl -text [mc "Name"]
3117 entry $top.name -width 20 -textvariable newviewname($n)
3118 grid $top.nl $top.name -sticky w -pady 5
3119 checkbutton $top.perm -text [mc "Remember this view"] \
3120 -variable newviewperm($n)
3121 grid $top.perm - -pady 5 -sticky w
3122 message $top.al -aspect 1000 \
3123 -text [mc "Commits to include (arguments to git log):"]
3124 grid $top.al - -sticky w -pady 5
3125 entry $top.args -width 50 -textvariable newviewargs($n) \
3126 -background $bgcolor
3127 grid $top.args - -sticky ew -padx 5
3129 message $top.ac -aspect 1000 \
3130 -text [mc "Command to generate more commits to include:"]
3131 grid $top.ac - -sticky w -pady 5
3132 entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
3134 grid $top.argscmd - -sticky ew -padx 5
3136 message $top.l -aspect 1000 \
3137 -text [mc "Enter files and directories to include, one per line:"]
3138 grid $top.l - -sticky w
3139 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
3140 if {[info exists viewfiles($n)]} {
3141 foreach f $viewfiles($n) {
3142 $top.t insert end $f
3143 $top.t insert end "\n"
3145 $top.t delete {end - 1c} end
3146 $top.t mark set insert 0.0
3148 grid $top.t - -sticky ew -padx 5
3150 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3151 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3152 grid $top.buts.ok $top.buts.can
3153 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3154 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3155 grid $top.buts - -pady 10 -sticky ew
3159 proc doviewmenu {m first cmd op argv} {
3160 set nmenu [$m index end]
3161 for {set i $first} {$i <= $nmenu} {incr i} {
3162 if {[$m entrycget $i -command] eq $cmd} {
3163 eval $m $op $i $argv
3169 proc allviewmenus {n op args} {
3172 doviewmenu .bar.view 5 [list showview $n] $op $args
3173 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3176 proc newviewok {top n} {
3177 global nextviewnum newviewperm newviewname newishighlight
3178 global viewname viewfiles viewperm selectedview curview
3179 global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
3182 set newargs [shellsplit $newviewargs($n)]
3184 error_popup "[mc "Error in commit selection arguments:"] $err"
3190 foreach f [split [$top.t get 0.0 end] "\n"] {
3191 set ft [string trim $f]
3196 if {![info exists viewfiles($n)]} {
3197 # creating a new view
3199 set viewname($n) $newviewname($n)
3200 set viewperm($n) $newviewperm($n)
3201 set viewfiles($n) $files
3202 set viewargs($n) $newargs
3203 set viewargscmd($n) $newviewargscmd($n)
3205 if {!$newishighlight} {
3208 run addvhighlight $n
3211 # editing an existing view
3212 set viewperm($n) $newviewperm($n)
3213 if {$newviewname($n) ne $viewname($n)} {
3214 set viewname($n) $newviewname($n)
3215 doviewmenu .bar.view 5 [list showview $n] \
3216 entryconf [list -label $viewname($n)]
3217 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3218 # entryconf [list -label $viewname($n) -value $viewname($n)]
3220 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3221 $newviewargscmd($n) ne $viewargscmd($n)} {
3222 set viewfiles($n) $files
3223 set viewargs($n) $newargs
3224 set viewargscmd($n) $newviewargscmd($n)
3225 if {$curview == $n} {
3230 catch {destroy $top}
3234 global curview viewperm hlview selectedhlview
3236 if {$curview == 0} return
3237 if {[info exists hlview] && $hlview == $curview} {
3238 set selectedhlview [mc "None"]
3241 allviewmenus $curview delete
3242 set viewperm($curview) 0
3246 proc addviewmenu {n} {
3247 global viewname viewhlmenu
3249 .bar.view add radiobutton -label $viewname($n) \
3250 -command [list showview $n] -variable selectedview -value $n
3251 #$viewhlmenu add radiobutton -label $viewname($n) \
3252 # -command [list addvhighlight $n] -variable selectedhlview
3256 global curview cached_commitrow ordertok
3257 global displayorder parentlist rowidlist rowisopt rowfinal
3258 global colormap rowtextx nextcolor canvxmax
3259 global numcommits viewcomplete
3260 global selectedline currentid canv canvy0
3262 global pending_select mainheadid
3265 global hlview selectedhlview commitinterest
3267 if {$n == $curview} return
3269 set ymax [lindex [$canv cget -scrollregion] 3]
3270 set span [$canv yview]
3271 set ytop [expr {[lindex $span 0] * $ymax}]
3272 set ybot [expr {[lindex $span 1] * $ymax}]
3273 set yscreen [expr {($ybot - $ytop) / 2}]
3274 if {$selectedline ne {}} {
3275 set selid $currentid
3276 set y [yc $selectedline]
3277 if {$ytop < $y && $y < $ybot} {
3278 set yscreen [expr {$y - $ytop}]
3280 } elseif {[info exists pending_select]} {
3281 set selid $pending_select
3282 unset pending_select
3286 catch {unset treediffs}
3288 if {[info exists hlview] && $hlview == $n} {
3290 set selectedhlview [mc "None"]
3292 catch {unset commitinterest}
3293 catch {unset cached_commitrow}
3294 catch {unset ordertok}
3298 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3299 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3302 if {![info exists viewcomplete($n)]} {
3304 set pending_select $selid
3315 set numcommits $commitidx($n)
3317 catch {unset colormap}
3318 catch {unset rowtextx}
3320 set canvxmax [$canv cget -width]
3326 if {$selid ne {} && [commitinview $selid $n]} {
3327 set row [rowofcommit $selid]
3328 # try to get the selected row in the same position on the screen
3329 set ymax [lindex [$canv cget -scrollregion] 3]
3330 set ytop [expr {[yc $row] - $yscreen}]
3334 set yf [expr {$ytop * 1.0 / $ymax}]
3336 allcanvs yview moveto $yf
3340 } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
3341 selectline [rowofcommit $mainheadid] 1
3342 } elseif {!$viewcomplete($n)} {
3344 set pending_select $selid
3346 set pending_select $mainheadid
3349 set row [first_real_row]
3350 if {$row < $numcommits} {
3354 if {!$viewcomplete($n)} {
3355 if {$numcommits == 0} {
3356 show_status [mc "Reading commits..."]
3358 } elseif {$numcommits == 0} {
3359 show_status [mc "No commits selected"]
3363 # Stuff relating to the highlighting facility
3365 proc ishighlighted {id} {
3366 global vhighlights fhighlights nhighlights rhighlights
3368 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3369 return $nhighlights($id)
3371 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3372 return $vhighlights($id)
3374 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
3375 return $fhighlights($id)
3377 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
3378 return $rhighlights($id)
3383 proc bolden {row font} {
3384 global canv linehtag selectedline boldrows
3386 lappend boldrows $row
3387 $canv itemconf $linehtag($row) -font $font
3388 if {$row == $selectedline} {
3390 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
3391 -outline {{}} -tags secsel \
3392 -fill [$canv cget -selectbackground]]
3397 proc bolden_name {row font} {
3398 global canv2 linentag selectedline boldnamerows
3400 lappend boldnamerows $row
3401 $canv2 itemconf $linentag($row) -font $font
3402 if {$row == $selectedline} {
3403 $canv2 delete secsel
3404 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
3405 -outline {{}} -tags secsel \
3406 -fill [$canv2 cget -selectbackground]]
3415 foreach row $boldrows {
3416 if {![ishighlighted [commitonrow $row]]} {
3417 bolden $row mainfont
3419 lappend stillbold $row
3422 set boldrows $stillbold
3425 proc addvhighlight {n} {
3426 global hlview viewcomplete curview vhl_done commitidx
3428 if {[info exists hlview]} {
3432 if {$n != $curview && ![info exists viewcomplete($n)]} {
3435 set vhl_done $commitidx($hlview)
3436 if {$vhl_done > 0} {
3441 proc delvhighlight {} {
3442 global hlview vhighlights
3444 if {![info exists hlview]} return
3446 catch {unset vhighlights}
3450 proc vhighlightmore {} {
3451 global hlview vhl_done commitidx vhighlights curview
3453 set max $commitidx($hlview)
3454 set vr [visiblerows]
3455 set r0 [lindex $vr 0]
3456 set r1 [lindex $vr 1]
3457 for {set i $vhl_done} {$i < $max} {incr i} {
3458 set id [commitonrow $i $hlview]
3459 if {[commitinview $id $curview]} {
3460 set row [rowofcommit $id]
3461 if {$r0 <= $row && $row <= $r1} {
3462 if {![highlighted $row]} {
3463 bolden $row mainfontbold
3465 set vhighlights($id) 1
3473 proc askvhighlight {row id} {
3474 global hlview vhighlights iddrawn
3476 if {[commitinview $id $hlview]} {
3477 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3478 bolden $row mainfontbold
3480 set vhighlights($id) 1
3482 set vhighlights($id) 0
3486 proc hfiles_change {} {
3487 global highlight_files filehighlight fhighlights fh_serial
3488 global highlight_paths gdttype
3490 if {[info exists filehighlight]} {
3491 # delete previous highlights
3492 catch {close $filehighlight}
3494 catch {unset fhighlights}
3496 unhighlight_filelist
3498 set highlight_paths {}
3499 after cancel do_file_hl $fh_serial
3501 if {$highlight_files ne {}} {
3502 after 300 do_file_hl $fh_serial
3506 proc gdttype_change {name ix op} {
3507 global gdttype highlight_files findstring findpattern
3510 if {$findstring ne {}} {
3511 if {$gdttype eq [mc "containing:"]} {
3512 if {$highlight_files ne {}} {
3513 set highlight_files {}
3518 if {$findpattern ne {}} {
3522 set highlight_files $findstring
3527 # enable/disable findtype/findloc menus too
3530 proc find_change {name ix op} {
3531 global gdttype findstring highlight_files
3534 if {$gdttype eq [mc "containing:"]} {
3537 if {$highlight_files ne $findstring} {
3538 set highlight_files $findstring
3545 proc findcom_change args {
3546 global nhighlights boldnamerows
3547 global findpattern findtype findstring gdttype
3550 # delete previous highlights, if any
3551 foreach row $boldnamerows {
3552 bolden_name $row mainfont
3555 catch {unset nhighlights}
3558 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3560 } elseif {$findtype eq [mc "Regexp"]} {
3561 set findpattern $findstring
3563 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3565 set findpattern "*$e*"
3569 proc makepatterns {l} {
3572 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3573 if {[string index $ee end] eq "/"} {
3583 proc do_file_hl {serial} {
3584 global highlight_files filehighlight highlight_paths gdttype fhl_list
3586 if {$gdttype eq [mc "touching paths:"]} {
3587 if {[catch {set paths [shellsplit $highlight_files]}]} return
3588 set highlight_paths [makepatterns $paths]
3590 set gdtargs [concat -- $paths]
3591 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3592 set gdtargs [list "-S$highlight_files"]
3594 # must be "containing:", i.e. we're searching commit info
3597 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3598 set filehighlight [open $cmd r+]
3599 fconfigure $filehighlight -blocking 0
3600 filerun $filehighlight readfhighlight
3606 proc flushhighlights {} {
3607 global filehighlight fhl_list
3609 if {[info exists filehighlight]} {
3611 puts $filehighlight ""
3612 flush $filehighlight
3616 proc askfilehighlight {row id} {
3617 global filehighlight fhighlights fhl_list
3619 lappend fhl_list $id
3620 set fhighlights($id) -1
3621 puts $filehighlight $id
3624 proc readfhighlight {} {
3625 global filehighlight fhighlights curview iddrawn
3626 global fhl_list find_dirn
3628 if {![info exists filehighlight]} {
3632 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3633 set line [string trim $line]
3634 set i [lsearch -exact $fhl_list $line]
3635 if {$i < 0} continue
3636 for {set j 0} {$j < $i} {incr j} {
3637 set id [lindex $fhl_list $j]
3638 set fhighlights($id) 0
3640 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3641 if {$line eq {}} continue
3642 if {![commitinview $line $curview]} continue
3643 set row [rowofcommit $line]
3644 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3645 bolden $row mainfontbold
3647 set fhighlights($line) 1
3649 if {[eof $filehighlight]} {
3651 puts "oops, git diff-tree died"
3652 catch {close $filehighlight}
3656 if {[info exists find_dirn]} {
3662 proc doesmatch {f} {
3663 global findtype findpattern
3665 if {$findtype eq [mc "Regexp"]} {
3666 return [regexp $findpattern $f]
3667 } elseif {$findtype eq [mc "IgnCase"]} {
3668 return [string match -nocase $findpattern $f]
3670 return [string match $findpattern $f]
3674 proc askfindhighlight {row id} {
3675 global nhighlights commitinfo iddrawn
3677 global markingmatches
3679 if {![info exists commitinfo($id)]} {
3682 set info $commitinfo($id)
3684 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3685 foreach f $info ty $fldtypes {
3686 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3688 if {$ty eq [mc "Author"]} {
3695 if {$isbold && [info exists iddrawn($id)]} {
3696 if {![ishighlighted $id]} {
3697 bolden $row mainfontbold
3699 bolden_name $row mainfontbold
3702 if {$markingmatches} {
3703 markrowmatches $row $id
3706 set nhighlights($id) $isbold
3709 proc markrowmatches {row id} {
3710 global canv canv2 linehtag linentag commitinfo findloc
3712 set headline [lindex $commitinfo($id) 0]
3713 set author [lindex $commitinfo($id) 1]
3714 $canv delete match$row
3715 $canv2 delete match$row
3716 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3717 set m [findmatches $headline]
3719 markmatches $canv $row $headline $linehtag($row) $m \
3720 [$canv itemcget $linehtag($row) -font] $row
3723 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3724 set m [findmatches $author]
3726 markmatches $canv2 $row $author $linentag($row) $m \
3727 [$canv2 itemcget $linentag($row) -font] $row
3732 proc vrel_change {name ix op} {
3733 global highlight_related
3736 if {$highlight_related ne [mc "None"]} {
3741 # prepare for testing whether commits are descendents or ancestors of a
3742 proc rhighlight_sel {a} {
3743 global descendent desc_todo ancestor anc_todo
3744 global highlight_related
3746 catch {unset descendent}
3747 set desc_todo [list $a]
3748 catch {unset ancestor}
3749 set anc_todo [list $a]
3750 if {$highlight_related ne [mc "None"]} {
3756 proc rhighlight_none {} {
3759 catch {unset rhighlights}
3763 proc is_descendent {a} {
3764 global curview children descendent desc_todo
3767 set la [rowofcommit $a]
3771 for {set i 0} {$i < [llength $todo]} {incr i} {
3772 set do [lindex $todo $i]
3773 if {[rowofcommit $do] < $la} {
3774 lappend leftover $do
3777 foreach nk $children($v,$do) {
3778 if {![info exists descendent($nk)]} {
3779 set descendent($nk) 1
3787 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3791 set descendent($a) 0
3792 set desc_todo $leftover
3795 proc is_ancestor {a} {
3796 global curview parents ancestor anc_todo
3799 set la [rowofcommit $a]
3803 for {set i 0} {$i < [llength $todo]} {incr i} {
3804 set do [lindex $todo $i]
3805 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3806 lappend leftover $do
3809 foreach np $parents($v,$do) {
3810 if {![info exists ancestor($np)]} {
3819 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3824 set anc_todo $leftover
3827 proc askrelhighlight {row id} {
3828 global descendent highlight_related iddrawn rhighlights
3829 global selectedline ancestor
3831 if {$selectedline eq {}} return
3833 if {$highlight_related eq [mc "Descendant"] ||
3834 $highlight_related eq [mc "Not descendant"]} {
3835 if {![info exists descendent($id)]} {
3838 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
3841 } elseif {$highlight_related eq [mc "Ancestor"] ||
3842 $highlight_related eq [mc "Not ancestor"]} {
3843 if {![info exists ancestor($id)]} {
3846 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3850 if {[info exists iddrawn($id)]} {
3851 if {$isbold && ![ishighlighted $id]} {
3852 bolden $row mainfontbold
3855 set rhighlights($id) $isbold
3858 # Graph layout functions
3860 proc shortids {ids} {
3863 if {[llength $id] > 1} {
3864 lappend res [shortids $id]
3865 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3866 lappend res [string range $id 0 7]
3877 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3878 if {($n & $mask) != 0} {
3879 set ret [concat $ret $o]
3881 set o [concat $o $o]
3886 proc ordertoken {id} {
3887 global ordertok curview varcid varcstart varctok curview parents children
3888 global nullid nullid2
3890 if {[info exists ordertok($id)]} {
3891 return $ordertok($id)
3896 if {[info exists varcid($curview,$id)]} {
3897 set a $varcid($curview,$id)
3898 set p [lindex $varcstart($curview) $a]
3900 set p [lindex $children($curview,$id) 0]
3902 if {[info exists ordertok($p)]} {
3903 set tok $ordertok($p)
3906 set id [first_real_child $curview,$p]
3909 set tok [lindex $varctok($curview) $varcid($curview,$p)]
3912 if {[llength $parents($curview,$id)] == 1} {
3913 lappend todo [list $p {}]
3915 set j [lsearch -exact $parents($curview,$id) $p]
3917 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3919 lappend todo [list $p [strrep $j]]
3922 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3923 set p [lindex $todo $i 0]
3924 append tok [lindex $todo $i 1]
3925 set ordertok($p) $tok
3927 set ordertok($origid) $tok
3931 # Work out where id should go in idlist so that order-token
3932 # values increase from left to right
3933 proc idcol {idlist id {i 0}} {
3934 set t [ordertoken $id]
3938 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3939 if {$i > [llength $idlist]} {
3940 set i [llength $idlist]
3942 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3945 if {$t > [ordertoken [lindex $idlist $i]]} {
3946 while {[incr i] < [llength $idlist] &&
3947 $t >= [ordertoken [lindex $idlist $i]]} {}
3953 proc initlayout {} {
3954 global rowidlist rowisopt rowfinal displayorder parentlist
3955 global numcommits canvxmax canv
3957 global colormap rowtextx
3966 set canvxmax [$canv cget -width]
3967 catch {unset colormap}
3968 catch {unset rowtextx}
3972 proc setcanvscroll {} {
3973 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3974 global lastscrollset lastscrollrows
3976 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3977 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3978 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3979 $canv3 conf -scrollregion [list 0 0 0 $ymax]
3980 set lastscrollset [clock clicks -milliseconds]
3981 set lastscrollrows $numcommits
3984 proc visiblerows {} {
3985 global canv numcommits linespc
3987 set ymax [lindex [$canv cget -scrollregion] 3]
3988 if {$ymax eq {} || $ymax == 0} return
3990 set y0 [expr {int([lindex $f 0] * $ymax)}]
3991 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3995 set y1 [expr {int([lindex $f 1] * $ymax)}]
3996 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3997 if {$r1 >= $numcommits} {
3998 set r1 [expr {$numcommits - 1}]
4000 return [list $r0 $r1]
4003 proc layoutmore {} {
4004 global commitidx viewcomplete curview
4005 global numcommits pending_select curview
4006 global lastscrollset lastscrollrows commitinterest
4008 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4009 [clock clicks -milliseconds] - $lastscrollset > 500} {
4012 if {[info exists pending_select] &&
4013 [commitinview $pending_select $curview]} {
4014 selectline [rowofcommit $pending_select] 1
4019 proc doshowlocalchanges {} {
4020 global curview mainheadid
4022 if {$mainheadid eq {}} return
4023 if {[commitinview $mainheadid $curview]} {
4026 lappend commitinterest($mainheadid) {dodiffindex}
4030 proc dohidelocalchanges {} {
4031 global nullid nullid2 lserial curview
4033 if {[commitinview $nullid $curview]} {
4034 removefakerow $nullid
4036 if {[commitinview $nullid2 $curview]} {
4037 removefakerow $nullid2
4042 # spawn off a process to do git diff-index --cached HEAD
4043 proc dodiffindex {} {
4044 global lserial showlocalchanges
4047 if {!$showlocalchanges || !$isworktree} return
4049 set fd [open "|git diff-index --cached HEAD" r]
4050 fconfigure $fd -blocking 0
4051 filerun $fd [list readdiffindex $fd $lserial]
4054 proc readdiffindex {fd serial} {
4055 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4058 if {[gets $fd line] < 0} {
4064 # we only need to see one line and we don't really care what it says...
4067 if {$serial != $lserial} {
4071 # now see if there are any local changes not checked in to the index
4072 set fd [open "|git diff-files" r]
4073 fconfigure $fd -blocking 0
4074 filerun $fd [list readdifffiles $fd $serial]
4076 if {$isdiff && ![commitinview $nullid2 $curview]} {
4077 # add the line for the changes in the index to the graph
4078 set hl [mc "Local changes checked in to index but not committed"]
4079 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4080 set commitdata($nullid2) "\n $hl\n"
4081 if {[commitinview $nullid $curview]} {
4082 removefakerow $nullid
4084 insertfakerow $nullid2 $mainheadid
4085 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4086 removefakerow $nullid2
4091 proc readdifffiles {fd serial} {
4092 global mainheadid nullid nullid2 curview
4093 global commitinfo commitdata lserial
4096 if {[gets $fd line] < 0} {
4102 # we only need to see one line and we don't really care what it says...
4105 if {$serial != $lserial} {
4109 if {$isdiff && ![commitinview $nullid $curview]} {
4110 # add the line for the local diff to the graph
4111 set hl [mc "Local uncommitted changes, not checked in to index"]
4112 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4113 set commitdata($nullid) "\n $hl\n"
4114 if {[commitinview $nullid2 $curview]} {
4119 insertfakerow $nullid $p
4120 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4121 removefakerow $nullid
4126 proc nextuse {id row} {
4127 global curview children
4129 if {[info exists children($curview,$id)]} {
4130 foreach kid $children($curview,$id) {
4131 if {![commitinview $kid $curview]} {
4134 if {[rowofcommit $kid] > $row} {
4135 return [rowofcommit $kid]
4139 if {[commitinview $id $curview]} {
4140 return [rowofcommit $id]
4145 proc prevuse {id row} {
4146 global curview children
4149 if {[info exists children($curview,$id)]} {
4150 foreach kid $children($curview,$id) {
4151 if {![commitinview $kid $curview]} break
4152 if {[rowofcommit $kid] < $row} {
4153 set ret [rowofcommit $kid]
4160 proc make_idlist {row} {
4161 global displayorder parentlist uparrowlen downarrowlen mingaplen
4162 global commitidx curview children
4164 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4168 set ra [expr {$row - $downarrowlen}]
4172 set rb [expr {$row + $uparrowlen}]
4173 if {$rb > $commitidx($curview)} {
4174 set rb $commitidx($curview)
4176 make_disporder $r [expr {$rb + 1}]
4178 for {} {$r < $ra} {incr r} {
4179 set nextid [lindex $displayorder [expr {$r + 1}]]
4180 foreach p [lindex $parentlist $r] {
4181 if {$p eq $nextid} continue
4182 set rn [nextuse $p $r]
4184 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4185 lappend ids [list [ordertoken $p] $p]
4189 for {} {$r < $row} {incr r} {
4190 set nextid [lindex $displayorder [expr {$r + 1}]]
4191 foreach p [lindex $parentlist $r] {
4192 if {$p eq $nextid} continue
4193 set rn [nextuse $p $r]
4194 if {$rn < 0 || $rn >= $row} {
4195 lappend ids [list [ordertoken $p] $p]
4199 set id [lindex $displayorder $row]
4200 lappend ids [list [ordertoken $id] $id]
4202 foreach p [lindex $parentlist $r] {
4203 set firstkid [lindex $children($curview,$p) 0]
4204 if {[rowofcommit $firstkid] < $row} {
4205 lappend ids [list [ordertoken $p] $p]
4209 set id [lindex $displayorder $r]
4211 set firstkid [lindex $children($curview,$id) 0]
4212 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4213 lappend ids [list [ordertoken $id] $id]
4218 foreach idx [lsort -unique $ids] {
4219 lappend idlist [lindex $idx 1]
4224 proc rowsequal {a b} {
4225 while {[set i [lsearch -exact $a {}]] >= 0} {
4226 set a [lreplace $a $i $i]
4228 while {[set i [lsearch -exact $b {}]] >= 0} {
4229 set b [lreplace $b $i $i]
4231 return [expr {$a eq $b}]
4234 proc makeupline {id row rend col} {
4235 global rowidlist uparrowlen downarrowlen mingaplen
4237 for {set r $rend} {1} {set r $rstart} {
4238 set rstart [prevuse $id $r]
4239 if {$rstart < 0} return
4240 if {$rstart < $row} break
4242 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4243 set rstart [expr {$rend - $uparrowlen - 1}]
4245 for {set r $rstart} {[incr r] <= $row} {} {
4246 set idlist [lindex $rowidlist $r]
4247 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4248 set col [idcol $idlist $id $col]
4249 lset rowidlist $r [linsert $idlist $col $id]
4255 proc layoutrows {row endrow} {
4256 global rowidlist rowisopt rowfinal displayorder
4257 global uparrowlen downarrowlen maxwidth mingaplen
4258 global children parentlist
4259 global commitidx viewcomplete curview
4261 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4264 set rm1 [expr {$row - 1}]
4265 foreach id [lindex $rowidlist $rm1] {
4270 set final [lindex $rowfinal $rm1]
4272 for {} {$row < $endrow} {incr row} {
4273 set rm1 [expr {$row - 1}]
4274 if {$rm1 < 0 || $idlist eq {}} {
4275 set idlist [make_idlist $row]
4278 set id [lindex $displayorder $rm1]
4279 set col [lsearch -exact $idlist $id]
4280 set idlist [lreplace $idlist $col $col]
4281 foreach p [lindex $parentlist $rm1] {
4282 if {[lsearch -exact $idlist $p] < 0} {
4283 set col [idcol $idlist $p $col]
4284 set idlist [linsert $idlist $col $p]
4285 # if not the first child, we have to insert a line going up
4286 if {$id ne [lindex $children($curview,$p) 0]} {
4287 makeupline $p $rm1 $row $col
4291 set id [lindex $displayorder $row]
4292 if {$row > $downarrowlen} {
4293 set termrow [expr {$row - $downarrowlen - 1}]
4294 foreach p [lindex $parentlist $termrow] {
4295 set i [lsearch -exact $idlist $p]
4296 if {$i < 0} continue
4297 set nr [nextuse $p $termrow]
4298 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4299 set idlist [lreplace $idlist $i $i]
4303 set col [lsearch -exact $idlist $id]
4305 set col [idcol $idlist $id]
4306 set idlist [linsert $idlist $col $id]
4307 if {$children($curview,$id) ne {}} {
4308 makeupline $id $rm1 $row $col
4311 set r [expr {$row + $uparrowlen - 1}]
4312 if {$r < $commitidx($curview)} {
4314 foreach p [lindex $parentlist $r] {
4315 if {[lsearch -exact $idlist $p] >= 0} continue
4316 set fk [lindex $children($curview,$p) 0]
4317 if {[rowofcommit $fk] < $row} {
4318 set x [idcol $idlist $p $x]
4319 set idlist [linsert $idlist $x $p]
4322 if {[incr r] < $commitidx($curview)} {
4323 set p [lindex $displayorder $r]
4324 if {[lsearch -exact $idlist $p] < 0} {
4325 set fk [lindex $children($curview,$p) 0]
4326 if {$fk ne {} && [rowofcommit $fk] < $row} {
4327 set x [idcol $idlist $p $x]
4328 set idlist [linsert $idlist $x $p]
4334 if {$final && !$viewcomplete($curview) &&
4335 $row + $uparrowlen + $mingaplen + $downarrowlen
4336 >= $commitidx($curview)} {
4339 set l [llength $rowidlist]
4341 lappend rowidlist $idlist
4343 lappend rowfinal $final
4344 } elseif {$row < $l} {
4345 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4346 lset rowidlist $row $idlist
4349 lset rowfinal $row $final
4351 set pad [ntimes [expr {$row - $l}] {}]
4352 set rowidlist [concat $rowidlist $pad]
4353 lappend rowidlist $idlist
4354 set rowfinal [concat $rowfinal $pad]
4355 lappend rowfinal $final
4356 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4362 proc changedrow {row} {
4363 global displayorder iddrawn rowisopt need_redisplay
4365 set l [llength $rowisopt]
4367 lset rowisopt $row 0
4368 if {$row + 1 < $l} {
4369 lset rowisopt [expr {$row + 1}] 0
4370 if {$row + 2 < $l} {
4371 lset rowisopt [expr {$row + 2}] 0
4375 set id [lindex $displayorder $row]
4376 if {[info exists iddrawn($id)]} {
4377 set need_redisplay 1
4381 proc insert_pad {row col npad} {
4384 set pad [ntimes $npad {}]
4385 set idlist [lindex $rowidlist $row]
4386 set bef [lrange $idlist 0 [expr {$col - 1}]]
4387 set aft [lrange $idlist $col end]
4388 set i [lsearch -exact $aft {}]
4390 set aft [lreplace $aft $i $i]
4392 lset rowidlist $row [concat $bef $pad $aft]
4396 proc optimize_rows {row col endrow} {
4397 global rowidlist rowisopt displayorder curview children
4402 for {} {$row < $endrow} {incr row; set col 0} {
4403 if {[lindex $rowisopt $row]} continue
4405 set y0 [expr {$row - 1}]
4406 set ym [expr {$row - 2}]
4407 set idlist [lindex $rowidlist $row]
4408 set previdlist [lindex $rowidlist $y0]
4409 if {$idlist eq {} || $previdlist eq {}} continue
4411 set pprevidlist [lindex $rowidlist $ym]
4412 if {$pprevidlist eq {}} continue
4418 for {} {$col < [llength $idlist]} {incr col} {
4419 set id [lindex $idlist $col]
4420 if {[lindex $previdlist $col] eq $id} continue
4425 set x0 [lsearch -exact $previdlist $id]
4426 if {$x0 < 0} continue
4427 set z [expr {$x0 - $col}]
4431 set xm [lsearch -exact $pprevidlist $id]
4433 set z0 [expr {$xm - $x0}]
4437 # if row y0 is the first child of $id then it's not an arrow
4438 if {[lindex $children($curview,$id) 0] ne
4439 [lindex $displayorder $y0]} {
4443 if {!$isarrow && $id ne [lindex $displayorder $row] &&
4444 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4447 # Looking at lines from this row to the previous row,
4448 # make them go straight up if they end in an arrow on
4449 # the previous row; otherwise make them go straight up
4451 if {$z < -1 || ($z < 0 && $isarrow)} {
4452 # Line currently goes left too much;
4453 # insert pads in the previous row, then optimize it
4454 set npad [expr {-1 - $z + $isarrow}]
4455 insert_pad $y0 $x0 $npad
4457 optimize_rows $y0 $x0 $row
4459 set previdlist [lindex $rowidlist $y0]
4460 set x0 [lsearch -exact $previdlist $id]
4461 set z [expr {$x0 - $col}]
4463 set pprevidlist [lindex $rowidlist $ym]
4464 set xm [lsearch -exact $pprevidlist $id]
4465 set z0 [expr {$xm - $x0}]
4467 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4468 # Line currently goes right too much;
4469 # insert pads in this line
4470 set npad [expr {$z - 1 + $isarrow}]
4471 insert_pad $row $col $npad
4472 set idlist [lindex $rowidlist $row]
4474 set z [expr {$x0 - $col}]
4477 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4478 # this line links to its first child on row $row-2
4479 set id [lindex $displayorder $ym]
4480 set xc [lsearch -exact $pprevidlist $id]
4482 set z0 [expr {$xc - $x0}]
4485 # avoid lines jigging left then immediately right
4486 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4487 insert_pad $y0 $x0 1
4489 optimize_rows $y0 $x0 $row
4490 set previdlist [lindex $rowidlist $y0]
4494 # Find the first column that doesn't have a line going right
4495 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4496 set id [lindex $idlist $col]
4497 if {$id eq {}} break
4498 set x0 [lsearch -exact $previdlist $id]
4500 # check if this is the link to the first child
4501 set kid [lindex $displayorder $y0]
4502 if {[lindex $children($curview,$id) 0] eq $kid} {
4503 # it is, work out offset to child
4504 set x0 [lsearch -exact $previdlist $kid]
4507 if {$x0 <= $col} break
4509 # Insert a pad at that column as long as it has a line and
4510 # isn't the last column
4511 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4512 set idlist [linsert $idlist $col {}]
4513 lset rowidlist $row $idlist
4521 global canvx0 linespc
4522 return [expr {$canvx0 + $col * $linespc}]
4526 global canvy0 linespc
4527 return [expr {$canvy0 + $row * $linespc}]
4530 proc linewidth {id} {
4531 global thickerline lthickness
4534 if {[info exists thickerline] && $id eq $thickerline} {
4535 set wid [expr {2 * $lthickness}]
4540 proc rowranges {id} {
4541 global curview children uparrowlen downarrowlen
4544 set kids $children($curview,$id)
4550 foreach child $kids {
4551 if {![commitinview $child $curview]} break
4552 set row [rowofcommit $child]
4553 if {![info exists prev]} {
4554 lappend ret [expr {$row + 1}]
4556 if {$row <= $prevrow} {
4557 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4559 # see if the line extends the whole way from prevrow to row
4560 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4561 [lsearch -exact [lindex $rowidlist \
4562 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4563 # it doesn't, see where it ends
4564 set r [expr {$prevrow + $downarrowlen}]
4565 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4566 while {[incr r -1] > $prevrow &&
4567 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4569 while {[incr r] <= $row &&
4570 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4574 # see where it starts up again
4575 set r [expr {$row - $uparrowlen}]
4576 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4577 while {[incr r] < $row &&
4578 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4580 while {[incr r -1] >= $prevrow &&
4581 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4587 if {$child eq $id} {
4596 proc drawlineseg {id row endrow arrowlow} {
4597 global rowidlist displayorder iddrawn linesegs
4598 global canv colormap linespc curview maxlinelen parentlist
4600 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4601 set le [expr {$row + 1}]
4604 set c [lsearch -exact [lindex $rowidlist $le] $id]
4610 set x [lindex $displayorder $le]
4615 if {[info exists iddrawn($x)] || $le == $endrow} {
4616 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4632 if {[info exists linesegs($id)]} {
4633 set lines $linesegs($id)
4635 set r0 [lindex $li 0]
4637 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4647 set li [lindex $lines [expr {$i-1}]]
4648 set r1 [lindex $li 1]
4649 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4654 set x [lindex $cols [expr {$le - $row}]]
4655 set xp [lindex $cols [expr {$le - 1 - $row}]]
4656 set dir [expr {$xp - $x}]
4658 set ith [lindex $lines $i 2]
4659 set coords [$canv coords $ith]
4660 set ah [$canv itemcget $ith -arrow]
4661 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4662 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4663 if {$x2 ne {} && $x - $x2 == $dir} {
4664 set coords [lrange $coords 0 end-2]
4667 set coords [list [xc $le $x] [yc $le]]
4670 set itl [lindex $lines [expr {$i-1}] 2]
4671 set al [$canv itemcget $itl -arrow]
4672 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4673 } elseif {$arrowlow} {
4674 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4675 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4679 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4680 for {set y $le} {[incr y -1] > $row} {} {
4682 set xp [lindex $cols [expr {$y - 1 - $row}]]
4683 set ndir [expr {$xp - $x}]
4684 if {$dir != $ndir || $xp < 0} {
4685 lappend coords [xc $y $x] [yc $y]
4691 # join parent line to first child
4692 set ch [lindex $displayorder $row]
4693 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4695 puts "oops: drawlineseg: child $ch not on row $row"
4696 } elseif {$xc != $x} {
4697 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4698 set d [expr {int(0.5 * $linespc)}]
4701 set x2 [expr {$x1 - $d}]
4703 set x2 [expr {$x1 + $d}]
4706 set y1 [expr {$y2 + $d}]
4707 lappend coords $x1 $y1 $x2 $y2
4708 } elseif {$xc < $x - 1} {
4709 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4710 } elseif {$xc > $x + 1} {
4711 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4715 lappend coords [xc $row $x] [yc $row]
4717 set xn [xc $row $xp]
4719 lappend coords $xn $yn
4723 set t [$canv create line $coords -width [linewidth $id] \
4724 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4727 set lines [linsert $lines $i [list $row $le $t]]
4729 $canv coords $ith $coords
4730 if {$arrow ne $ah} {
4731 $canv itemconf $ith -arrow $arrow
4733 lset lines $i 0 $row
4736 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4737 set ndir [expr {$xo - $xp}]
4738 set clow [$canv coords $itl]
4739 if {$dir == $ndir} {
4740 set clow [lrange $clow 2 end]
4742 set coords [concat $coords $clow]
4744 lset lines [expr {$i-1}] 1 $le
4746 # coalesce two pieces
4748 set b [lindex $lines [expr {$i-1}] 0]
4749 set e [lindex $lines $i 1]
4750 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4752 $canv coords $itl $coords
4753 if {$arrow ne $al} {
4754 $canv itemconf $itl -arrow $arrow
4758 set linesegs($id) $lines
4762 proc drawparentlinks {id row} {
4763 global rowidlist canv colormap curview parentlist
4764 global idpos linespc
4766 set rowids [lindex $rowidlist $row]
4767 set col [lsearch -exact $rowids $id]
4768 if {$col < 0} return
4769 set olds [lindex $parentlist $row]
4770 set row2 [expr {$row + 1}]
4771 set x [xc $row $col]
4774 set d [expr {int(0.5 * $linespc)}]
4775 set ymid [expr {$y + $d}]
4776 set ids [lindex $rowidlist $row2]
4777 # rmx = right-most X coord used
4780 set i [lsearch -exact $ids $p]
4782 puts "oops, parent $p of $id not in list"
4785 set x2 [xc $row2 $i]
4789 set j [lsearch -exact $rowids $p]
4791 # drawlineseg will do this one for us
4795 # should handle duplicated parents here...
4796 set coords [list $x $y]
4798 # if attaching to a vertical segment, draw a smaller
4799 # slant for visual distinctness
4802 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4804 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4806 } elseif {$i < $col && $i < $j} {
4807 # segment slants towards us already
4808 lappend coords [xc $row $j] $y
4810 if {$i < $col - 1} {
4811 lappend coords [expr {$x2 + $linespc}] $y
4812 } elseif {$i > $col + 1} {
4813 lappend coords [expr {$x2 - $linespc}] $y
4815 lappend coords $x2 $y2
4818 lappend coords $x2 $y2
4820 set t [$canv create line $coords -width [linewidth $p] \
4821 -fill $colormap($p) -tags lines.$p]
4825 if {$rmx > [lindex $idpos($id) 1]} {
4826 lset idpos($id) 1 $rmx
4831 proc drawlines {id} {
4834 $canv itemconf lines.$id -width [linewidth $id]
4837 proc drawcmittext {id row col} {
4838 global linespc canv canv2 canv3 fgcolor curview
4839 global cmitlisted commitinfo rowidlist parentlist
4840 global rowtextx idpos idtags idheads idotherrefs
4841 global linehtag linentag linedtag selectedline
4842 global canvxmax boldrows boldnamerows fgcolor
4843 global mainheadid nullid nullid2 circleitem circlecolors
4845 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
4846 set listed $cmitlisted($curview,$id)
4847 if {$id eq $nullid} {
4849 } elseif {$id eq $nullid2} {
4851 } elseif {$id eq $mainheadid} {
4854 set ofill [lindex $circlecolors $listed]
4856 set x [xc $row $col]
4858 set orad [expr {$linespc / 3}]
4860 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4861 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4862 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4863 } elseif {$listed == 3} {
4864 # triangle pointing left for left-side commits
4865 set t [$canv create polygon \
4866 [expr {$x - $orad}] $y \
4867 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4868 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4869 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4871 # triangle pointing right for right-side commits
4872 set t [$canv create polygon \
4873 [expr {$x + $orad - 1}] $y \
4874 [expr {$x - $orad}] [expr {$y - $orad}] \
4875 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4876 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4878 set circleitem($row) $t
4880 $canv bind $t <1> {selcanvline {} %x %y}
4881 set rmx [llength [lindex $rowidlist $row]]
4882 set olds [lindex $parentlist $row]
4884 set nextids [lindex $rowidlist [expr {$row + 1}]]
4886 set i [lsearch -exact $nextids $p]
4892 set xt [xc $row $rmx]
4893 set rowtextx($row) $xt
4894 set idpos($id) [list $x $xt $y]
4895 if {[info exists idtags($id)] || [info exists idheads($id)]
4896 || [info exists idotherrefs($id)]} {
4897 set xt [drawtags $id $x $xt $y]
4899 set headline [lindex $commitinfo($id) 0]
4900 set name [lindex $commitinfo($id) 1]
4901 set date [lindex $commitinfo($id) 2]
4902 set date [formatdate $date]
4905 set isbold [ishighlighted $id]
4907 lappend boldrows $row
4908 set font mainfontbold
4910 lappend boldnamerows $row
4911 set nfont mainfontbold
4914 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4915 -text $headline -font $font -tags text]
4916 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4917 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4918 -text $name -font $nfont -tags text]
4919 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4920 -text $date -font mainfont -tags text]
4921 if {$selectedline == $row} {
4924 set xr [expr {$xt + [font measure $font $headline]}]
4925 if {$xr > $canvxmax} {
4931 proc drawcmitrow {row} {
4932 global displayorder rowidlist nrows_drawn
4933 global iddrawn markingmatches
4934 global commitinfo numcommits
4935 global filehighlight fhighlights findpattern nhighlights
4936 global hlview vhighlights
4937 global highlight_related rhighlights
4939 if {$row >= $numcommits} return
4941 set id [lindex $displayorder $row]
4942 if {[info exists hlview] && ![info exists vhighlights($id)]} {
4943 askvhighlight $row $id
4945 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
4946 askfilehighlight $row $id
4948 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
4949 askfindhighlight $row $id
4951 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
4952 askrelhighlight $row $id
4954 if {![info exists iddrawn($id)]} {
4955 set col [lsearch -exact [lindex $rowidlist $row] $id]
4957 puts "oops, row $row id $id not in list"
4960 if {![info exists commitinfo($id)]} {
4964 drawcmittext $id $row $col
4968 if {$markingmatches} {
4969 markrowmatches $row $id
4973 proc drawcommits {row {endrow {}}} {
4974 global numcommits iddrawn displayorder curview need_redisplay
4975 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4980 if {$endrow eq {}} {
4983 if {$endrow >= $numcommits} {
4984 set endrow [expr {$numcommits - 1}]
4987 set rl1 [expr {$row - $downarrowlen - 3}]
4991 set ro1 [expr {$row - 3}]
4995 set r2 [expr {$endrow + $uparrowlen + 3}]
4996 if {$r2 > $numcommits} {
4999 for {set r $rl1} {$r < $r2} {incr r} {
5000 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5004 set rl1 [expr {$r + 1}]
5010 optimize_rows $ro1 0 $r2
5011 if {$need_redisplay || $nrows_drawn > 2000} {
5016 # make the lines join to already-drawn rows either side
5017 set r [expr {$row - 1}]
5018 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5021 set er [expr {$endrow + 1}]
5022 if {$er >= $numcommits ||
5023 ![info exists iddrawn([lindex $displayorder $er])]} {
5026 for {} {$r <= $er} {incr r} {
5027 set id [lindex $displayorder $r]
5028 set wasdrawn [info exists iddrawn($id)]
5030 if {$r == $er} break
5031 set nextid [lindex $displayorder [expr {$r + 1}]]
5032 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5033 drawparentlinks $id $r
5035 set rowids [lindex $rowidlist $r]
5036 foreach lid $rowids {
5037 if {$lid eq {}} continue
5038 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5040 # see if this is the first child of any of its parents
5041 foreach p [lindex $parentlist $r] {
5042 if {[lsearch -exact $rowids $p] < 0} {
5043 # make this line extend up to the child
5044 set lineend($p) [drawlineseg $p $r $er 0]
5048 set lineend($lid) [drawlineseg $lid $r $er 1]
5054 proc undolayout {row} {
5055 global uparrowlen mingaplen downarrowlen
5056 global rowidlist rowisopt rowfinal need_redisplay
5058 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5062 if {[llength $rowidlist] > $r} {
5064 set rowidlist [lrange $rowidlist 0 $r]
5065 set rowfinal [lrange $rowfinal 0 $r]
5066 set rowisopt [lrange $rowisopt 0 $r]
5067 set need_redisplay 1
5072 proc drawvisible {} {
5073 global canv linespc curview vrowmod selectedline targetrow targetid
5074 global need_redisplay cscroll numcommits
5076 set fs [$canv yview]
5077 set ymax [lindex [$canv cget -scrollregion] 3]
5078 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5079 set f0 [lindex $fs 0]
5080 set f1 [lindex $fs 1]
5081 set y0 [expr {int($f0 * $ymax)}]
5082 set y1 [expr {int($f1 * $ymax)}]
5084 if {[info exists targetid]} {
5085 if {[commitinview $targetid $curview]} {
5086 set r [rowofcommit $targetid]
5087 if {$r != $targetrow} {
5088 # Fix up the scrollregion and change the scrolling position
5089 # now that our target row has moved.
5090 set diff [expr {($r - $targetrow) * $linespc}]
5093 set ymax [lindex [$canv cget -scrollregion] 3]
5096 set f0 [expr {$y0 / $ymax}]
5097 set f1 [expr {$y1 / $ymax}]
5098 allcanvs yview moveto $f0
5099 $cscroll set $f0 $f1
5100 set need_redisplay 1
5107 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5108 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5109 if {$endrow >= $vrowmod($curview)} {
5110 update_arcrows $curview
5112 if {$selectedline ne {} &&
5113 $row <= $selectedline && $selectedline <= $endrow} {
5114 set targetrow $selectedline
5115 } elseif {[info exists targetid]} {
5116 set targetrow [expr {int(($row + $endrow) / 2)}]
5118 if {[info exists targetrow]} {
5119 if {$targetrow >= $numcommits} {
5120 set targetrow [expr {$numcommits - 1}]
5122 set targetid [commitonrow $targetrow]
5124 drawcommits $row $endrow
5127 proc clear_display {} {
5128 global iddrawn linesegs need_redisplay nrows_drawn
5129 global vhighlights fhighlights nhighlights rhighlights
5130 global linehtag linentag linedtag boldrows boldnamerows
5133 catch {unset iddrawn}
5134 catch {unset linesegs}
5135 catch {unset linehtag}
5136 catch {unset linentag}
5137 catch {unset linedtag}
5140 catch {unset vhighlights}
5141 catch {unset fhighlights}
5142 catch {unset nhighlights}
5143 catch {unset rhighlights}
5144 set need_redisplay 0
5148 proc findcrossings {id} {
5149 global rowidlist parentlist numcommits displayorder
5153 foreach {s e} [rowranges $id] {
5154 if {$e >= $numcommits} {
5155 set e [expr {$numcommits - 1}]
5157 if {$e <= $s} continue
5158 for {set row $e} {[incr row -1] >= $s} {} {
5159 set x [lsearch -exact [lindex $rowidlist $row] $id]
5161 set olds [lindex $parentlist $row]
5162 set kid [lindex $displayorder $row]
5163 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5164 if {$kidx < 0} continue
5165 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5167 set px [lsearch -exact $nextrow $p]
5168 if {$px < 0} continue
5169 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5170 if {[lsearch -exact $ccross $p] >= 0} continue
5171 if {$x == $px + ($kidx < $px? -1: 1)} {
5173 } elseif {[lsearch -exact $cross $p] < 0} {
5180 return [concat $ccross {{}} $cross]
5183 proc assigncolor {id} {
5184 global colormap colors nextcolor
5185 global parents children children curview
5187 if {[info exists colormap($id)]} return
5188 set ncolors [llength $colors]
5189 if {[info exists children($curview,$id)]} {
5190 set kids $children($curview,$id)
5194 if {[llength $kids] == 1} {
5195 set child [lindex $kids 0]
5196 if {[info exists colormap($child)]
5197 && [llength $parents($curview,$child)] == 1} {
5198 set colormap($id) $colormap($child)
5204 foreach x [findcrossings $id] {
5206 # delimiter between corner crossings and other crossings
5207 if {[llength $badcolors] >= $ncolors - 1} break
5208 set origbad $badcolors
5210 if {[info exists colormap($x)]
5211 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5212 lappend badcolors $colormap($x)
5215 if {[llength $badcolors] >= $ncolors} {
5216 set badcolors $origbad
5218 set origbad $badcolors
5219 if {[llength $badcolors] < $ncolors - 1} {
5220 foreach child $kids {
5221 if {[info exists colormap($child)]
5222 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5223 lappend badcolors $colormap($child)
5225 foreach p $parents($curview,$child) {
5226 if {[info exists colormap($p)]
5227 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5228 lappend badcolors $colormap($p)
5232 if {[llength $badcolors] >= $ncolors} {
5233 set badcolors $origbad
5236 for {set i 0} {$i <= $ncolors} {incr i} {
5237 set c [lindex $colors $nextcolor]
5238 if {[incr nextcolor] >= $ncolors} {
5241 if {[lsearch -exact $badcolors $c]} break
5243 set colormap($id) $c
5246 proc bindline {t id} {
5249 $canv bind $t <Enter> "lineenter %x %y $id"
5250 $canv bind $t <Motion> "linemotion %x %y $id"
5251 $canv bind $t <Leave> "lineleave $id"
5252 $canv bind $t <Button-1> "lineclick %x %y $id 1"
5255 proc drawtags {id x xt y1} {
5256 global idtags idheads idotherrefs mainhead
5257 global linespc lthickness
5258 global canv rowtextx curview fgcolor bgcolor
5263 if {[info exists idtags($id)]} {
5264 set marks $idtags($id)
5265 set ntags [llength $marks]
5267 if {[info exists idheads($id)]} {
5268 set marks [concat $marks $idheads($id)]
5269 set nheads [llength $idheads($id)]
5271 if {[info exists idotherrefs($id)]} {
5272 set marks [concat $marks $idotherrefs($id)]
5278 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5279 set yt [expr {$y1 - 0.5 * $linespc}]
5280 set yb [expr {$yt + $linespc - 1}]
5284 foreach tag $marks {
5286 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5287 set wid [font measure mainfontbold $tag]
5289 set wid [font measure mainfont $tag]
5293 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5295 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5296 -width $lthickness -fill black -tags tag.$id]
5298 foreach tag $marks x $xvals wid $wvals {
5299 set xl [expr {$x + $delta}]
5300 set xr [expr {$x + $delta + $wid + $lthickness}]
5302 if {[incr ntags -1] >= 0} {
5304 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5305 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5306 -width 1 -outline black -fill yellow -tags tag.$id]
5307 $canv bind $t <1> [list showtag $tag 1]
5308 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5310 # draw a head or other ref
5311 if {[incr nheads -1] >= 0} {
5313 if {$tag eq $mainhead} {
5314 set font mainfontbold
5319 set xl [expr {$xl - $delta/2}]
5320 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5321 -width 1 -outline black -fill $col -tags tag.$id
5322 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5323 set rwid [font measure mainfont $remoteprefix]
5324 set xi [expr {$x + 1}]
5325 set yti [expr {$yt + 1}]
5326 set xri [expr {$x + $rwid}]
5327 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5328 -width 0 -fill "#ffddaa" -tags tag.$id
5331 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5332 -font $font -tags [list tag.$id text]]
5334 $canv bind $t <1> [list showtag $tag 1]
5335 } elseif {$nheads >= 0} {
5336 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
5342 proc xcoord {i level ln} {
5343 global canvx0 xspc1 xspc2
5345 set x [expr {$canvx0 + $i * $xspc1($ln)}]
5346 if {$i > 0 && $i == $level} {
5347 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5348 } elseif {$i > $level} {
5349 set x [expr {$x + $xspc2 - $xspc1($ln)}]
5354 proc show_status {msg} {
5358 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5359 -tags text -fill $fgcolor
5362 # Don't change the text pane cursor if it is currently the hand cursor,
5363 # showing that we are over a sha1 ID link.
5364 proc settextcursor {c} {
5365 global ctext curtextcursor
5367 if {[$ctext cget -cursor] == $curtextcursor} {
5368 $ctext config -cursor $c
5370 set curtextcursor $c
5373 proc nowbusy {what {name {}}} {
5374 global isbusy busyname statusw
5376 if {[array names isbusy] eq {}} {
5377 . config -cursor watch
5381 set busyname($what) $name
5383 $statusw conf -text $name
5387 proc notbusy {what} {
5388 global isbusy maincursor textcursor busyname statusw
5392 if {$busyname($what) ne {} &&
5393 [$statusw cget -text] eq $busyname($what)} {
5394 $statusw conf -text {}
5397 if {[array names isbusy] eq {}} {
5398 . config -cursor $maincursor
5399 settextcursor $textcursor
5403 proc findmatches {f} {
5404 global findtype findstring
5405 if {$findtype == [mc "Regexp"]} {
5406 set matches [regexp -indices -all -inline $findstring $f]
5409 if {$findtype == [mc "IgnCase"]} {
5410 set f [string tolower $f]
5411 set fs [string tolower $fs]
5415 set l [string length $fs]
5416 while {[set j [string first $fs $f $i]] >= 0} {
5417 lappend matches [list $j [expr {$j+$l-1}]]
5418 set i [expr {$j + $l}]
5424 proc dofind {{dirn 1} {wrap 1}} {
5425 global findstring findstartline findcurline selectedline numcommits
5426 global gdttype filehighlight fh_serial find_dirn findallowwrap
5428 if {[info exists find_dirn]} {
5429 if {$find_dirn == $dirn} return
5433 if {$findstring eq {} || $numcommits == 0} return
5434 if {$selectedline eq {}} {
5435 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5437 set findstartline $selectedline
5439 set findcurline $findstartline
5440 nowbusy finding [mc "Searching"]
5441 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5442 after cancel do_file_hl $fh_serial
5443 do_file_hl $fh_serial
5446 set findallowwrap $wrap
5450 proc stopfinding {} {
5451 global find_dirn findcurline fprogcoord
5453 if {[info exists find_dirn]} {
5463 global commitdata commitinfo numcommits findpattern findloc
5464 global findstartline findcurline findallowwrap
5465 global find_dirn gdttype fhighlights fprogcoord
5466 global curview varcorder vrownum varccommits vrowmod
5468 if {![info exists find_dirn]} {
5471 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5474 if {$find_dirn > 0} {
5476 if {$l >= $numcommits} {
5479 if {$l <= $findstartline} {
5480 set lim [expr {$findstartline + 1}]
5483 set moretodo $findallowwrap
5490 if {$l >= $findstartline} {
5491 set lim [expr {$findstartline - 1}]
5494 set moretodo $findallowwrap
5497 set n [expr {($lim - $l) * $find_dirn}]
5502 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5503 update_arcrows $curview
5507 set ai [bsearch $vrownum($curview) $l]
5508 set a [lindex $varcorder($curview) $ai]
5509 set arow [lindex $vrownum($curview) $ai]
5510 set ids [lindex $varccommits($curview,$a)]
5511 set arowend [expr {$arow + [llength $ids]}]
5512 if {$gdttype eq [mc "containing:"]} {
5513 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5514 if {$l < $arow || $l >= $arowend} {
5516 set a [lindex $varcorder($curview) $ai]
5517 set arow [lindex $vrownum($curview) $ai]
5518 set ids [lindex $varccommits($curview,$a)]
5519 set arowend [expr {$arow + [llength $ids]}]
5521 set id [lindex $ids [expr {$l - $arow}]]
5522 # shouldn't happen unless git log doesn't give all the commits...
5523 if {![info exists commitdata($id)] ||
5524 ![doesmatch $commitdata($id)]} {
5527 if {![info exists commitinfo($id)]} {
5530 set info $commitinfo($id)
5531 foreach f $info ty $fldtypes {
5532 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5541 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5542 if {$l < $arow || $l >= $arowend} {
5544 set a [lindex $varcorder($curview) $ai]
5545 set arow [lindex $vrownum($curview) $ai]
5546 set ids [lindex $varccommits($curview,$a)]
5547 set arowend [expr {$arow + [llength $ids]}]
5549 set id [lindex $ids [expr {$l - $arow}]]
5550 if {![info exists fhighlights($id)]} {
5551 # this sets fhighlights($id) to -1
5552 askfilehighlight $l $id
5554 if {$fhighlights($id) > 0} {
5558 if {$fhighlights($id) < 0} {
5561 set findcurline [expr {$l - $find_dirn}]
5566 if {$found || ($domore && !$moretodo)} {
5582 set findcurline [expr {$l - $find_dirn}]
5584 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5588 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5593 proc findselectline {l} {
5594 global findloc commentend ctext findcurline markingmatches gdttype
5596 set markingmatches 1
5599 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5600 # highlight the matches in the comments
5601 set f [$ctext get 1.0 $commentend]
5602 set matches [findmatches $f]
5603 foreach match $matches {
5604 set start [lindex $match 0]
5605 set end [expr {[lindex $match 1] + 1}]
5606 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5612 # mark the bits of a headline or author that match a find string
5613 proc markmatches {canv l str tag matches font row} {
5616 set bbox [$canv bbox $tag]
5617 set x0 [lindex $bbox 0]
5618 set y0 [lindex $bbox 1]
5619 set y1 [lindex $bbox 3]
5620 foreach match $matches {
5621 set start [lindex $match 0]
5622 set end [lindex $match 1]
5623 if {$start > $end} continue
5624 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5625 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5626 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5627 [expr {$x0+$xlen+2}] $y1 \
5628 -outline {} -tags [list match$l matches] -fill yellow]
5630 if {$row == $selectedline} {
5631 $canv raise $t secsel
5636 proc unmarkmatches {} {
5637 global markingmatches
5639 allcanvs delete matches
5640 set markingmatches 0
5644 proc selcanvline {w x y} {
5645 global canv canvy0 ctext linespc
5647 set ymax [lindex [$canv cget -scrollregion] 3]
5648 if {$ymax == {}} return
5649 set yfrac [lindex [$canv yview] 0]
5650 set y [expr {$y + $yfrac * $ymax}]
5651 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5656 set xmax [lindex [$canv cget -scrollregion] 2]
5657 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5658 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5664 proc commit_descriptor {p} {
5666 if {![info exists commitinfo($p)]} {
5670 if {[llength $commitinfo($p)] > 1} {
5671 set l [lindex $commitinfo($p) 0]
5676 # append some text to the ctext widget, and make any SHA1 ID
5677 # that we know about be a clickable link.
5678 proc appendwithlinks {text tags} {
5679 global ctext linknum curview pendinglinks
5681 set start [$ctext index "end - 1c"]
5682 $ctext insert end $text $tags
5683 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5687 set linkid [string range $text $s $e]
5689 $ctext tag delete link$linknum
5690 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5691 setlink $linkid link$linknum
5696 proc setlink {id lk} {
5697 global curview ctext pendinglinks commitinterest
5699 if {[commitinview $id $curview]} {
5700 $ctext tag conf $lk -foreground blue -underline 1
5701 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5702 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5703 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5705 lappend pendinglinks($id) $lk
5706 lappend commitinterest($id) {makelink %I}
5710 proc makelink {id} {
5713 if {![info exists pendinglinks($id)]} return
5714 foreach lk $pendinglinks($id) {
5717 unset pendinglinks($id)
5720 proc linkcursor {w inc} {
5721 global linkentercount curtextcursor
5723 if {[incr linkentercount $inc] > 0} {
5724 $w configure -cursor hand2
5726 $w configure -cursor $curtextcursor
5727 if {$linkentercount < 0} {
5728 set linkentercount 0
5733 proc viewnextline {dir} {
5737 set ymax [lindex [$canv cget -scrollregion] 3]
5738 set wnow [$canv yview]
5739 set wtop [expr {[lindex $wnow 0] * $ymax}]
5740 set newtop [expr {$wtop + $dir * $linespc}]
5743 } elseif {$newtop > $ymax} {
5746 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5749 # add a list of tag or branch names at position pos
5750 # returns the number of names inserted
5751 proc appendrefs {pos ids var} {
5752 global ctext linknum curview $var maxrefs
5754 if {[catch {$ctext index $pos}]} {
5757 $ctext conf -state normal
5758 $ctext delete $pos "$pos lineend"
5761 foreach tag [set $var\($id\)] {
5762 lappend tags [list $tag $id]
5765 if {[llength $tags] > $maxrefs} {
5766 $ctext insert $pos "many ([llength $tags])"
5768 set tags [lsort -index 0 -decreasing $tags]
5771 set id [lindex $ti 1]
5774 $ctext tag delete $lk
5775 $ctext insert $pos $sep
5776 $ctext insert $pos [lindex $ti 0] $lk
5781 $ctext conf -state disabled
5782 return [llength $tags]
5785 # called when we have finished computing the nearby tags
5786 proc dispneartags {delay} {
5787 global selectedline currentid showneartags tagphase
5789 if {$selectedline eq {} || !$showneartags} return
5790 after cancel dispnexttag
5792 after 200 dispnexttag
5795 after idle dispnexttag
5800 proc dispnexttag {} {
5801 global selectedline currentid showneartags tagphase ctext
5803 if {$selectedline eq {} || !$showneartags} return
5804 switch -- $tagphase {
5806 set dtags [desctags $currentid]
5808 appendrefs precedes $dtags idtags
5812 set atags [anctags $currentid]
5814 appendrefs follows $atags idtags
5818 set dheads [descheads $currentid]
5819 if {$dheads ne {}} {
5820 if {[appendrefs branch $dheads idheads] > 1
5821 && [$ctext get "branch -3c"] eq "h"} {
5822 # turn "Branch" into "Branches"
5823 $ctext conf -state normal
5824 $ctext insert "branch -2c" "es"
5825 $ctext conf -state disabled
5830 if {[incr tagphase] <= 2} {
5831 after idle dispnexttag
5835 proc make_secsel {l} {
5836 global linehtag linentag linedtag canv canv2 canv3
5838 if {![info exists linehtag($l)]} return
5840 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5841 -tags secsel -fill [$canv cget -selectbackground]]
5843 $canv2 delete secsel
5844 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5845 -tags secsel -fill [$canv2 cget -selectbackground]]
5847 $canv3 delete secsel
5848 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5849 -tags secsel -fill [$canv3 cget -selectbackground]]
5853 proc selectline {l isnew} {
5854 global canv ctext commitinfo selectedline
5855 global canvy0 linespc parents children curview
5856 global currentid sha1entry
5857 global commentend idtags linknum
5858 global mergemax numcommits pending_select
5859 global cmitmode showneartags allcommits
5860 global targetrow targetid lastscrollrows
5863 catch {unset pending_select}
5868 if {$l < 0 || $l >= $numcommits} return
5869 set id [commitonrow $l]
5874 if {$lastscrollrows < $numcommits} {
5878 set y [expr {$canvy0 + $l * $linespc}]
5879 set ymax [lindex [$canv cget -scrollregion] 3]
5880 set ytop [expr {$y - $linespc - 1}]
5881 set ybot [expr {$y + $linespc + 1}]
5882 set wnow [$canv yview]
5883 set wtop [expr {[lindex $wnow 0] * $ymax}]
5884 set wbot [expr {[lindex $wnow 1] * $ymax}]
5885 set wh [expr {$wbot - $wtop}]
5887 if {$ytop < $wtop} {
5888 if {$ybot < $wtop} {
5889 set newtop [expr {$y - $wh / 2.0}]
5892 if {$newtop > $wtop - $linespc} {
5893 set newtop [expr {$wtop - $linespc}]
5896 } elseif {$ybot > $wbot} {
5897 if {$ytop > $wbot} {
5898 set newtop [expr {$y - $wh / 2.0}]
5900 set newtop [expr {$ybot - $wh}]
5901 if {$newtop < $wtop + $linespc} {
5902 set newtop [expr {$wtop + $linespc}]
5906 if {$newtop != $wtop} {
5910 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5917 addtohistory [list selbyid $id]
5920 $sha1entry delete 0 end
5921 $sha1entry insert 0 $id
5923 $sha1entry selection from 0
5924 $sha1entry selection to end
5928 $ctext conf -state normal
5931 if {![info exists commitinfo($id)]} {
5934 set info $commitinfo($id)
5935 set date [formatdate [lindex $info 2]]
5936 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5937 set date [formatdate [lindex $info 4]]
5938 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5939 if {[info exists idtags($id)]} {
5940 $ctext insert end [mc "Tags:"]
5941 foreach tag $idtags($id) {
5942 $ctext insert end " $tag"
5944 $ctext insert end "\n"
5948 set olds $parents($curview,$id)
5949 if {[llength $olds] > 1} {
5952 if {$np >= $mergemax} {
5957 $ctext insert end "[mc "Parent"]: " $tag
5958 appendwithlinks [commit_descriptor $p] {}
5963 append headers "[mc "Parent"]: [commit_descriptor $p]"
5967 foreach c $children($curview,$id) {
5968 append headers "[mc "Child"]: [commit_descriptor $c]"
5971 # make anything that looks like a SHA1 ID be a clickable link
5972 appendwithlinks $headers {}
5973 if {$showneartags} {
5974 if {![info exists allcommits]} {
5977 $ctext insert end "[mc "Branch"]: "
5978 $ctext mark set branch "end -1c"
5979 $ctext mark gravity branch left
5980 $ctext insert end "\n[mc "Follows"]: "
5981 $ctext mark set follows "end -1c"
5982 $ctext mark gravity follows left
5983 $ctext insert end "\n[mc "Precedes"]: "
5984 $ctext mark set precedes "end -1c"
5985 $ctext mark gravity precedes left
5986 $ctext insert end "\n"
5989 $ctext insert end "\n"
5990 set comment [lindex $info 5]
5991 if {[string first "\r" $comment] >= 0} {
5992 set comment [string map {"\r" "\n "} $comment]
5994 appendwithlinks $comment {comment}
5996 $ctext tag remove found 1.0 end
5997 $ctext conf -state disabled
5998 set commentend [$ctext index "end - 1c"]
6000 init_flist [mc "Comments"]
6001 if {$cmitmode eq "tree"} {
6003 } elseif {[llength $olds] <= 1} {
6010 proc selfirstline {} {
6015 proc sellastline {} {
6018 set l [expr {$numcommits - 1}]
6022 proc selnextline {dir} {
6025 if {$selectedline eq {}} return
6026 set l [expr {$selectedline + $dir}]
6031 proc selnextpage {dir} {
6032 global canv linespc selectedline numcommits
6034 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6038 allcanvs yview scroll [expr {$dir * $lpp}] units
6040 if {$selectedline eq {}} return
6041 set l [expr {$selectedline + $dir * $lpp}]
6044 } elseif {$l >= $numcommits} {
6045 set l [expr $numcommits - 1]
6051 proc unselectline {} {
6052 global selectedline currentid
6055 catch {unset currentid}
6056 allcanvs delete secsel
6060 proc reselectline {} {
6063 if {$selectedline ne {}} {
6064 selectline $selectedline 0
6068 proc addtohistory {cmd} {
6069 global history historyindex curview
6071 set elt [list $curview $cmd]
6072 if {$historyindex > 0
6073 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6077 if {$historyindex < [llength $history]} {
6078 set history [lreplace $history $historyindex end $elt]
6080 lappend history $elt
6083 if {$historyindex > 1} {
6084 .tf.bar.leftbut conf -state normal
6086 .tf.bar.leftbut conf -state disabled
6088 .tf.bar.rightbut conf -state disabled
6094 set view [lindex $elt 0]
6095 set cmd [lindex $elt 1]
6096 if {$curview != $view} {
6103 global history historyindex
6106 if {$historyindex > 1} {
6107 incr historyindex -1
6108 godo [lindex $history [expr {$historyindex - 1}]]
6109 .tf.bar.rightbut conf -state normal
6111 if {$historyindex <= 1} {
6112 .tf.bar.leftbut conf -state disabled
6117 global history historyindex
6120 if {$historyindex < [llength $history]} {
6121 set cmd [lindex $history $historyindex]
6124 .tf.bar.leftbut conf -state normal
6126 if {$historyindex >= [llength $history]} {
6127 .tf.bar.rightbut conf -state disabled
6132 global treefilelist treeidlist diffids diffmergeid treepending
6133 global nullid nullid2
6136 catch {unset diffmergeid}
6137 if {![info exists treefilelist($id)]} {
6138 if {![info exists treepending]} {
6139 if {$id eq $nullid} {
6140 set cmd [list | git ls-files]
6141 } elseif {$id eq $nullid2} {
6142 set cmd [list | git ls-files --stage -t]
6144 set cmd [list | git ls-tree -r $id]
6146 if {[catch {set gtf [open $cmd r]}]} {
6150 set treefilelist($id) {}
6151 set treeidlist($id) {}
6152 fconfigure $gtf -blocking 0
6153 filerun $gtf [list gettreeline $gtf $id]
6160 proc gettreeline {gtf id} {
6161 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6164 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6165 if {$diffids eq $nullid} {
6168 set i [string first "\t" $line]
6169 if {$i < 0} continue
6170 set fname [string range $line [expr {$i+1}] end]
6171 set line [string range $line 0 [expr {$i-1}]]
6172 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6173 set sha1 [lindex $line 2]
6174 if {[string index $fname 0] eq "\""} {
6175 set fname [lindex $fname 0]
6177 lappend treeidlist($id) $sha1
6179 lappend treefilelist($id) $fname
6182 return [expr {$nl >= 1000? 2: 1}]
6186 if {$cmitmode ne "tree"} {
6187 if {![info exists diffmergeid]} {
6188 gettreediffs $diffids
6190 } elseif {$id ne $diffids} {
6199 global treefilelist treeidlist diffids nullid nullid2
6200 global ctext commentend
6202 set i [lsearch -exact $treefilelist($diffids) $f]
6204 puts "oops, $f not in list for id $diffids"
6207 if {$diffids eq $nullid} {
6208 if {[catch {set bf [open $f r]} err]} {
6209 puts "oops, can't read $f: $err"
6213 set blob [lindex $treeidlist($diffids) $i]
6214 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6215 puts "oops, error reading blob $blob: $err"
6219 fconfigure $bf -blocking 0
6220 filerun $bf [list getblobline $bf $diffids]
6221 $ctext config -state normal
6222 clear_ctext $commentend
6223 $ctext insert end "\n"
6224 $ctext insert end "$f\n" filesep
6225 $ctext config -state disabled
6226 $ctext yview $commentend
6230 proc getblobline {bf id} {
6231 global diffids cmitmode ctext
6233 if {$id ne $diffids || $cmitmode ne "tree"} {
6237 $ctext config -state normal
6239 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6240 $ctext insert end "$line\n"
6243 # delete last newline
6244 $ctext delete "end - 2c" "end - 1c"
6248 $ctext config -state disabled
6249 return [expr {$nl >= 1000? 2: 1}]
6252 proc mergediff {id} {
6253 global diffmergeid mdifffd
6257 global limitdiffs vfilelimit curview
6261 # this doesn't seem to actually affect anything...
6262 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
6263 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6264 set cmd [concat $cmd -- $vfilelimit($curview)]
6266 if {[catch {set mdf [open $cmd r]} err]} {
6267 error_popup "[mc "Error getting merge diffs:"] $err"
6270 fconfigure $mdf -blocking 0
6271 set mdifffd($id) $mdf
6272 set np [llength $parents($curview,$id)]
6274 filerun $mdf [list getmergediffline $mdf $id $np]
6277 proc getmergediffline {mdf id np} {
6278 global diffmergeid ctext cflist mergemax
6279 global difffilestart mdifffd
6281 $ctext conf -state normal
6283 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
6284 if {![info exists diffmergeid] || $id != $diffmergeid
6285 || $mdf != $mdifffd($id)} {
6289 if {[regexp {^diff --cc (.*)} $line match fname]} {
6290 # start of a new file
6291 $ctext insert end "\n"
6292 set here [$ctext index "end - 1c"]
6293 lappend difffilestart $here
6294 add_flist [list $fname]
6295 set l [expr {(78 - [string length $fname]) / 2}]
6296 set pad [string range "----------------------------------------" 1 $l]
6297 $ctext insert end "$pad $fname $pad\n" filesep
6298 } elseif {[regexp {^@@} $line]} {
6299 $ctext insert end "$line\n" hunksep
6300 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
6303 # parse the prefix - one ' ', '-' or '+' for each parent
6308 for {set j 0} {$j < $np} {incr j} {
6309 set c [string range $line $j $j]
6312 } elseif {$c == "-"} {
6314 } elseif {$c == "+"} {
6323 if {!$isbad && $minuses ne {} && $pluses eq {}} {
6324 # line doesn't appear in result, parents in $minuses have the line
6325 set num [lindex $minuses 0]
6326 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
6327 # line appears in result, parents in $pluses don't have the line
6328 lappend tags mresult
6329 set num [lindex $spaces 0]
6332 if {$num >= $mergemax} {
6337 $ctext insert end "$line\n" $tags
6340 $ctext conf -state disabled
6345 return [expr {$nr >= 1000? 2: 1}]
6348 proc startdiff {ids} {
6349 global treediffs diffids treepending diffmergeid nullid nullid2
6353 catch {unset diffmergeid}
6354 if {![info exists treediffs($ids)] ||
6355 [lsearch -exact $ids $nullid] >= 0 ||
6356 [lsearch -exact $ids $nullid2] >= 0} {
6357 if {![info exists treepending]} {
6365 proc path_filter {filter name} {
6367 set l [string length $p]
6368 if {[string index $p end] eq "/"} {
6369 if {[string compare -length $l $p $name] == 0} {
6373 if {[string compare -length $l $p $name] == 0 &&
6374 ([string length $name] == $l ||
6375 [string index $name $l] eq "/")} {
6383 proc addtocflist {ids} {
6386 add_flist $treediffs($ids)
6390 proc diffcmd {ids flags} {
6391 global nullid nullid2
6393 set i [lsearch -exact $ids $nullid]
6394 set j [lsearch -exact $ids $nullid2]
6396 if {[llength $ids] > 1 && $j < 0} {
6397 # comparing working directory with some specific revision
6398 set cmd [concat | git diff-index $flags]
6400 lappend cmd -R [lindex $ids 1]
6402 lappend cmd [lindex $ids 0]
6405 # comparing working directory with index
6406 set cmd [concat | git diff-files $flags]
6411 } elseif {$j >= 0} {
6412 set cmd [concat | git diff-index --cached $flags]
6413 if {[llength $ids] > 1} {
6414 # comparing index with specific revision
6416 lappend cmd -R [lindex $ids 1]
6418 lappend cmd [lindex $ids 0]
6421 # comparing index with HEAD
6425 set cmd [concat | git diff-tree -r $flags $ids]
6430 proc gettreediffs {ids} {
6431 global treediff treepending
6433 set treepending $ids
6435 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6436 fconfigure $gdtf -blocking 0
6437 filerun $gdtf [list gettreediffline $gdtf $ids]
6440 proc gettreediffline {gdtf ids} {
6441 global treediff treediffs treepending diffids diffmergeid
6442 global cmitmode vfilelimit curview limitdiffs
6445 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6446 set i [string first "\t" $line]
6448 set file [string range $line [expr {$i+1}] end]
6449 if {[string index $file 0] eq "\""} {
6450 set file [lindex $file 0]
6452 lappend treediff $file
6456 return [expr {$nr >= 1000? 2: 1}]
6459 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6461 foreach f $treediff {
6462 if {[path_filter $vfilelimit($curview) $f]} {
6466 set treediffs($ids) $flist
6468 set treediffs($ids) $treediff
6471 if {$cmitmode eq "tree"} {
6473 } elseif {$ids != $diffids} {
6474 if {![info exists diffmergeid]} {
6475 gettreediffs $diffids
6483 # empty string or positive integer
6484 proc diffcontextvalidate {v} {
6485 return [regexp {^(|[1-9][0-9]*)$} $v]
6488 proc diffcontextchange {n1 n2 op} {
6489 global diffcontextstring diffcontext
6491 if {[string is integer -strict $diffcontextstring]} {
6492 if {$diffcontextstring > 0} {
6493 set diffcontext $diffcontextstring
6499 proc changeignorespace {} {
6503 proc getblobdiffs {ids} {
6504 global blobdifffd diffids env
6505 global diffinhdr treediffs
6508 global limitdiffs vfilelimit curview
6510 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6514 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6515 set cmd [concat $cmd -- $vfilelimit($curview)]
6517 if {[catch {set bdf [open $cmd r]} err]} {
6518 puts "error getting diffs: $err"
6522 fconfigure $bdf -blocking 0
6523 set blobdifffd($ids) $bdf
6524 filerun $bdf [list getblobdiffline $bdf $diffids]
6527 proc setinlist {var i val} {
6530 while {[llength [set $var]] < $i} {
6533 if {[llength [set $var]] == $i} {
6540 proc makediffhdr {fname ids} {
6541 global ctext curdiffstart treediffs
6543 set i [lsearch -exact $treediffs($ids) $fname]
6545 setinlist difffilestart $i $curdiffstart
6547 set l [expr {(78 - [string length $fname]) / 2}]
6548 set pad [string range "----------------------------------------" 1 $l]
6549 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6552 proc getblobdiffline {bdf ids} {
6553 global diffids blobdifffd ctext curdiffstart
6554 global diffnexthead diffnextnote difffilestart
6555 global diffinhdr treediffs
6558 $ctext conf -state normal
6559 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6560 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6564 if {![string compare -length 11 "diff --git " $line]} {
6565 # trim off "diff --git "
6566 set line [string range $line 11 end]
6568 # start of a new file
6569 $ctext insert end "\n"
6570 set curdiffstart [$ctext index "end - 1c"]
6571 $ctext insert end "\n" filesep
6572 # If the name hasn't changed the length will be odd,
6573 # the middle char will be a space, and the two bits either
6574 # side will be a/name and b/name, or "a/name" and "b/name".
6575 # If the name has changed we'll get "rename from" and
6576 # "rename to" or "copy from" and "copy to" lines following this,
6577 # and we'll use them to get the filenames.
6578 # This complexity is necessary because spaces in the filename(s)
6579 # don't get escaped.
6580 set l [string length $line]
6581 set i [expr {$l / 2}]
6582 if {!(($l & 1) && [string index $line $i] eq " " &&
6583 [string range $line 2 [expr {$i - 1}]] eq \
6584 [string range $line [expr {$i + 3}] end])} {
6587 # unescape if quoted and chop off the a/ from the front
6588 if {[string index $line 0] eq "\""} {
6589 set fname [string range [lindex $line 0] 2 end]
6591 set fname [string range $line 2 [expr {$i - 1}]]
6593 makediffhdr $fname $ids
6595 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6596 $line match f1l f1c f2l f2c rest]} {
6597 $ctext insert end "$line\n" hunksep
6600 } elseif {$diffinhdr} {
6601 if {![string compare -length 12 "rename from " $line]} {
6602 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6603 if {[string index $fname 0] eq "\""} {
6604 set fname [lindex $fname 0]
6606 set i [lsearch -exact $treediffs($ids) $fname]
6608 setinlist difffilestart $i $curdiffstart
6610 } elseif {![string compare -length 10 $line "rename to "] ||
6611 ![string compare -length 8 $line "copy to "]} {
6612 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6613 if {[string index $fname 0] eq "\""} {
6614 set fname [lindex $fname 0]
6616 makediffhdr $fname $ids
6617 } elseif {[string compare -length 3 $line "---"] == 0} {
6620 } elseif {[string compare -length 3 $line "+++"] == 0} {
6624 $ctext insert end "$line\n" filesep
6627 set x [string range $line 0 0]
6628 if {$x == "-" || $x == "+"} {
6629 set tag [expr {$x == "+"}]
6630 $ctext insert end "$line\n" d$tag
6631 } elseif {$x == " "} {
6632 $ctext insert end "$line\n"
6634 # "\ No newline at end of file",
6635 # or something else we don't recognize
6636 $ctext insert end "$line\n" hunksep
6640 $ctext conf -state disabled
6645 return [expr {$nr >= 1000? 2: 1}]
6648 proc changediffdisp {} {
6649 global ctext diffelide
6651 $ctext tag conf d0 -elide [lindex $diffelide 0]
6652 $ctext tag conf d1 -elide [lindex $diffelide 1]
6655 proc highlightfile {loc cline} {
6656 global ctext cflist cflist_top
6659 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
6660 $cflist tag add highlight $cline.0 "$cline.0 lineend"
6661 $cflist see $cline.0
6662 set cflist_top $cline
6666 global difffilestart ctext cmitmode
6668 if {$cmitmode eq "tree"} return
6671 set here [$ctext index @0,0]
6672 foreach loc $difffilestart {
6673 if {[$ctext compare $loc >= $here]} {
6674 highlightfile $prev $prevline
6680 highlightfile $prev $prevline
6684 global difffilestart ctext cmitmode
6686 if {$cmitmode eq "tree"} return
6687 set here [$ctext index @0,0]
6689 foreach loc $difffilestart {
6691 if {[$ctext compare $loc > $here]} {
6692 highlightfile $loc $line
6698 proc clear_ctext {{first 1.0}} {
6699 global ctext smarktop smarkbot
6702 set l [lindex [split $first .] 0]
6703 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6706 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6709 $ctext delete $first end
6710 if {$first eq "1.0"} {
6711 catch {unset pendinglinks}
6715 proc settabs {{firstab {}}} {
6716 global firsttabstop tabstop ctext have_tk85
6718 if {$firstab ne {} && $have_tk85} {
6719 set firsttabstop $firstab
6721 set w [font measure textfont "0"]
6722 if {$firsttabstop != 0} {
6723 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6724 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6725 } elseif {$have_tk85 || $tabstop != 8} {
6726 $ctext conf -tabs [expr {$tabstop * $w}]
6728 $ctext conf -tabs {}
6732 proc incrsearch {name ix op} {
6733 global ctext searchstring searchdirn
6735 $ctext tag remove found 1.0 end
6736 if {[catch {$ctext index anchor}]} {
6737 # no anchor set, use start of selection, or of visible area
6738 set sel [$ctext tag ranges sel]
6740 $ctext mark set anchor [lindex $sel 0]
6741 } elseif {$searchdirn eq "-forwards"} {
6742 $ctext mark set anchor @0,0
6744 $ctext mark set anchor @0,[winfo height $ctext]
6747 if {$searchstring ne {}} {
6748 set here [$ctext search $searchdirn -- $searchstring anchor]
6757 global sstring ctext searchstring searchdirn
6760 $sstring icursor end
6761 set searchdirn -forwards
6762 if {$searchstring ne {}} {
6763 set sel [$ctext tag ranges sel]
6765 set start "[lindex $sel 0] + 1c"
6766 } elseif {[catch {set start [$ctext index anchor]}]} {
6769 set match [$ctext search -count mlen -- $searchstring $start]
6770 $ctext tag remove sel 1.0 end
6776 set mend "$match + $mlen c"
6777 $ctext tag add sel $match $mend
6778 $ctext mark unset anchor
6782 proc dosearchback {} {
6783 global sstring ctext searchstring searchdirn
6786 $sstring icursor end
6787 set searchdirn -backwards
6788 if {$searchstring ne {}} {
6789 set sel [$ctext tag ranges sel]
6791 set start [lindex $sel 0]
6792 } elseif {[catch {set start [$ctext index anchor]}]} {
6793 set start @0,[winfo height $ctext]
6795 set match [$ctext search -backwards -count ml -- $searchstring $start]
6796 $ctext tag remove sel 1.0 end
6802 set mend "$match + $ml c"
6803 $ctext tag add sel $match $mend
6804 $ctext mark unset anchor
6808 proc searchmark {first last} {
6809 global ctext searchstring
6813 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6814 if {$match eq {}} break
6815 set mend "$match + $mlen c"
6816 $ctext tag add found $match $mend
6820 proc searchmarkvisible {doall} {
6821 global ctext smarktop smarkbot
6823 set topline [lindex [split [$ctext index @0,0] .] 0]
6824 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6825 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6826 # no overlap with previous
6827 searchmark $topline $botline
6828 set smarktop $topline
6829 set smarkbot $botline
6831 if {$topline < $smarktop} {
6832 searchmark $topline [expr {$smarktop-1}]
6833 set smarktop $topline
6835 if {$botline > $smarkbot} {
6836 searchmark [expr {$smarkbot+1}] $botline
6837 set smarkbot $botline
6842 proc scrolltext {f0 f1} {
6845 .bleft.bottom.sb set $f0 $f1
6846 if {$searchstring ne {}} {
6852 global linespc charspc canvx0 canvy0
6853 global xspc1 xspc2 lthickness
6855 set linespc [font metrics mainfont -linespace]
6856 set charspc [font measure mainfont "m"]
6857 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6858 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6859 set lthickness [expr {int($linespc / 9) + 1}]
6860 set xspc1(0) $linespc
6868 set ymax [lindex [$canv cget -scrollregion] 3]
6869 if {$ymax eq {} || $ymax == 0} return
6870 set span [$canv yview]
6873 allcanvs yview moveto [lindex $span 0]
6875 if {$selectedline ne {}} {
6876 selectline $selectedline 0
6877 allcanvs yview moveto [lindex $span 0]
6881 proc parsefont {f n} {
6884 set fontattr($f,family) [lindex $n 0]
6886 if {$s eq {} || $s == 0} {
6889 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6891 set fontattr($f,size) $s
6892 set fontattr($f,weight) normal
6893 set fontattr($f,slant) roman
6894 foreach style [lrange $n 2 end] {
6897 "bold" {set fontattr($f,weight) $style}
6899 "italic" {set fontattr($f,slant) $style}
6904 proc fontflags {f {isbold 0}} {
6907 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6908 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6909 -slant $fontattr($f,slant)]
6915 set n [list $fontattr($f,family) $fontattr($f,size)]
6916 if {$fontattr($f,weight) eq "bold"} {
6919 if {$fontattr($f,slant) eq "italic"} {
6925 proc incrfont {inc} {
6926 global mainfont textfont ctext canv cflist showrefstop
6927 global stopped entries fontattr
6930 set s $fontattr(mainfont,size)
6935 set fontattr(mainfont,size) $s
6936 font config mainfont -size $s
6937 font config mainfontbold -size $s
6938 set mainfont [fontname mainfont]
6939 set s $fontattr(textfont,size)
6944 set fontattr(textfont,size) $s
6945 font config textfont -size $s
6946 font config textfontbold -size $s
6947 set textfont [fontname textfont]
6954 global sha1entry sha1string
6955 if {[string length $sha1string] == 40} {
6956 $sha1entry delete 0 end
6960 proc sha1change {n1 n2 op} {
6961 global sha1string currentid sha1but
6962 if {$sha1string == {}
6963 || ([info exists currentid] && $sha1string == $currentid)} {
6968 if {[$sha1but cget -state] == $state} return
6969 if {$state == "normal"} {
6970 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6972 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6976 proc gotocommit {} {
6977 global sha1string tagids headids curview varcid
6979 if {$sha1string == {}
6980 || ([info exists currentid] && $sha1string == $currentid)} return
6981 if {[info exists tagids($sha1string)]} {
6982 set id $tagids($sha1string)
6983 } elseif {[info exists headids($sha1string)]} {
6984 set id $headids($sha1string)
6986 set id [string tolower $sha1string]
6987 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6988 set matches [array names varcid "$curview,$id*"]
6989 if {$matches ne {}} {
6990 if {[llength $matches] > 1} {
6991 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6994 set id [lindex [split [lindex $matches 0] ","] 1]
6998 if {[commitinview $id $curview]} {
6999 selectline [rowofcommit $id] 1
7002 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7003 set msg [mc "SHA1 id %s is not known" $sha1string]
7005 set msg [mc "Tag/Head %s is not known" $sha1string]
7010 proc lineenter {x y id} {
7011 global hoverx hovery hoverid hovertimer
7012 global commitinfo canv
7014 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7018 if {[info exists hovertimer]} {
7019 after cancel $hovertimer
7021 set hovertimer [after 500 linehover]
7025 proc linemotion {x y id} {
7026 global hoverx hovery hoverid hovertimer
7028 if {[info exists hoverid] && $id == $hoverid} {
7031 if {[info exists hovertimer]} {
7032 after cancel $hovertimer
7034 set hovertimer [after 500 linehover]
7038 proc lineleave {id} {
7039 global hoverid hovertimer canv
7041 if {[info exists hoverid] && $id == $hoverid} {
7043 if {[info exists hovertimer]} {
7044 after cancel $hovertimer
7052 global hoverx hovery hoverid hovertimer
7053 global canv linespc lthickness
7056 set text [lindex $commitinfo($hoverid) 0]
7057 set ymax [lindex [$canv cget -scrollregion] 3]
7058 if {$ymax == {}} return
7059 set yfrac [lindex [$canv yview] 0]
7060 set x [expr {$hoverx + 2 * $linespc}]
7061 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7062 set x0 [expr {$x - 2 * $lthickness}]
7063 set y0 [expr {$y - 2 * $lthickness}]
7064 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7065 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7066 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7067 -fill \#ffff80 -outline black -width 1 -tags hover]
7069 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7074 proc clickisonarrow {id y} {
7077 set ranges [rowranges $id]
7078 set thresh [expr {2 * $lthickness + 6}]
7079 set n [expr {[llength $ranges] - 1}]
7080 for {set i 1} {$i < $n} {incr i} {
7081 set row [lindex $ranges $i]
7082 if {abs([yc $row] - $y) < $thresh} {
7089 proc arrowjump {id n y} {
7092 # 1 <-> 2, 3 <-> 4, etc...
7093 set n [expr {(($n - 1) ^ 1) + 1}]
7094 set row [lindex [rowranges $id] $n]
7096 set ymax [lindex [$canv cget -scrollregion] 3]
7097 if {$ymax eq {} || $ymax <= 0} return
7098 set view [$canv yview]
7099 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7100 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7104 allcanvs yview moveto $yfrac
7107 proc lineclick {x y id isnew} {
7108 global ctext commitinfo children canv thickerline curview
7110 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7115 # draw this line thicker than normal
7119 set ymax [lindex [$canv cget -scrollregion] 3]
7120 if {$ymax eq {}} return
7121 set yfrac [lindex [$canv yview] 0]
7122 set y [expr {$y + $yfrac * $ymax}]
7124 set dirn [clickisonarrow $id $y]
7126 arrowjump $id $dirn $y
7131 addtohistory [list lineclick $x $y $id 0]
7133 # fill the details pane with info about this line
7134 $ctext conf -state normal
7137 $ctext insert end "[mc "Parent"]:\t"
7138 $ctext insert end $id link0
7140 set info $commitinfo($id)
7141 $ctext insert end "\n\t[lindex $info 0]\n"
7142 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7143 set date [formatdate [lindex $info 2]]
7144 $ctext insert end "\t[mc "Date"]:\t$date\n"
7145 set kids $children($curview,$id)
7147 $ctext insert end "\n[mc "Children"]:"
7149 foreach child $kids {
7151 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7152 set info $commitinfo($child)
7153 $ctext insert end "\n\t"
7154 $ctext insert end $child link$i
7155 setlink $child link$i
7156 $ctext insert end "\n\t[lindex $info 0]"
7157 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7158 set date [formatdate [lindex $info 2]]
7159 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7162 $ctext conf -state disabled
7166 proc normalline {} {
7168 if {[info exists thickerline]} {
7177 if {[commitinview $id $curview]} {
7178 selectline [rowofcommit $id] 1
7184 if {![info exists startmstime]} {
7185 set startmstime [clock clicks -milliseconds]
7187 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7190 proc rowmenu {x y id} {
7191 global rowctxmenu selectedline rowmenuid curview
7192 global nullid nullid2 fakerowmenu mainhead
7196 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7201 if {$id ne $nullid && $id ne $nullid2} {
7202 set menu $rowctxmenu
7203 if {$mainhead ne {}} {
7204 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7206 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7209 set menu $fakerowmenu
7211 $menu entryconfigure [mc "Diff this -> selected"] -state $state
7212 $menu entryconfigure [mc "Diff selected -> this"] -state $state
7213 $menu entryconfigure [mc "Make patch"] -state $state
7214 tk_popup $menu $x $y
7217 proc diffvssel {dirn} {
7218 global rowmenuid selectedline
7220 if {$selectedline eq {}} return
7222 set oldid [commitonrow $selectedline]
7223 set newid $rowmenuid
7225 set oldid $rowmenuid
7226 set newid [commitonrow $selectedline]
7228 addtohistory [list doseldiff $oldid $newid]
7229 doseldiff $oldid $newid
7232 proc doseldiff {oldid newid} {
7236 $ctext conf -state normal
7238 init_flist [mc "Top"]
7239 $ctext insert end "[mc "From"] "
7240 $ctext insert end $oldid link0
7241 setlink $oldid link0
7242 $ctext insert end "\n "
7243 $ctext insert end [lindex $commitinfo($oldid) 0]
7244 $ctext insert end "\n\n[mc "To"] "
7245 $ctext insert end $newid link1
7246 setlink $newid link1
7247 $ctext insert end "\n "
7248 $ctext insert end [lindex $commitinfo($newid) 0]
7249 $ctext insert end "\n"
7250 $ctext conf -state disabled
7251 $ctext tag remove found 1.0 end
7252 startdiff [list $oldid $newid]
7256 global rowmenuid currentid commitinfo patchtop patchnum
7258 if {![info exists currentid]} return
7259 set oldid $currentid
7260 set oldhead [lindex $commitinfo($oldid) 0]
7261 set newid $rowmenuid
7262 set newhead [lindex $commitinfo($newid) 0]
7265 catch {destroy $top}
7267 label $top.title -text [mc "Generate patch"]
7268 grid $top.title - -pady 10
7269 label $top.from -text [mc "From:"]
7270 entry $top.fromsha1 -width 40 -relief flat
7271 $top.fromsha1 insert 0 $oldid
7272 $top.fromsha1 conf -state readonly
7273 grid $top.from $top.fromsha1 -sticky w
7274 entry $top.fromhead -width 60 -relief flat
7275 $top.fromhead insert 0 $oldhead
7276 $top.fromhead conf -state readonly
7277 grid x $top.fromhead -sticky w
7278 label $top.to -text [mc "To:"]
7279 entry $top.tosha1 -width 40 -relief flat
7280 $top.tosha1 insert 0 $newid
7281 $top.tosha1 conf -state readonly
7282 grid $top.to $top.tosha1 -sticky w
7283 entry $top.tohead -width 60 -relief flat
7284 $top.tohead insert 0 $newhead
7285 $top.tohead conf -state readonly
7286 grid x $top.tohead -sticky w
7287 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7288 grid $top.rev x -pady 10
7289 label $top.flab -text [mc "Output file:"]
7290 entry $top.fname -width 60
7291 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7293 grid $top.flab $top.fname -sticky w
7295 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7296 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7297 grid $top.buts.gen $top.buts.can
7298 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7299 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7300 grid $top.buts - -pady 10 -sticky ew
7304 proc mkpatchrev {} {
7307 set oldid [$patchtop.fromsha1 get]
7308 set oldhead [$patchtop.fromhead get]
7309 set newid [$patchtop.tosha1 get]
7310 set newhead [$patchtop.tohead get]
7311 foreach e [list fromsha1 fromhead tosha1 tohead] \
7312 v [list $newid $newhead $oldid $oldhead] {
7313 $patchtop.$e conf -state normal
7314 $patchtop.$e delete 0 end
7315 $patchtop.$e insert 0 $v
7316 $patchtop.$e conf -state readonly
7321 global patchtop nullid nullid2
7323 set oldid [$patchtop.fromsha1 get]
7324 set newid [$patchtop.tosha1 get]
7325 set fname [$patchtop.fname get]
7326 set cmd [diffcmd [list $oldid $newid] -p]
7327 # trim off the initial "|"
7328 set cmd [lrange $cmd 1 end]
7329 lappend cmd >$fname &
7330 if {[catch {eval exec $cmd} err]} {
7331 error_popup "[mc "Error creating patch:"] $err"
7333 catch {destroy $patchtop}
7337 proc mkpatchcan {} {
7340 catch {destroy $patchtop}
7345 global rowmenuid mktagtop commitinfo
7349 catch {destroy $top}
7351 label $top.title -text [mc "Create tag"]
7352 grid $top.title - -pady 10
7353 label $top.id -text [mc "ID:"]
7354 entry $top.sha1 -width 40 -relief flat
7355 $top.sha1 insert 0 $rowmenuid
7356 $top.sha1 conf -state readonly
7357 grid $top.id $top.sha1 -sticky w
7358 entry $top.head -width 60 -relief flat
7359 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7360 $top.head conf -state readonly
7361 grid x $top.head -sticky w
7362 label $top.tlab -text [mc "Tag name:"]
7363 entry $top.tag -width 60
7364 grid $top.tlab $top.tag -sticky w
7366 button $top.buts.gen -text [mc "Create"] -command mktaggo
7367 button $top.buts.can -text [mc "Cancel"] -command mktagcan
7368 grid $top.buts.gen $top.buts.can
7369 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7370 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7371 grid $top.buts - -pady 10 -sticky ew
7376 global mktagtop env tagids idtags
7378 set id [$mktagtop.sha1 get]
7379 set tag [$mktagtop.tag get]
7381 error_popup [mc "No tag name specified"]
7384 if {[info exists tagids($tag)]} {
7385 error_popup [mc "Tag \"%s\" already exists" $tag]
7389 exec git tag $tag $id
7391 error_popup "[mc "Error creating tag:"] $err"
7395 set tagids($tag) $id
7396 lappend idtags($id) $tag
7403 proc redrawtags {id} {
7404 global canv linehtag idpos currentid curview cmitlisted
7405 global canvxmax iddrawn circleitem mainheadid circlecolors
7407 if {![commitinview $id $curview]} return
7408 if {![info exists iddrawn($id)]} return
7409 set row [rowofcommit $id]
7410 if {$id eq $mainheadid} {
7413 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
7415 $canv itemconf $circleitem($row) -fill $ofill
7416 $canv delete tag.$id
7417 set xt [eval drawtags $id $idpos($id)]
7418 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7419 set text [$canv itemcget $linehtag($row) -text]
7420 set font [$canv itemcget $linehtag($row) -font]
7421 set xr [expr {$xt + [font measure $font $text]}]
7422 if {$xr > $canvxmax} {
7426 if {[info exists currentid] && $currentid == $id} {
7434 catch {destroy $mktagtop}
7443 proc writecommit {} {
7444 global rowmenuid wrcomtop commitinfo wrcomcmd
7446 set top .writecommit
7448 catch {destroy $top}
7450 label $top.title -text [mc "Write commit to file"]
7451 grid $top.title - -pady 10
7452 label $top.id -text [mc "ID:"]
7453 entry $top.sha1 -width 40 -relief flat
7454 $top.sha1 insert 0 $rowmenuid
7455 $top.sha1 conf -state readonly
7456 grid $top.id $top.sha1 -sticky w
7457 entry $top.head -width 60 -relief flat
7458 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7459 $top.head conf -state readonly
7460 grid x $top.head -sticky w
7461 label $top.clab -text [mc "Command:"]
7462 entry $top.cmd -width 60 -textvariable wrcomcmd
7463 grid $top.clab $top.cmd -sticky w -pady 10
7464 label $top.flab -text [mc "Output file:"]
7465 entry $top.fname -width 60
7466 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7467 grid $top.flab $top.fname -sticky w
7469 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7470 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7471 grid $top.buts.gen $top.buts.can
7472 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7473 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7474 grid $top.buts - -pady 10 -sticky ew
7481 set id [$wrcomtop.sha1 get]
7482 set cmd "echo $id | [$wrcomtop.cmd get]"
7483 set fname [$wrcomtop.fname get]
7484 if {[catch {exec sh -c $cmd >$fname &} err]} {
7485 error_popup "[mc "Error writing commit:"] $err"
7487 catch {destroy $wrcomtop}
7494 catch {destroy $wrcomtop}
7499 global rowmenuid mkbrtop
7502 catch {destroy $top}
7504 label $top.title -text [mc "Create new branch"]
7505 grid $top.title - -pady 10
7506 label $top.id -text [mc "ID:"]
7507 entry $top.sha1 -width 40 -relief flat
7508 $top.sha1 insert 0 $rowmenuid
7509 $top.sha1 conf -state readonly
7510 grid $top.id $top.sha1 -sticky w
7511 label $top.nlab -text [mc "Name:"]
7512 entry $top.name -width 40
7513 grid $top.nlab $top.name -sticky w
7515 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7516 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7517 grid $top.buts.go $top.buts.can
7518 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7519 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7520 grid $top.buts - -pady 10 -sticky ew
7525 global headids idheads
7527 set name [$top.name get]
7528 set id [$top.sha1 get]
7530 error_popup [mc "Please specify a name for the new branch"]
7533 catch {destroy $top}
7537 exec git branch $name $id
7542 set headids($name) $id
7543 lappend idheads($id) $name
7552 proc cherrypick {} {
7553 global rowmenuid curview
7554 global mainhead mainheadid
7556 set oldhead [exec git rev-parse HEAD]
7557 set dheads [descheads $rowmenuid]
7558 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7559 set ok [confirm_popup [mc "Commit %s is already\
7560 included in branch %s -- really re-apply it?" \
7561 [string range $rowmenuid 0 7] $mainhead]]
7564 nowbusy cherrypick [mc "Cherry-picking"]
7566 # Unfortunately git-cherry-pick writes stuff to stderr even when
7567 # no error occurs, and exec takes that as an indication of error...
7568 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7573 set newhead [exec git rev-parse HEAD]
7574 if {$newhead eq $oldhead} {
7576 error_popup [mc "No changes committed"]
7579 addnewchild $newhead $oldhead
7580 if {[commitinview $oldhead $curview]} {
7581 insertrow $newhead $oldhead $curview
7582 if {$mainhead ne {}} {
7583 movehead $newhead $mainhead
7584 movedhead $newhead $mainhead
7586 set mainheadid $newhead
7595 global mainhead rowmenuid confirm_ok resettype
7598 set w ".confirmreset"
7601 wm title $w [mc "Confirm reset"]
7602 message $w.m -text \
7603 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7604 -justify center -aspect 1000
7605 pack $w.m -side top -fill x -padx 20 -pady 20
7606 frame $w.f -relief sunken -border 2
7607 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7608 grid $w.f.rt -sticky w
7610 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7611 -text [mc "Soft: Leave working tree and index untouched"]
7612 grid $w.f.soft -sticky w
7613 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7614 -text [mc "Mixed: Leave working tree untouched, reset index"]
7615 grid $w.f.mixed -sticky w
7616 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7617 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7618 grid $w.f.hard -sticky w
7619 pack $w.f -side top -fill x
7620 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7621 pack $w.ok -side left -fill x -padx 20 -pady 20
7622 button $w.cancel -text [mc Cancel] -command "destroy $w"
7623 pack $w.cancel -side right -fill x -padx 20 -pady 20
7624 bind $w <Visibility> "grab $w; focus $w"
7626 if {!$confirm_ok} return
7627 if {[catch {set fd [open \
7628 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
7632 filerun $fd [list readresetstat $fd]
7633 nowbusy reset [mc "Resetting"]
7638 proc readresetstat {fd} {
7639 global mainhead mainheadid showlocalchanges rprogcoord
7641 if {[gets $fd line] >= 0} {
7642 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7643 set rprogcoord [expr {1.0 * $m / $n}]
7651 if {[catch {close $fd} err]} {
7654 set oldhead $mainheadid
7655 set newhead [exec git rev-parse HEAD]
7656 if {$newhead ne $oldhead} {
7657 movehead $newhead $mainhead
7658 movedhead $newhead $mainhead
7659 set mainheadid $newhead
7663 if {$showlocalchanges} {
7669 # context menu for a head
7670 proc headmenu {x y id head} {
7671 global headmenuid headmenuhead headctxmenu mainhead
7675 set headmenuhead $head
7677 if {$head eq $mainhead} {
7680 $headctxmenu entryconfigure 0 -state $state
7681 $headctxmenu entryconfigure 1 -state $state
7682 tk_popup $headctxmenu $x $y
7686 global headmenuid headmenuhead headids
7687 global showlocalchanges mainheadid
7689 # check the tree is clean first??
7690 nowbusy checkout [mc "Checking out"]
7694 set fd [open [list | git checkout $headmenuhead 2>@1] r]
7698 if {$showlocalchanges} {
7702 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
7706 proc readcheckoutstat {fd newhead newheadid} {
7707 global mainhead mainheadid headids showlocalchanges progresscoords
7709 if {[gets $fd line] >= 0} {
7710 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7711 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
7716 set progresscoords {0 0}
7719 if {[catch {close $fd} err]} {
7722 set oldmainid $mainheadid
7723 set mainhead $newhead
7724 set mainheadid $newheadid
7725 redrawtags $oldmainid
7726 redrawtags $newheadid
7728 if {$showlocalchanges} {
7734 global headmenuid headmenuhead mainhead
7737 set head $headmenuhead
7739 # this check shouldn't be needed any more...
7740 if {$head eq $mainhead} {
7741 error_popup [mc "Cannot delete the currently checked-out branch"]
7744 set dheads [descheads $id]
7745 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7746 # the stuff on this branch isn't on any other branch
7747 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7748 branch.\nReally delete branch %s?" $head $head]]} return
7752 if {[catch {exec git branch -D $head} err]} {
7757 removehead $id $head
7758 removedhead $id $head
7765 # Display a list of tags and heads
7767 global showrefstop bgcolor fgcolor selectbgcolor
7768 global bglist fglist reflistfilter reflist maincursor
7771 set showrefstop $top
7772 if {[winfo exists $top]} {
7778 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7779 text $top.list -background $bgcolor -foreground $fgcolor \
7780 -selectbackground $selectbgcolor -font mainfont \
7781 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7782 -width 30 -height 20 -cursor $maincursor \
7783 -spacing1 1 -spacing3 1 -state disabled
7784 $top.list tag configure highlight -background $selectbgcolor
7785 lappend bglist $top.list
7786 lappend fglist $top.list
7787 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7788 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7789 grid $top.list $top.ysb -sticky nsew
7790 grid $top.xsb x -sticky ew
7792 label $top.f.l -text "[mc "Filter"]: "
7793 entry $top.f.e -width 20 -textvariable reflistfilter
7794 set reflistfilter "*"
7795 trace add variable reflistfilter write reflistfilter_change
7796 pack $top.f.e -side right -fill x -expand 1
7797 pack $top.f.l -side left
7798 grid $top.f - -sticky ew -pady 2
7799 button $top.close -command [list destroy $top] -text [mc "Close"]
7801 grid columnconfigure $top 0 -weight 1
7802 grid rowconfigure $top 0 -weight 1
7803 bind $top.list <1> {break}
7804 bind $top.list <B1-Motion> {break}
7805 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7810 proc sel_reflist {w x y} {
7811 global showrefstop reflist headids tagids otherrefids
7813 if {![winfo exists $showrefstop]} return
7814 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7815 set ref [lindex $reflist [expr {$l-1}]]
7816 set n [lindex $ref 0]
7817 switch -- [lindex $ref 1] {
7818 "H" {selbyid $headids($n)}
7819 "T" {selbyid $tagids($n)}
7820 "o" {selbyid $otherrefids($n)}
7822 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7825 proc unsel_reflist {} {
7828 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7829 $showrefstop.list tag remove highlight 0.0 end
7832 proc reflistfilter_change {n1 n2 op} {
7833 global reflistfilter
7835 after cancel refill_reflist
7836 after 200 refill_reflist
7839 proc refill_reflist {} {
7840 global reflist reflistfilter showrefstop headids tagids otherrefids
7841 global curview commitinterest
7843 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7845 foreach n [array names headids] {
7846 if {[string match $reflistfilter $n]} {
7847 if {[commitinview $headids($n) $curview]} {
7848 lappend refs [list $n H]
7850 set commitinterest($headids($n)) {run refill_reflist}
7854 foreach n [array names tagids] {
7855 if {[string match $reflistfilter $n]} {
7856 if {[commitinview $tagids($n) $curview]} {
7857 lappend refs [list $n T]
7859 set commitinterest($tagids($n)) {run refill_reflist}
7863 foreach n [array names otherrefids] {
7864 if {[string match $reflistfilter $n]} {
7865 if {[commitinview $otherrefids($n) $curview]} {
7866 lappend refs [list $n o]
7868 set commitinterest($otherrefids($n)) {run refill_reflist}
7872 set refs [lsort -index 0 $refs]
7873 if {$refs eq $reflist} return
7875 # Update the contents of $showrefstop.list according to the
7876 # differences between $reflist (old) and $refs (new)
7877 $showrefstop.list conf -state normal
7878 $showrefstop.list insert end "\n"
7881 while {$i < [llength $reflist] || $j < [llength $refs]} {
7882 if {$i < [llength $reflist]} {
7883 if {$j < [llength $refs]} {
7884 set cmp [string compare [lindex $reflist $i 0] \
7885 [lindex $refs $j 0]]
7887 set cmp [string compare [lindex $reflist $i 1] \
7888 [lindex $refs $j 1]]
7898 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7906 set l [expr {$j + 1}]
7907 $showrefstop.list image create $l.0 -align baseline \
7908 -image reficon-[lindex $refs $j 1] -padx 2
7909 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7915 # delete last newline
7916 $showrefstop.list delete end-2c end-1c
7917 $showrefstop.list conf -state disabled
7920 # Stuff for finding nearby tags
7921 proc getallcommits {} {
7922 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7923 global idheads idtags idotherrefs allparents tagobjid
7925 if {![info exists allcommits]} {
7931 set allccache [file join [gitdir] "gitk.cache"]
7933 set f [open $allccache r]
7942 set cmd [list | git rev-list --parents]
7943 set allcupdate [expr {$seeds ne {}}]
7947 set refs [concat [array names idheads] [array names idtags] \
7948 [array names idotherrefs]]
7951 foreach name [array names tagobjid] {
7952 lappend tagobjs $tagobjid($name)
7954 foreach id [lsort -unique $refs] {
7955 if {![info exists allparents($id)] &&
7956 [lsearch -exact $tagobjs $id] < 0} {
7967 set fd [open [concat $cmd $ids] r]
7968 fconfigure $fd -blocking 0
7971 filerun $fd [list getallclines $fd]
7977 # Since most commits have 1 parent and 1 child, we group strings of
7978 # such commits into "arcs" joining branch/merge points (BMPs), which
7979 # are commits that either don't have 1 parent or don't have 1 child.
7981 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7982 # arcout(id) - outgoing arcs for BMP
7983 # arcids(a) - list of IDs on arc including end but not start
7984 # arcstart(a) - BMP ID at start of arc
7985 # arcend(a) - BMP ID at end of arc
7986 # growing(a) - arc a is still growing
7987 # arctags(a) - IDs out of arcids (excluding end) that have tags
7988 # archeads(a) - IDs out of arcids (excluding end) that have heads
7989 # The start of an arc is at the descendent end, so "incoming" means
7990 # coming from descendents, and "outgoing" means going towards ancestors.
7992 proc getallclines {fd} {
7993 global allparents allchildren idtags idheads nextarc
7994 global arcnos arcids arctags arcout arcend arcstart archeads growing
7995 global seeds allcommits cachedarcs allcupdate
7998 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7999 set id [lindex $line 0]
8000 if {[info exists allparents($id)]} {
8005 set olds [lrange $line 1 end]
8006 set allparents($id) $olds
8007 if {![info exists allchildren($id)]} {
8008 set allchildren($id) {}
8013 if {[llength $olds] == 1 && [llength $a] == 1} {
8014 lappend arcids($a) $id
8015 if {[info exists idtags($id)]} {
8016 lappend arctags($a) $id
8018 if {[info exists idheads($id)]} {
8019 lappend archeads($a) $id
8021 if {[info exists allparents($olds)]} {
8022 # seen parent already
8023 if {![info exists arcout($olds)]} {
8026 lappend arcids($a) $olds
8027 set arcend($a) $olds
8030 lappend allchildren($olds) $id
8031 lappend arcnos($olds) $a
8035 foreach a $arcnos($id) {
8036 lappend arcids($a) $id
8043 lappend allchildren($p) $id
8044 set a [incr nextarc]
8045 set arcstart($a) $id
8052 if {[info exists allparents($p)]} {
8053 # seen it already, may need to make a new branch
8054 if {![info exists arcout($p)]} {
8057 lappend arcids($a) $p
8061 lappend arcnos($p) $a
8066 global cached_dheads cached_dtags cached_atags
8067 catch {unset cached_dheads}
8068 catch {unset cached_dtags}
8069 catch {unset cached_atags}
8072 return [expr {$nid >= 1000? 2: 1}]
8076 fconfigure $fd -blocking 1
8079 # got an error reading the list of commits
8080 # if we were updating, try rereading the whole thing again
8086 error_popup "[mc "Error reading commit topology information;\
8087 branch and preceding/following tag information\
8088 will be incomplete."]\n($err)"
8091 if {[incr allcommits -1] == 0} {
8101 proc recalcarc {a} {
8102 global arctags archeads arcids idtags idheads
8106 foreach id [lrange $arcids($a) 0 end-1] {
8107 if {[info exists idtags($id)]} {
8110 if {[info exists idheads($id)]} {
8115 set archeads($a) $ah
8119 global arcnos arcids nextarc arctags archeads idtags idheads
8120 global arcstart arcend arcout allparents growing
8123 if {[llength $a] != 1} {
8124 puts "oops splitarc called but [llength $a] arcs already"
8128 set i [lsearch -exact $arcids($a) $p]
8130 puts "oops splitarc $p not in arc $a"
8133 set na [incr nextarc]
8134 if {[info exists arcend($a)]} {
8135 set arcend($na) $arcend($a)
8137 set l [lindex $allparents([lindex $arcids($a) end]) 0]
8138 set j [lsearch -exact $arcnos($l) $a]
8139 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8141 set tail [lrange $arcids($a) [expr {$i+1}] end]
8142 set arcids($a) [lrange $arcids($a) 0 $i]
8144 set arcstart($na) $p
8146 set arcids($na) $tail
8147 if {[info exists growing($a)]} {
8153 if {[llength $arcnos($id)] == 1} {
8156 set j [lsearch -exact $arcnos($id) $a]
8157 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8161 # reconstruct tags and heads lists
8162 if {$arctags($a) ne {} || $archeads($a) ne {}} {
8167 set archeads($na) {}
8171 # Update things for a new commit added that is a child of one
8172 # existing commit. Used when cherry-picking.
8173 proc addnewchild {id p} {
8174 global allparents allchildren idtags nextarc
8175 global arcnos arcids arctags arcout arcend arcstart archeads growing
8176 global seeds allcommits
8178 if {![info exists allcommits] || ![info exists arcnos($p)]} return
8179 set allparents($id) [list $p]
8180 set allchildren($id) {}
8183 lappend allchildren($p) $id
8184 set a [incr nextarc]
8185 set arcstart($a) $id
8188 set arcids($a) [list $p]
8190 if {![info exists arcout($p)]} {
8193 lappend arcnos($p) $a
8194 set arcout($id) [list $a]
8197 # This implements a cache for the topology information.
8198 # The cache saves, for each arc, the start and end of the arc,
8199 # the ids on the arc, and the outgoing arcs from the end.
8200 proc readcache {f} {
8201 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8202 global idtags idheads allparents cachedarcs possible_seeds seeds growing
8207 if {$lim - $a > 500} {
8208 set lim [expr {$a + 500}]
8212 # finish reading the cache and setting up arctags, etc.
8214 if {$line ne "1"} {error "bad final version"}
8216 foreach id [array names idtags] {
8217 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8218 [llength $allparents($id)] == 1} {
8219 set a [lindex $arcnos($id) 0]
8220 if {$arctags($a) eq {}} {
8225 foreach id [array names idheads] {
8226 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8227 [llength $allparents($id)] == 1} {
8228 set a [lindex $arcnos($id) 0]
8229 if {$archeads($a) eq {}} {
8234 foreach id [lsort -unique $possible_seeds] {
8235 if {$arcnos($id) eq {}} {
8241 while {[incr a] <= $lim} {
8243 if {[llength $line] != 3} {error "bad line"}
8244 set s [lindex $line 0]
8246 lappend arcout($s) $a
8247 if {![info exists arcnos($s)]} {
8248 lappend possible_seeds $s
8251 set e [lindex $line 1]
8256 if {![info exists arcout($e)]} {
8260 set arcids($a) [lindex $line 2]
8261 foreach id $arcids($a) {
8262 lappend allparents($s) $id
8264 lappend arcnos($id) $a
8266 if {![info exists allparents($s)]} {
8267 set allparents($s) {}
8272 set nextarc [expr {$a - 1}]
8285 global nextarc cachedarcs possible_seeds
8289 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8290 # make sure it's an integer
8291 set cachedarcs [expr {int([lindex $line 1])}]
8292 if {$cachedarcs < 0} {error "bad number of arcs"}
8294 set possible_seeds {}
8302 proc dropcache {err} {
8303 global allcwait nextarc cachedarcs seeds
8305 #puts "dropping cache ($err)"
8306 foreach v {arcnos arcout arcids arcstart arcend growing \
8307 arctags archeads allparents allchildren} {
8318 proc writecache {f} {
8319 global cachearc cachedarcs allccache
8320 global arcstart arcend arcnos arcids arcout
8324 if {$lim - $a > 1000} {
8325 set lim [expr {$a + 1000}]
8328 while {[incr a] <= $lim} {
8329 if {[info exists arcend($a)]} {
8330 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8332 puts $f [list $arcstart($a) {} $arcids($a)]
8337 catch {file delete $allccache}
8338 #puts "writing cache failed ($err)"
8341 set cachearc [expr {$a - 1}]
8342 if {$a > $cachedarcs} {
8351 global nextarc cachedarcs cachearc allccache
8353 if {$nextarc == $cachedarcs} return
8355 set cachedarcs $nextarc
8357 set f [open $allccache w]
8358 puts $f [list 1 $cachedarcs]
8363 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8364 # or 0 if neither is true.
8365 proc anc_or_desc {a b} {
8366 global arcout arcstart arcend arcnos cached_isanc
8368 if {$arcnos($a) eq $arcnos($b)} {
8369 # Both are on the same arc(s); either both are the same BMP,
8370 # or if one is not a BMP, the other is also not a BMP or is
8371 # the BMP at end of the arc (and it only has 1 incoming arc).
8372 # Or both can be BMPs with no incoming arcs.
8373 if {$a eq $b || $arcnos($a) eq {}} {
8376 # assert {[llength $arcnos($a)] == 1}
8377 set arc [lindex $arcnos($a) 0]
8378 set i [lsearch -exact $arcids($arc) $a]
8379 set j [lsearch -exact $arcids($arc) $b]
8380 if {$i < 0 || $i > $j} {
8387 if {![info exists arcout($a)]} {
8388 set arc [lindex $arcnos($a) 0]
8389 if {[info exists arcend($arc)]} {
8390 set aend $arcend($arc)
8394 set a $arcstart($arc)
8398 if {![info exists arcout($b)]} {
8399 set arc [lindex $arcnos($b) 0]
8400 if {[info exists arcend($arc)]} {
8401 set bend $arcend($arc)
8405 set b $arcstart($arc)
8415 if {[info exists cached_isanc($a,$bend)]} {
8416 if {$cached_isanc($a,$bend)} {
8420 if {[info exists cached_isanc($b,$aend)]} {
8421 if {$cached_isanc($b,$aend)} {
8424 if {[info exists cached_isanc($a,$bend)]} {
8429 set todo [list $a $b]
8432 for {set i 0} {$i < [llength $todo]} {incr i} {
8433 set x [lindex $todo $i]
8434 if {$anc($x) eq {}} {
8437 foreach arc $arcnos($x) {
8438 set xd $arcstart($arc)
8440 set cached_isanc($a,$bend) 1
8441 set cached_isanc($b,$aend) 0
8443 } elseif {$xd eq $aend} {
8444 set cached_isanc($b,$aend) 1
8445 set cached_isanc($a,$bend) 0
8448 if {![info exists anc($xd)]} {
8449 set anc($xd) $anc($x)
8451 } elseif {$anc($xd) ne $anc($x)} {
8456 set cached_isanc($a,$bend) 0
8457 set cached_isanc($b,$aend) 0
8461 # This identifies whether $desc has an ancestor that is
8462 # a growing tip of the graph and which is not an ancestor of $anc
8463 # and returns 0 if so and 1 if not.
8464 # If we subsequently discover a tag on such a growing tip, and that
8465 # turns out to be a descendent of $anc (which it could, since we
8466 # don't necessarily see children before parents), then $desc
8467 # isn't a good choice to display as a descendent tag of
8468 # $anc (since it is the descendent of another tag which is
8469 # a descendent of $anc). Similarly, $anc isn't a good choice to
8470 # display as a ancestor tag of $desc.
8472 proc is_certain {desc anc} {
8473 global arcnos arcout arcstart arcend growing problems
8476 if {[llength $arcnos($anc)] == 1} {
8477 # tags on the same arc are certain
8478 if {$arcnos($desc) eq $arcnos($anc)} {
8481 if {![info exists arcout($anc)]} {
8482 # if $anc is partway along an arc, use the start of the arc instead
8483 set a [lindex $arcnos($anc) 0]
8484 set anc $arcstart($a)
8487 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8490 set a [lindex $arcnos($desc) 0]
8496 set anclist [list $x]
8500 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8501 set x [lindex $anclist $i]
8506 foreach a $arcout($x) {
8507 if {[info exists growing($a)]} {
8508 if {![info exists growanc($x)] && $dl($x)} {
8514 if {[info exists dl($y)]} {
8518 if {![info exists done($y)]} {
8521 if {[info exists growanc($x)]} {
8525 for {set k 0} {$k < [llength $xl]} {incr k} {
8526 set z [lindex $xl $k]
8527 foreach c $arcout($z) {
8528 if {[info exists arcend($c)]} {
8530 if {[info exists dl($v)] && $dl($v)} {
8532 if {![info exists done($v)]} {
8535 if {[info exists growanc($v)]} {
8545 } elseif {$y eq $anc || !$dl($x)} {
8556 foreach x [array names growanc] {
8565 proc validate_arctags {a} {
8566 global arctags idtags
8570 foreach id $arctags($a) {
8572 if {![info exists idtags($id)]} {
8573 set na [lreplace $na $i $i]
8580 proc validate_archeads {a} {
8581 global archeads idheads
8584 set na $archeads($a)
8585 foreach id $archeads($a) {
8587 if {![info exists idheads($id)]} {
8588 set na [lreplace $na $i $i]
8592 set archeads($a) $na
8595 # Return the list of IDs that have tags that are descendents of id,
8596 # ignoring IDs that are descendents of IDs already reported.
8597 proc desctags {id} {
8598 global arcnos arcstart arcids arctags idtags allparents
8599 global growing cached_dtags
8601 if {![info exists allparents($id)]} {
8604 set t1 [clock clicks -milliseconds]
8606 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8607 # part-way along an arc; check that arc first
8608 set a [lindex $arcnos($id) 0]
8609 if {$arctags($a) ne {}} {
8611 set i [lsearch -exact $arcids($a) $id]
8613 foreach t $arctags($a) {
8614 set j [lsearch -exact $arcids($a) $t]
8622 set id $arcstart($a)
8623 if {[info exists idtags($id)]} {
8627 if {[info exists cached_dtags($id)]} {
8628 return $cached_dtags($id)
8635 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8636 set id [lindex $todo $i]
8638 set ta [info exists hastaggedancestor($id)]
8642 # ignore tags on starting node
8643 if {!$ta && $i > 0} {
8644 if {[info exists idtags($id)]} {
8647 } elseif {[info exists cached_dtags($id)]} {
8648 set tagloc($id) $cached_dtags($id)
8652 foreach a $arcnos($id) {
8654 if {!$ta && $arctags($a) ne {}} {
8656 if {$arctags($a) ne {}} {
8657 lappend tagloc($id) [lindex $arctags($a) end]
8660 if {$ta || $arctags($a) ne {}} {
8661 set tomark [list $d]
8662 for {set j 0} {$j < [llength $tomark]} {incr j} {
8663 set dd [lindex $tomark $j]
8664 if {![info exists hastaggedancestor($dd)]} {
8665 if {[info exists done($dd)]} {
8666 foreach b $arcnos($dd) {
8667 lappend tomark $arcstart($b)
8669 if {[info exists tagloc($dd)]} {
8672 } elseif {[info exists queued($dd)]} {
8675 set hastaggedancestor($dd) 1
8679 if {![info exists queued($d)]} {
8682 if {![info exists hastaggedancestor($d)]} {
8689 foreach id [array names tagloc] {
8690 if {![info exists hastaggedancestor($id)]} {
8691 foreach t $tagloc($id) {
8692 if {[lsearch -exact $tags $t] < 0} {
8698 set t2 [clock clicks -milliseconds]
8701 # remove tags that are descendents of other tags
8702 for {set i 0} {$i < [llength $tags]} {incr i} {
8703 set a [lindex $tags $i]
8704 for {set j 0} {$j < $i} {incr j} {
8705 set b [lindex $tags $j]
8706 set r [anc_or_desc $a $b]
8708 set tags [lreplace $tags $j $j]
8711 } elseif {$r == -1} {
8712 set tags [lreplace $tags $i $i]
8719 if {[array names growing] ne {}} {
8720 # graph isn't finished, need to check if any tag could get
8721 # eclipsed by another tag coming later. Simply ignore any
8722 # tags that could later get eclipsed.
8725 if {[is_certain $t $origid]} {
8729 if {$tags eq $ctags} {
8730 set cached_dtags($origid) $tags
8735 set cached_dtags($origid) $tags
8737 set t3 [clock clicks -milliseconds]
8738 if {0 && $t3 - $t1 >= 100} {
8739 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8740 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8746 global arcnos arcids arcout arcend arctags idtags allparents
8747 global growing cached_atags
8749 if {![info exists allparents($id)]} {
8752 set t1 [clock clicks -milliseconds]
8754 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8755 # part-way along an arc; check that arc first
8756 set a [lindex $arcnos($id) 0]
8757 if {$arctags($a) ne {}} {
8759 set i [lsearch -exact $arcids($a) $id]
8760 foreach t $arctags($a) {
8761 set j [lsearch -exact $arcids($a) $t]
8767 if {![info exists arcend($a)]} {
8771 if {[info exists idtags($id)]} {
8775 if {[info exists cached_atags($id)]} {
8776 return $cached_atags($id)
8784 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8785 set id [lindex $todo $i]
8787 set td [info exists hastaggeddescendent($id)]
8791 # ignore tags on starting node
8792 if {!$td && $i > 0} {
8793 if {[info exists idtags($id)]} {
8796 } elseif {[info exists cached_atags($id)]} {
8797 set tagloc($id) $cached_atags($id)
8801 foreach a $arcout($id) {
8802 if {!$td && $arctags($a) ne {}} {
8804 if {$arctags($a) ne {}} {
8805 lappend tagloc($id) [lindex $arctags($a) 0]
8808 if {![info exists arcend($a)]} continue
8810 if {$td || $arctags($a) ne {}} {
8811 set tomark [list $d]
8812 for {set j 0} {$j < [llength $tomark]} {incr j} {
8813 set dd [lindex $tomark $j]
8814 if {![info exists hastaggeddescendent($dd)]} {
8815 if {[info exists done($dd)]} {
8816 foreach b $arcout($dd) {
8817 if {[info exists arcend($b)]} {
8818 lappend tomark $arcend($b)
8821 if {[info exists tagloc($dd)]} {
8824 } elseif {[info exists queued($dd)]} {
8827 set hastaggeddescendent($dd) 1
8831 if {![info exists queued($d)]} {
8834 if {![info exists hastaggeddescendent($d)]} {
8840 set t2 [clock clicks -milliseconds]
8843 foreach id [array names tagloc] {
8844 if {![info exists hastaggeddescendent($id)]} {
8845 foreach t $tagloc($id) {
8846 if {[lsearch -exact $tags $t] < 0} {
8853 # remove tags that are ancestors of other tags
8854 for {set i 0} {$i < [llength $tags]} {incr i} {
8855 set a [lindex $tags $i]
8856 for {set j 0} {$j < $i} {incr j} {
8857 set b [lindex $tags $j]
8858 set r [anc_or_desc $a $b]
8860 set tags [lreplace $tags $j $j]
8863 } elseif {$r == 1} {
8864 set tags [lreplace $tags $i $i]
8871 if {[array names growing] ne {}} {
8872 # graph isn't finished, need to check if any tag could get
8873 # eclipsed by another tag coming later. Simply ignore any
8874 # tags that could later get eclipsed.
8877 if {[is_certain $origid $t]} {
8881 if {$tags eq $ctags} {
8882 set cached_atags($origid) $tags
8887 set cached_atags($origid) $tags
8889 set t3 [clock clicks -milliseconds]
8890 if {0 && $t3 - $t1 >= 100} {
8891 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8892 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8897 # Return the list of IDs that have heads that are descendents of id,
8898 # including id itself if it has a head.
8899 proc descheads {id} {
8900 global arcnos arcstart arcids archeads idheads cached_dheads
8903 if {![info exists allparents($id)]} {
8907 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8908 # part-way along an arc; check it first
8909 set a [lindex $arcnos($id) 0]
8910 if {$archeads($a) ne {}} {
8911 validate_archeads $a
8912 set i [lsearch -exact $arcids($a) $id]
8913 foreach t $archeads($a) {
8914 set j [lsearch -exact $arcids($a) $t]
8919 set id $arcstart($a)
8925 for {set i 0} {$i < [llength $todo]} {incr i} {
8926 set id [lindex $todo $i]
8927 if {[info exists cached_dheads($id)]} {
8928 set ret [concat $ret $cached_dheads($id)]
8930 if {[info exists idheads($id)]} {
8933 foreach a $arcnos($id) {
8934 if {$archeads($a) ne {}} {
8935 validate_archeads $a
8936 if {$archeads($a) ne {}} {
8937 set ret [concat $ret $archeads($a)]
8941 if {![info exists seen($d)]} {
8948 set ret [lsort -unique $ret]
8949 set cached_dheads($origid) $ret
8950 return [concat $ret $aret]
8953 proc addedtag {id} {
8954 global arcnos arcout cached_dtags cached_atags
8956 if {![info exists arcnos($id)]} return
8957 if {![info exists arcout($id)]} {
8958 recalcarc [lindex $arcnos($id) 0]
8960 catch {unset cached_dtags}
8961 catch {unset cached_atags}
8964 proc addedhead {hid head} {
8965 global arcnos arcout cached_dheads
8967 if {![info exists arcnos($hid)]} return
8968 if {![info exists arcout($hid)]} {
8969 recalcarc [lindex $arcnos($hid) 0]
8971 catch {unset cached_dheads}
8974 proc removedhead {hid head} {
8975 global cached_dheads
8977 catch {unset cached_dheads}
8980 proc movedhead {hid head} {
8981 global arcnos arcout cached_dheads
8983 if {![info exists arcnos($hid)]} return
8984 if {![info exists arcout($hid)]} {
8985 recalcarc [lindex $arcnos($hid) 0]
8987 catch {unset cached_dheads}
8990 proc changedrefs {} {
8991 global cached_dheads cached_dtags cached_atags
8992 global arctags archeads arcnos arcout idheads idtags
8994 foreach id [concat [array names idheads] [array names idtags]] {
8995 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8996 set a [lindex $arcnos($id) 0]
8997 if {![info exists donearc($a)]} {
9003 catch {unset cached_dtags}
9004 catch {unset cached_atags}
9005 catch {unset cached_dheads}
9008 proc rereadrefs {} {
9009 global idtags idheads idotherrefs mainheadid
9011 set refids [concat [array names idtags] \
9012 [array names idheads] [array names idotherrefs]]
9013 foreach id $refids {
9014 if {![info exists ref($id)]} {
9015 set ref($id) [listrefs $id]
9018 set oldmainhead $mainheadid
9021 set refids [lsort -unique [concat $refids [array names idtags] \
9022 [array names idheads] [array names idotherrefs]]]
9023 foreach id $refids {
9024 set v [listrefs $id]
9025 if {![info exists ref($id)] || $ref($id) != $v} {
9029 if {$oldmainhead ne $mainheadid} {
9030 redrawtags $oldmainhead
9031 redrawtags $mainheadid
9036 proc listrefs {id} {
9037 global idtags idheads idotherrefs
9040 if {[info exists idtags($id)]} {
9044 if {[info exists idheads($id)]} {
9048 if {[info exists idotherrefs($id)]} {
9049 set z $idotherrefs($id)
9051 return [list $x $y $z]
9054 proc showtag {tag isnew} {
9055 global ctext tagcontents tagids linknum tagobjid
9058 addtohistory [list showtag $tag 0]
9060 $ctext conf -state normal
9064 if {![info exists tagcontents($tag)]} {
9066 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9069 if {[info exists tagcontents($tag)]} {
9070 set text $tagcontents($tag)
9072 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
9074 appendwithlinks $text {}
9075 $ctext conf -state disabled
9087 if {[info exists gitktmpdir]} {
9088 catch {file delete -force $gitktmpdir}
9092 proc mkfontdisp {font top which} {
9093 global fontattr fontpref $font
9095 set fontpref($font) [set $font]
9096 button $top.${font}but -text $which -font optionfont \
9097 -command [list choosefont $font $which]
9098 label $top.$font -relief flat -font $font \
9099 -text $fontattr($font,family) -justify left
9100 grid x $top.${font}but $top.$font -sticky w
9103 proc choosefont {font which} {
9104 global fontparam fontlist fonttop fontattr
9106 set fontparam(which) $which
9107 set fontparam(font) $font
9108 set fontparam(family) [font actual $font -family]
9109 set fontparam(size) $fontattr($font,size)
9110 set fontparam(weight) $fontattr($font,weight)
9111 set fontparam(slant) $fontattr($font,slant)
9114 if {![winfo exists $top]} {
9116 eval font config sample [font actual $font]
9118 wm title $top [mc "Gitk font chooser"]
9119 label $top.l -textvariable fontparam(which)
9120 pack $top.l -side top
9121 set fontlist [lsort [font families]]
9123 listbox $top.f.fam -listvariable fontlist \
9124 -yscrollcommand [list $top.f.sb set]
9125 bind $top.f.fam <<ListboxSelect>> selfontfam
9126 scrollbar $top.f.sb -command [list $top.f.fam yview]
9127 pack $top.f.sb -side right -fill y
9128 pack $top.f.fam -side left -fill both -expand 1
9129 pack $top.f -side top -fill both -expand 1
9131 spinbox $top.g.size -from 4 -to 40 -width 4 \
9132 -textvariable fontparam(size) \
9133 -validatecommand {string is integer -strict %s}
9134 checkbutton $top.g.bold -padx 5 \
9135 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9136 -variable fontparam(weight) -onvalue bold -offvalue normal
9137 checkbutton $top.g.ital -padx 5 \
9138 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9139 -variable fontparam(slant) -onvalue italic -offvalue roman
9140 pack $top.g.size $top.g.bold $top.g.ital -side left
9141 pack $top.g -side top
9142 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9144 $top.c create text 100 25 -anchor center -text $which -font sample \
9145 -fill black -tags text
9146 bind $top.c <Configure> [list centertext $top.c]
9147 pack $top.c -side top -fill x
9149 button $top.buts.ok -text [mc "OK"] -command fontok -default active
9150 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9151 grid $top.buts.ok $top.buts.can
9152 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9153 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9154 pack $top.buts -side bottom -fill x
9155 trace add variable fontparam write chg_fontparam
9158 $top.c itemconf text -text $which
9160 set i [lsearch -exact $fontlist $fontparam(family)]
9162 $top.f.fam selection set $i
9167 proc centertext {w} {
9168 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9172 global fontparam fontpref prefstop
9174 set f $fontparam(font)
9175 set fontpref($f) [list $fontparam(family) $fontparam(size)]
9176 if {$fontparam(weight) eq "bold"} {
9177 lappend fontpref($f) "bold"
9179 if {$fontparam(slant) eq "italic"} {
9180 lappend fontpref($f) "italic"
9183 $w conf -text $fontparam(family) -font $fontpref($f)
9189 global fonttop fontparam
9191 if {[info exists fonttop]} {
9192 catch {destroy $fonttop}
9193 catch {font delete sample}
9199 proc selfontfam {} {
9200 global fonttop fontparam
9202 set i [$fonttop.f.fam curselection]
9204 set fontparam(family) [$fonttop.f.fam get $i]
9208 proc chg_fontparam {v sub op} {
9211 font config sample -$sub $fontparam($sub)
9215 global maxwidth maxgraphpct
9216 global oldprefs prefstop showneartags showlocalchanges
9217 global bgcolor fgcolor ctext diffcolors selectbgcolor
9218 global tabstop limitdiffs autoselect extdifftool
9222 if {[winfo exists $top]} {
9226 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9227 limitdiffs tabstop} {
9228 set oldprefs($v) [set $v]
9231 wm title $top [mc "Gitk preferences"]
9232 label $top.ldisp -text [mc "Commit list display options"]
9233 grid $top.ldisp - -sticky w -pady 10
9234 label $top.spacer -text " "
9235 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9237 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9238 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9239 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9241 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9242 grid x $top.maxpctl $top.maxpct -sticky w
9243 frame $top.showlocal
9244 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9245 checkbutton $top.showlocal.b -variable showlocalchanges
9246 pack $top.showlocal.b $top.showlocal.l -side left
9247 grid x $top.showlocal -sticky w
9248 frame $top.autoselect
9249 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9250 checkbutton $top.autoselect.b -variable autoselect
9251 pack $top.autoselect.b $top.autoselect.l -side left
9252 grid x $top.autoselect -sticky w
9254 label $top.ddisp -text [mc "Diff display options"]
9255 grid $top.ddisp - -sticky w -pady 10
9256 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9257 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9258 grid x $top.tabstopl $top.tabstop -sticky w
9260 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9261 checkbutton $top.ntag.b -variable showneartags
9262 pack $top.ntag.b $top.ntag.l -side left
9263 grid x $top.ntag -sticky w
9265 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9266 checkbutton $top.ldiff.b -variable limitdiffs
9267 pack $top.ldiff.b $top.ldiff.l -side left
9268 grid x $top.ldiff -sticky w
9270 entry $top.extdifft -textvariable extdifftool
9272 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9274 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9275 -command choose_extdiff
9276 pack $top.extdifff.l $top.extdifff.b -side left
9277 grid x $top.extdifff $top.extdifft -sticky w
9279 label $top.cdisp -text [mc "Colors: press to choose"]
9280 grid $top.cdisp - -sticky w -pady 10
9281 label $top.bg -padx 40 -relief sunk -background $bgcolor
9282 button $top.bgbut -text [mc "Background"] -font optionfont \
9283 -command [list choosecolor bgcolor {} $top.bg background setbg]
9284 grid x $top.bgbut $top.bg -sticky w
9285 label $top.fg -padx 40 -relief sunk -background $fgcolor
9286 button $top.fgbut -text [mc "Foreground"] -font optionfont \
9287 -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9288 grid x $top.fgbut $top.fg -sticky w
9289 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9290 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9291 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9292 [list $ctext tag conf d0 -foreground]]
9293 grid x $top.diffoldbut $top.diffold -sticky w
9294 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9295 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9296 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9297 [list $ctext tag conf d1 -foreground]]
9298 grid x $top.diffnewbut $top.diffnew -sticky w
9299 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9300 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9301 -command [list choosecolor diffcolors 2 $top.hunksep \
9302 "diff hunk header" \
9303 [list $ctext tag conf hunksep -foreground]]
9304 grid x $top.hunksepbut $top.hunksep -sticky w
9305 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9306 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9307 -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9308 grid x $top.selbgbut $top.selbgsep -sticky w
9310 label $top.cfont -text [mc "Fonts: press to choose"]
9311 grid $top.cfont - -sticky w -pady 10
9312 mkfontdisp mainfont $top [mc "Main font"]
9313 mkfontdisp textfont $top [mc "Diff display font"]
9314 mkfontdisp uifont $top [mc "User interface font"]
9317 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9318 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9319 grid $top.buts.ok $top.buts.can
9320 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9321 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9322 grid $top.buts - - -pady 10 -sticky ew
9323 bind $top <Visibility> "focus $top.buts.ok"
9326 proc choose_extdiff {} {
9329 set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9331 set extdifftool $prog
9335 proc choosecolor {v vi w x cmd} {
9338 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9339 -title [mc "Gitk: choose color for %s" $x]]
9340 if {$c eq {}} return
9341 $w conf -background $c
9347 global bglist cflist
9349 $w configure -selectbackground $c
9351 $cflist tag configure highlight \
9352 -background [$cflist cget -selectbackground]
9353 allcanvs itemconf secsel -fill $c
9360 $w conf -background $c
9368 $w conf -foreground $c
9370 allcanvs itemconf text -fill $c
9371 $canv itemconf circle -outline $c
9375 global oldprefs prefstop
9377 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9378 limitdiffs tabstop} {
9380 set $v $oldprefs($v)
9382 catch {destroy $prefstop}
9388 global maxwidth maxgraphpct
9389 global oldprefs prefstop showneartags showlocalchanges
9390 global fontpref mainfont textfont uifont
9391 global limitdiffs treediffs
9393 catch {destroy $prefstop}
9397 if {$mainfont ne $fontpref(mainfont)} {
9398 set mainfont $fontpref(mainfont)
9399 parsefont mainfont $mainfont
9400 eval font configure mainfont [fontflags mainfont]
9401 eval font configure mainfontbold [fontflags mainfont 1]
9405 if {$textfont ne $fontpref(textfont)} {
9406 set textfont $fontpref(textfont)
9407 parsefont textfont $textfont
9408 eval font configure textfont [fontflags textfont]
9409 eval font configure textfontbold [fontflags textfont 1]
9411 if {$uifont ne $fontpref(uifont)} {
9412 set uifont $fontpref(uifont)
9413 parsefont uifont $uifont
9414 eval font configure uifont [fontflags uifont]
9417 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9418 if {$showlocalchanges} {
9424 if {$limitdiffs != $oldprefs(limitdiffs)} {
9425 # treediffs elements are limited by path
9426 catch {unset treediffs}
9428 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9429 || $maxgraphpct != $oldprefs(maxgraphpct)} {
9431 } elseif {$showneartags != $oldprefs(showneartags) ||
9432 $limitdiffs != $oldprefs(limitdiffs)} {
9437 proc formatdate {d} {
9438 global datetimeformat
9440 set d [clock format $d -format $datetimeformat]
9445 # This list of encoding names and aliases is distilled from
9446 # http://www.iana.org/assignments/character-sets.
9447 # Not all of them are supported by Tcl.
9448 set encoding_aliases {
9449 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9450 ISO646-US US-ASCII us IBM367 cp367 csASCII }
9451 { ISO-10646-UTF-1 csISO10646UTF1 }
9452 { ISO_646.basic:1983 ref csISO646basic1983 }
9453 { INVARIANT csINVARIANT }
9454 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9455 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9456 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9457 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9458 { NATS-DANO iso-ir-9-1 csNATSDANO }
9459 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9460 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9461 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9462 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9463 { ISO-2022-KR csISO2022KR }
9465 { ISO-2022-JP csISO2022JP }
9466 { ISO-2022-JP-2 csISO2022JP2 }
9467 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9469 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9470 { IT iso-ir-15 ISO646-IT csISO15Italian }
9471 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9472 { ES iso-ir-17 ISO646-ES csISO17Spanish }
9473 { greek7-old iso-ir-18 csISO18Greek7Old }
9474 { latin-greek iso-ir-19 csISO19LatinGreek }
9475 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9476 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9477 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9478 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9479 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9480 { BS_viewdata iso-ir-47 csISO47BSViewdata }
9481 { INIS iso-ir-49 csISO49INIS }
9482 { INIS-8 iso-ir-50 csISO50INIS8 }
9483 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9484 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9485 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9486 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9487 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9488 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9490 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9491 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9492 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9493 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9494 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9495 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9496 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9497 { greek7 iso-ir-88 csISO88Greek7 }
9498 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9499 { iso-ir-90 csISO90 }
9500 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9501 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9502 csISO92JISC62991984b }
9503 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9504 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9505 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9506 csISO95JIS62291984handadd }
9507 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9508 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9509 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9510 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9512 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9513 { T.61-7bit iso-ir-102 csISO102T617bit }
9514 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9515 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9516 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9517 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9518 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9519 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9520 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9521 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9522 arabic csISOLatinArabic }
9523 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9524 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9525 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9526 greek greek8 csISOLatinGreek }
9527 { T.101-G2 iso-ir-128 csISO128T101G2 }
9528 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9530 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9531 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9532 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9533 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9534 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9535 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9536 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9537 csISOLatinCyrillic }
9538 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9539 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9540 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9541 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9542 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9543 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9544 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9545 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9546 { ISO_10367-box iso-ir-155 csISO10367Box }
9547 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9548 { latin-lap lap iso-ir-158 csISO158Lap }
9549 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9550 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9553 { JIS_X0201 X0201 csHalfWidthKatakana }
9554 { KSC5636 ISO646-KR csKSC5636 }
9555 { ISO-10646-UCS-2 csUnicode }
9556 { ISO-10646-UCS-4 csUCS4 }
9557 { DEC-MCS dec csDECMCS }
9558 { hp-roman8 roman8 r8 csHPRoman8 }
9559 { macintosh mac csMacintosh }
9560 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9562 { IBM038 EBCDIC-INT cp038 csIBM038 }
9563 { IBM273 CP273 csIBM273 }
9564 { IBM274 EBCDIC-BE CP274 csIBM274 }
9565 { IBM275 EBCDIC-BR cp275 csIBM275 }
9566 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9567 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9568 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9569 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9570 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9571 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9572 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9573 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9574 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9575 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9576 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9577 { IBM437 cp437 437 csPC8CodePage437 }
9578 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9579 { IBM775 cp775 csPC775Baltic }
9580 { IBM850 cp850 850 csPC850Multilingual }
9581 { IBM851 cp851 851 csIBM851 }
9582 { IBM852 cp852 852 csPCp852 }
9583 { IBM855 cp855 855 csIBM855 }
9584 { IBM857 cp857 857 csIBM857 }
9585 { IBM860 cp860 860 csIBM860 }
9586 { IBM861 cp861 861 cp-is csIBM861 }
9587 { IBM862 cp862 862 csPC862LatinHebrew }
9588 { IBM863 cp863 863 csIBM863 }
9589 { IBM864 cp864 csIBM864 }
9590 { IBM865 cp865 865 csIBM865 }
9591 { IBM866 cp866 866 csIBM866 }
9592 { IBM868 CP868 cp-ar csIBM868 }
9593 { IBM869 cp869 869 cp-gr csIBM869 }
9594 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9595 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9596 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9597 { IBM891 cp891 csIBM891 }
9598 { IBM903 cp903 csIBM903 }
9599 { IBM904 cp904 904 csIBBM904 }
9600 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9601 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9602 { IBM1026 CP1026 csIBM1026 }
9603 { EBCDIC-AT-DE csIBMEBCDICATDE }
9604 { EBCDIC-AT-DE-A csEBCDICATDEA }
9605 { EBCDIC-CA-FR csEBCDICCAFR }
9606 { EBCDIC-DK-NO csEBCDICDKNO }
9607 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9608 { EBCDIC-FI-SE csEBCDICFISE }
9609 { EBCDIC-FI-SE-A csEBCDICFISEA }
9610 { EBCDIC-FR csEBCDICFR }
9611 { EBCDIC-IT csEBCDICIT }
9612 { EBCDIC-PT csEBCDICPT }
9613 { EBCDIC-ES csEBCDICES }
9614 { EBCDIC-ES-A csEBCDICESA }
9615 { EBCDIC-ES-S csEBCDICESS }
9616 { EBCDIC-UK csEBCDICUK }
9617 { EBCDIC-US csEBCDICUS }
9618 { UNKNOWN-8BIT csUnknown8BiT }
9619 { MNEMONIC csMnemonic }
9624 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9625 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9626 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9627 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9628 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9629 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9630 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9631 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9632 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9633 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9634 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9635 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9636 { IBM1047 IBM-1047 }
9637 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9638 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9639 { UNICODE-1-1 csUnicode11 }
9642 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9643 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9645 { ISO-8859-15 ISO_8859-15 Latin-9 }
9646 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9647 { GBK CP936 MS936 windows-936 }
9648 { JIS_Encoding csJISEncoding }
9649 { Shift_JIS MS_Kanji csShiftJIS }
9650 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9652 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9653 { ISO-10646-UCS-Basic csUnicodeASCII }
9654 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9655 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9656 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9657 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9658 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9659 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9660 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9661 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9662 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9663 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9664 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9665 { Ventura-US csVenturaUS }
9666 { Ventura-International csVenturaInternational }
9667 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9668 { PC8-Turkish csPC8Turkish }
9669 { IBM-Symbols csIBMSymbols }
9670 { IBM-Thai csIBMThai }
9671 { HP-Legal csHPLegal }
9672 { HP-Pi-font csHPPiFont }
9673 { HP-Math8 csHPMath8 }
9674 { Adobe-Symbol-Encoding csHPPSMath }
9675 { HP-DeskTop csHPDesktop }
9676 { Ventura-Math csVenturaMath }
9677 { Microsoft-Publishing csMicrosoftPublishing }
9678 { Windows-31J csWindows31J }
9683 proc tcl_encoding {enc} {
9684 global encoding_aliases
9685 set names [encoding names]
9686 set lcnames [string tolower $names]
9687 set enc [string tolower $enc]
9688 set i [lsearch -exact $lcnames $enc]
9690 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9691 if {[regsub {^iso[-_]} $enc iso encx]} {
9692 set i [lsearch -exact $lcnames $encx]
9696 foreach l $encoding_aliases {
9697 set ll [string tolower $l]
9698 if {[lsearch -exact $ll $enc] < 0} continue
9699 # look through the aliases for one that tcl knows about
9701 set i [lsearch -exact $lcnames $e]
9703 if {[regsub {^iso[-_]} $e iso ex]} {
9704 set i [lsearch -exact $lcnames $ex]
9713 return [lindex $names $i]
9718 # First check that Tcl/Tk is recent enough
9719 if {[catch {package require Tk 8.4} err]} {
9720 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9721 Gitk requires at least Tcl/Tk 8.4."]
9726 set wrcomcmd "git diff-tree --stdin -p --pretty"
9730 set gitencoding [exec git config --get i18n.commitencoding]
9732 if {$gitencoding == ""} {
9733 set gitencoding "utf-8"
9735 set tclencoding [tcl_encoding $gitencoding]
9736 if {$tclencoding == {}} {
9737 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9740 set mainfont {Helvetica 9}
9741 set textfont {Courier 9}
9742 set uifont {Helvetica 9 bold}
9744 set findmergefiles 0
9752 set cmitmode "patch"
9753 set wrapcomment "none"
9757 set showlocalchanges 1
9759 set datetimeformat "%Y-%m-%d %H:%M:%S"
9762 set extdifftool "meld"
9764 set colors {green red blue magenta darkgrey brown orange}
9767 set diffcolors {red "#00a000" blue}
9770 set selectbgcolor gray85
9772 set circlecolors {white blue gray blue blue}
9774 ## For msgcat loading, first locate the installation location.
9775 if { [info exists ::env(GITK_MSGSDIR)] } {
9776 ## Msgsdir was manually set in the environment.
9777 set gitk_msgsdir $::env(GITK_MSGSDIR)
9779 ## Let's guess the prefix from argv0.
9780 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9781 set gitk_libdir [file join $gitk_prefix share gitk lib]
9782 set gitk_msgsdir [file join $gitk_libdir msgs]
9786 ## Internationalization (i18n) through msgcat and gettext. See
9787 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9788 package require msgcat
9789 namespace import ::msgcat::mc
9790 ## And eventually load the actual message catalog
9791 ::msgcat::mcload $gitk_msgsdir
9793 catch {source ~/.gitk}
9795 font create optionfont -family sans-serif -size -12
9797 parsefont mainfont $mainfont
9798 eval font create mainfont [fontflags mainfont]
9799 eval font create mainfontbold [fontflags mainfont 1]
9801 parsefont textfont $textfont
9802 eval font create textfont [fontflags textfont]
9803 eval font create textfontbold [fontflags textfont 1]
9805 parsefont uifont $uifont
9806 eval font create uifont [fontflags uifont]
9810 # check that we can find a .git directory somewhere...
9811 if {[catch {set gitdir [gitdir]}]} {
9812 show_error {} . [mc "Cannot find a git repository here."]
9815 if {![file isdirectory $gitdir]} {
9816 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9821 set cmdline_files {}
9823 set revtreeargscmd {}
9825 switch -glob -- $arg {
9828 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9832 set revtreeargscmd [string range $arg 10 end]
9835 lappend revtreeargs $arg
9841 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9842 # no -- on command line, but some arguments (other than --argscmd)
9844 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9845 set cmdline_files [split $f "\n"]
9846 set n [llength $cmdline_files]
9847 set revtreeargs [lrange $revtreeargs 0 end-$n]
9848 # Unfortunately git rev-parse doesn't produce an error when
9849 # something is both a revision and a filename. To be consistent
9850 # with git log and git rev-list, check revtreeargs for filenames.
9851 foreach arg $revtreeargs {
9852 if {[file exists $arg]} {
9853 show_error {} . [mc "Ambiguous argument '%s': both revision\
9859 # unfortunately we get both stdout and stderr in $err,
9860 # so look for "fatal:".
9861 set i [string first "fatal:" $err]
9863 set err [string range $err [expr {$i + 6}] end]
9865 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9870 set nullid "0000000000000000000000000000000000000000"
9871 set nullid2 "0000000000000000000000000000000000000001"
9872 set nullfile "/dev/null"
9874 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9881 set highlight_paths {}
9883 set searchdirn -forwards
9887 set markingmatches 0
9888 set linkentercount 0
9889 set need_redisplay 0
9896 set selectedhlview [mc "None"]
9897 set highlight_related [mc "None"]
9898 set highlight_files {}
9902 set viewargscmd(0) {}
9912 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
9915 # wait for the window to become visible
9917 wm title . "[file tail $argv0]: [file tail [pwd]]"
9920 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
9921 # create a view for the files/dirs specified on the command line
9925 set viewname(1) [mc "Command line"]
9926 set viewfiles(1) $cmdline_files
9927 set viewargs(1) $revtreeargs
9928 set viewargscmd(1) $revtreeargscmd
9932 .bar.view entryconf [mc "Edit view..."] -state normal
9933 .bar.view entryconf [mc "Delete view"] -state normal
9936 if {[info exists permviews]} {
9937 foreach v $permviews {
9940 set viewname($n) [lindex $v 0]
9941 set viewfiles($n) [lindex $v 1]
9942 set viewargs($n) [lindex $v 2]
9943 set viewargscmd($n) [lindex $v 3]