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.
25 global isonrunq runq currunq
28 if {[info exists isonrunq
($script)]} return
29 if {$runq eq
{} && ![info exists currunq
]} {
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
{}
44 if {$runq eq
{} && ![info exists currunq
]} {
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]
63 global isonrunq runq currunq
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 currunq
[lindex
$runq 0]
71 set runq
[lrange
$runq 1 end
]
72 set repeat
[eval $script]
74 set t1
[clock clicks
-milliseconds]
75 set t
[expr {$t1 - $t0}]
76 if {$repeat ne
{} && $repeat} {
77 if {$fd eq
{} ||
$repeat == 2} {
78 # script returns 1 if it wants to be readded
79 # file readers return 2 if they could do more straight away
80 lappend runq
[list
$fd $script]
82 fileevent
$fd readable
[list filereadable
$fd $script]
84 } elseif
{$fd eq
{}} {
85 unset isonrunq
($script)
88 if {$t1 - $tstart >= 80} break
95 proc reg_instance
{fd
} {
96 global commfd leftover loginstance
98 set i
[incr loginstance
]
104 proc unmerged_files
{files
} {
107 # find the list of unmerged files
111 set fd
[open
"| git ls-files -u" r
]
113 show_error
{} .
"[mc "Couldn
't get list of unmerged files:"] $err"
116 while {[gets $fd line] >= 0} {
117 set i [string first "\t" $line]
119 set fname [string range $line [expr {$i+1}] end]
120 if {[lsearch -exact $mlist $fname] >= 0} continue
122 if {$files eq {} || [path_filter $files $fname]} {
130 proc parseviewargs {n arglist} {
131 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
139 set origargs $arglist
143 foreach arg $arglist {
150 switch -glob -- $arg {
154 # remove from origargs in case we hit an unknown option
155 set origargs [lreplace $origargs $i $i]
158 # These request or affect diff output, which we don't want.
159 # Some could be used to set our defaults for diff display.
161 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
162 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
163 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
164 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
165 "--ignore-space-change" - "-U*" - "--unified=*" {
166 lappend diffargs
$arg
168 # These cause our parsing of git log's output to fail, or else
169 # they're options we want to set ourselves, so ignore them.
170 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
171 "--name-only" - "--name-status" - "--color" - "--color-words" -
172 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
173 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
174 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
175 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
176 "--objects" - "--objects-edge" - "--reverse" {
178 # These are harmless, and some are even useful
179 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
180 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
181 "--full-history" - "--dense" - "--sparse" -
182 "--follow" - "--left-right" - "--encoding=*" {
185 # These mean that we get a subset of the commits
186 "--diff-filter=*" - "--no-merges" - "--unpacked" -
187 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
188 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
189 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
190 "--remove-empty" - "--first-parent" - "--cherry-pick" -
191 "-S*" - "--pickaxe-all" - "--pickaxe-regex" - {
195 # This appears to be the only one that has a value as a
196 # separate word following it
203 set notflag
[expr {!$notflag}]
211 # git rev-parse doesn't understand --merge
212 lappend revargs
--gitk-symmetric-diff-marker MERGE_HEAD...HEAD
214 # Other flag arguments including -<n>
216 if {[string is digit
-strict [string range
$arg 1 end
]]} {
219 # a flag argument that we don't recognize;
220 # that means we can't optimize
225 # Non-flag arguments specify commits or ranges of commits
227 if {[string match
"*...*" $arg]} {
228 lappend revargs
--gitk-symmetric-diff-marker
234 set vdflags
($n) $diffargs
235 set vflags
($n) $glflags
236 set vrevs
($n) $revargs
237 set vfiltered
($n) $filtered
238 set vorigargs
($n) $origargs
242 proc parseviewrevs
{view revs
} {
243 global vposids vnegids
248 if {[catch
{set ids
[eval exec git rev-parse
$revs]} err
]} {
249 # we get stdout followed by stderr in $err
250 # for an unknown rev, git rev-parse echoes it and then errors out
251 set errlines
[split $err "\n"]
253 for {set l
0} {$l < [llength
$errlines]} {incr l
} {
254 set line
[lindex
$errlines $l]
255 if {!([string length
$line] == 40 && [string is xdigit
$line])} {
256 if {[string match
"fatal:*" $line]} {
257 if {[string match
"fatal: ambiguous argument*" $line]
259 if {[llength
$badrev] == 1} {
260 set err
"unknown revision $badrev"
262 set err
"unknown revisions: [join $badrev ", "]"
265 set err
[join [lrange
$errlines $l end
] "\n"]
272 error_popup
"Error parsing revisions: $err"
279 foreach id
[split $ids "\n"] {
280 if {$id eq
"--gitk-symmetric-diff-marker"} {
282 } elseif
{[string match
"^*" $id]} {
289 lappend neg
[string range
$id 1 end
]
294 lset ret end
[lindex
$ret end
]...
$id
300 set vposids
($view) $pos
301 set vnegids
($view) $neg
305 # Start off a git log process and arrange to read its output
306 proc start_rev_list
{view
} {
307 global startmsecs commitidx viewcomplete curview
309 global viewargs viewargscmd viewfiles vfilelimit
310 global showlocalchanges commitinterest
311 global viewactive viewinstances vmergeonly
313 global vcanopt vflags vrevs vorigargs
315 set startmsecs
[clock clicks
-milliseconds]
316 set commitidx
($view) 0
317 # these are set this way for the error exits
318 set viewcomplete
($view) 1
319 set viewactive
($view) 0
322 set args
$viewargs($view)
323 if {$viewargscmd($view) ne
{}} {
325 set str
[exec sh
-c $viewargscmd($view)]
327 error_popup
"Error executing --argscmd command: $err"
330 set args
[concat
$args [split $str "\n"]]
332 set vcanopt
($view) [parseviewargs
$view $args]
334 set files
$viewfiles($view)
335 if {$vmergeonly($view)} {
336 set files
[unmerged_files
$files]
339 if {$nr_unmerged == 0} {
340 error_popup
[mc
"No files selected: --merge specified but\
341 no files are unmerged."]
343 error_popup
[mc
"No files selected: --merge specified but\
344 no unmerged files are within file limit."]
349 set vfilelimit
($view) $files
351 if {$vcanopt($view)} {
352 set revs
[parseviewrevs
$view $vrevs($view)]
356 set args
[concat
$vflags($view) $revs]
358 set args
$vorigargs($view)
362 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
363 --boundary $args "--" $files] r
]
365 error_popup
"[mc "Error executing git log
:"] $err"
368 set i
[reg_instance
$fd]
369 set viewinstances
($view) [list
$i]
370 if {$showlocalchanges && $mainheadid ne
{}} {
371 lappend commitinterest
($mainheadid) {dodiffindex
}
373 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
374 if {$tclencoding != {}} {
375 fconfigure
$fd -encoding $tclencoding
377 filerun
$fd [list getcommitlines
$fd $i $view 0]
378 nowbusy
$view [mc
"Reading"]
379 set viewcomplete
($view) 0
380 set viewactive
($view) 1
384 proc stop_instance
{inst
} {
385 global commfd leftover
387 set fd
$commfd($inst)
391 if {$
::tcl_platform
(platform
) eq
{windows
}} {
400 unset leftover
($inst)
403 proc stop_backends
{} {
406 foreach inst
[array names commfd
] {
411 proc stop_rev_list
{view
} {
414 foreach inst
$viewinstances($view) {
417 set viewinstances
($view) {}
420 proc reset_pending_select
{selid
} {
421 global pending_select mainheadid selectheadid
424 set pending_select
$selid
425 } elseif
{$selectheadid ne
{}} {
426 set pending_select
$selectheadid
428 set pending_select
$mainheadid
432 proc getcommits
{selid
} {
433 global canv curview need_redisplay viewactive
436 if {[start_rev_list
$curview]} {
437 reset_pending_select
$selid
438 show_status
[mc
"Reading commits..."]
441 show_status
[mc
"No commits selected"]
445 proc updatecommits
{} {
446 global curview vcanopt vorigargs vfilelimit viewinstances
447 global viewactive viewcomplete tclencoding
448 global startmsecs showneartags showlocalchanges
449 global mainheadid pending_select
451 global varcid vposids vnegids vflags vrevs
453 set isworktree
[expr {[exec git rev-parse
--is-inside-work-tree] == "true"}]
454 set oldmainid
$mainheadid
456 if {$showlocalchanges} {
457 if {$mainheadid ne
$oldmainid} {
460 if {[commitinview
$mainheadid $curview]} {
465 if {$vcanopt($view)} {
466 set oldpos
$vposids($view)
467 set oldneg
$vnegids($view)
468 set revs
[parseviewrevs
$view $vrevs($view)]
472 # note: getting the delta when negative refs change is hard,
473 # and could require multiple git log invocations, so in that
474 # case we ask git log for all the commits (not just the delta)
475 if {$oldneg eq
$vnegids($view)} {
478 # take out positive refs that we asked for before or
479 # that we have already seen
481 if {[string length
$rev] == 40} {
482 if {[lsearch
-exact $oldpos $rev] < 0
483 && ![info exists varcid
($view,$rev)]} {
488 lappend
$newrevs $rev
491 if {$npos == 0} return
493 set vposids
($view) [lsort
-unique [concat
$oldpos $vposids($view)]]
495 set args
[concat
$vflags($view) $revs --not $oldpos]
497 set args
$vorigargs($view)
500 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
501 --boundary $args "--" $vfilelimit($view)] r
]
503 error_popup
"Error executing git log: $err"
506 if {$viewactive($view) == 0} {
507 set startmsecs
[clock clicks
-milliseconds]
509 set i
[reg_instance
$fd]
510 lappend viewinstances
($view) $i
511 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
512 if {$tclencoding != {}} {
513 fconfigure
$fd -encoding $tclencoding
515 filerun
$fd [list getcommitlines
$fd $i $view 1]
516 incr viewactive
($view)
517 set viewcomplete
($view) 0
518 reset_pending_select
{}
519 nowbusy
$view "Reading"
525 proc reloadcommits
{} {
526 global curview viewcomplete selectedline currentid thickerline
527 global showneartags treediffs commitinterest cached_commitrow
531 if {$selectedline ne
{}} {
535 if {!$viewcomplete($curview)} {
536 stop_rev_list
$curview
540 catch
{unset currentid
}
541 catch
{unset thickerline
}
542 catch
{unset treediffs
}
549 catch
{unset commitinterest
}
550 catch
{unset cached_commitrow
}
551 catch
{unset targetid
}
557 # This makes a string representation of a positive integer which
558 # sorts as a string in numerical order
561 return [format
"%x" $n]
562 } elseif
{$n < 256} {
563 return [format
"x%.2x" $n]
564 } elseif
{$n < 65536} {
565 return [format
"y%.4x" $n]
567 return [format
"z%.8x" $n]
570 # Procedures used in reordering commits from git log (without
571 # --topo-order) into the order for display.
573 proc varcinit
{view
} {
574 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
575 global vtokmod varcmod vrowmod varcix vlastins
577 set varcstart
($view) {{}}
578 set vupptr
($view) {0}
579 set vdownptr
($view) {0}
580 set vleftptr
($view) {0}
581 set vbackptr
($view) {0}
582 set varctok
($view) {{}}
583 set varcrow
($view) {{}}
584 set vtokmod
($view) {}
587 set varcix
($view) {{}}
588 set vlastins
($view) {0}
591 proc resetvarcs
{view
} {
592 global varcid varccommits parents children vseedcount ordertok
594 foreach vid
[array names varcid
$view,*] {
599 # some commits might have children but haven't been seen yet
600 foreach vid
[array names children
$view,*] {
603 foreach va
[array names varccommits
$view,*] {
604 unset varccommits
($va)
606 foreach vd
[array names vseedcount
$view,*] {
607 unset vseedcount
($vd)
609 catch
{unset ordertok
}
612 # returns a list of the commits with no children
614 global vdownptr vleftptr varcstart
617 set a
[lindex
$vdownptr($v) 0]
619 lappend ret
[lindex
$varcstart($v) $a]
620 set a
[lindex
$vleftptr($v) $a]
625 proc newvarc
{view id
} {
626 global varcid varctok parents children vdatemode
627 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
628 global commitdata commitinfo vseedcount varccommits vlastins
630 set a
[llength
$varctok($view)]
632 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
633 if {![info exists commitinfo
($id)]} {
634 parsecommit
$id $commitdata($id) 1
636 set cdate
[lindex
$commitinfo($id) 4]
637 if {![string is integer
-strict $cdate]} {
640 if {![info exists vseedcount
($view,$cdate)]} {
641 set vseedcount
($view,$cdate) -1
643 set c
[incr vseedcount
($view,$cdate)]
644 set cdate
[expr {$cdate ^
0xffffffff}]
645 set tok
"s[strrep $cdate][strrep $c]"
650 if {[llength
$children($vid)] > 0} {
651 set kid
[lindex
$children($vid) end
]
652 set k
$varcid($view,$kid)
653 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
656 set tok
[lindex
$varctok($view) $k]
660 set i
[lsearch
-exact $parents($view,$ki) $id]
661 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
662 append tok
[strrep
$j]
664 set c
[lindex
$vlastins($view) $ka]
665 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
667 set b
[lindex
$vdownptr($view) $ka]
669 set b
[lindex
$vleftptr($view) $c]
671 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
673 set b
[lindex
$vleftptr($view) $c]
676 lset vdownptr
($view) $ka $a
677 lappend vbackptr
($view) 0
679 lset vleftptr
($view) $c $a
680 lappend vbackptr
($view) $c
682 lset vlastins
($view) $ka $a
683 lappend vupptr
($view) $ka
684 lappend vleftptr
($view) $b
686 lset vbackptr
($view) $b $a
688 lappend varctok
($view) $tok
689 lappend varcstart
($view) $id
690 lappend vdownptr
($view) 0
691 lappend varcrow
($view) {}
692 lappend varcix
($view) {}
693 set varccommits
($view,$a) {}
694 lappend vlastins
($view) 0
698 proc splitvarc
{p v
} {
699 global varcid varcstart varccommits varctok
700 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
702 set oa
$varcid($v,$p)
703 set ac
$varccommits($v,$oa)
704 set i
[lsearch
-exact $varccommits($v,$oa) $p]
706 set na
[llength
$varctok($v)]
707 # "%" sorts before "0"...
708 set tok
"[lindex $varctok($v) $oa]%[strrep $i]"
709 lappend varctok
($v) $tok
710 lappend varcrow
($v) {}
711 lappend varcix
($v) {}
712 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
713 set varccommits
($v,$na) [lrange
$ac $i end
]
714 lappend varcstart
($v) $p
715 foreach id
$varccommits($v,$na) {
716 set varcid
($v,$id) $na
718 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
719 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
720 lset vdownptr
($v) $oa $na
721 lset vlastins
($v) $oa 0
722 lappend vupptr
($v) $oa
723 lappend vleftptr
($v) 0
724 lappend vbackptr
($v) 0
725 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
726 lset vupptr
($v) $b $na
730 proc renumbervarc
{a v
} {
731 global parents children varctok varcstart varccommits
732 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
734 set t1
[clock clicks
-milliseconds]
740 if {[info exists isrelated
($a)]} {
742 set id
[lindex
$varccommits($v,$a) end
]
743 foreach p
$parents($v,$id) {
744 if {[info exists varcid
($v,$p)]} {
745 set isrelated
($varcid($v,$p)) 1
750 set b
[lindex
$vdownptr($v) $a]
753 set b
[lindex
$vleftptr($v) $a]
755 set a
[lindex
$vupptr($v) $a]
761 if {![info exists kidchanged
($a)]} continue
762 set id
[lindex
$varcstart($v) $a]
763 if {[llength
$children($v,$id)] > 1} {
764 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
767 set oldtok
[lindex
$varctok($v) $a]
768 if {!$vdatemode($v)} {
774 set kid
[last_real_child
$v,$id]
776 set k
$varcid($v,$kid)
777 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
780 set tok
[lindex
$varctok($v) $k]
784 set i
[lsearch
-exact $parents($v,$ki) $id]
785 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
786 append tok
[strrep
$j]
788 if {$tok eq
$oldtok} {
791 set id
[lindex
$varccommits($v,$a) end
]
792 foreach p
$parents($v,$id) {
793 if {[info exists varcid
($v,$p)]} {
794 set kidchanged
($varcid($v,$p)) 1
799 lset varctok
($v) $a $tok
800 set b
[lindex
$vupptr($v) $a]
802 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
805 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
808 set c
[lindex
$vbackptr($v) $a]
809 set d
[lindex
$vleftptr($v) $a]
811 lset vdownptr
($v) $b $d
813 lset vleftptr
($v) $c $d
816 lset vbackptr
($v) $d $c
818 if {[lindex
$vlastins($v) $b] == $a} {
819 lset vlastins
($v) $b $c
821 lset vupptr
($v) $a $ka
822 set c
[lindex
$vlastins($v) $ka]
824 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
826 set b
[lindex
$vdownptr($v) $ka]
828 set b
[lindex
$vleftptr($v) $c]
831 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
833 set b
[lindex
$vleftptr($v) $c]
836 lset vdownptr
($v) $ka $a
837 lset vbackptr
($v) $a 0
839 lset vleftptr
($v) $c $a
840 lset vbackptr
($v) $a $c
842 lset vleftptr
($v) $a $b
844 lset vbackptr
($v) $b $a
846 lset vlastins
($v) $ka $a
849 foreach id
[array names sortkids
] {
850 if {[llength
$children($v,$id)] > 1} {
851 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
855 set t2
[clock clicks
-milliseconds]
856 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
859 # Fix up the graph after we have found out that in view $v,
860 # $p (a commit that we have already seen) is actually the parent
861 # of the last commit in arc $a.
862 proc fix_reversal
{p a v
} {
863 global varcid varcstart varctok vupptr
865 set pa
$varcid($v,$p)
866 if {$p ne
[lindex
$varcstart($v) $pa]} {
868 set pa
$varcid($v,$p)
870 # seeds always need to be renumbered
871 if {[lindex
$vupptr($v) $pa] == 0 ||
872 [string compare
[lindex
$varctok($v) $a] \
873 [lindex
$varctok($v) $pa]] > 0} {
878 proc insertrow
{id p v
} {
879 global cmitlisted children parents varcid varctok vtokmod
880 global varccommits ordertok commitidx numcommits curview
881 global targetid targetrow
885 set cmitlisted
($vid) 1
886 set children
($vid) {}
887 set parents
($vid) [list
$p]
888 set a
[newvarc
$v $id]
890 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
893 lappend varccommits
($v,$a) $id
895 if {[llength
[lappend children
($vp) $id]] > 1} {
896 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
897 catch
{unset ordertok
}
899 fix_reversal
$p $a $v
901 if {$v == $curview} {
902 set numcommits
$commitidx($v)
904 if {[info exists targetid
]} {
905 if {![comes_before
$targetid $p]} {
912 proc insertfakerow
{id p
} {
913 global varcid varccommits parents children cmitlisted
914 global commitidx varctok vtokmod targetid targetrow curview numcommits
918 set i
[lsearch
-exact $varccommits($v,$a) $p]
920 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
923 set children
($v,$id) {}
924 set parents
($v,$id) [list
$p]
925 set varcid
($v,$id) $a
926 lappend children
($v,$p) $id
927 set cmitlisted
($v,$id) 1
928 set numcommits
[incr commitidx
($v)]
929 # note we deliberately don't update varcstart($v) even if $i == 0
930 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
932 if {[info exists targetid
]} {
933 if {![comes_before
$targetid $p]} {
941 proc removefakerow
{id
} {
942 global varcid varccommits parents children commitidx
943 global varctok vtokmod cmitlisted currentid selectedline
944 global targetid curview numcommits
947 if {[llength
$parents($v,$id)] != 1} {
948 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
951 set p
[lindex
$parents($v,$id) 0]
952 set a
$varcid($v,$id)
953 set i
[lsearch
-exact $varccommits($v,$a) $id]
955 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
959 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
960 unset parents
($v,$id)
961 unset children
($v,$id)
962 unset cmitlisted
($v,$id)
963 set numcommits
[incr commitidx
($v) -1]
964 set j
[lsearch
-exact $children($v,$p) $id]
966 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
969 if {[info exist currentid
] && $id eq
$currentid} {
973 if {[info exists targetid
] && $targetid eq
$id} {
980 proc first_real_child
{vp
} {
981 global children nullid nullid2
983 foreach id
$children($vp) {
984 if {$id ne
$nullid && $id ne
$nullid2} {
991 proc last_real_child
{vp
} {
992 global children nullid nullid2
994 set kids
$children($vp)
995 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
996 set id
[lindex
$kids $i]
997 if {$id ne
$nullid && $id ne
$nullid2} {
1004 proc vtokcmp
{v a b
} {
1005 global varctok varcid
1007 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1008 [lindex
$varctok($v) $varcid($v,$b)]]
1011 # This assumes that if lim is not given, the caller has checked that
1012 # arc a's token is less than $vtokmod($v)
1013 proc modify_arc
{v a
{lim
{}}} {
1014 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1017 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
1020 set r
[lindex
$varcrow($v) $a]
1021 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
1024 set vtokmod
($v) [lindex
$varctok($v) $a]
1026 if {$v == $curview} {
1027 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
1028 set a
[lindex
$vupptr($v) $a]
1034 set lim
[llength
$varccommits($v,$a)]
1036 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
1043 proc update_arcrows
{v
} {
1044 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1045 global varcid vrownum varcorder varcix varccommits
1046 global vupptr vdownptr vleftptr varctok
1047 global displayorder parentlist curview cached_commitrow
1049 if {$vrowmod($v) == $commitidx($v)} return
1050 if {$v == $curview} {
1051 if {[llength
$displayorder] > $vrowmod($v)} {
1052 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
1053 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
1055 catch
{unset cached_commitrow
}
1057 set narctot
[expr {[llength
$varctok($v)] - 1}]
1059 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
1060 # go up the tree until we find something that has a row number,
1061 # or we get to a seed
1062 set a
[lindex
$vupptr($v) $a]
1065 set a
[lindex
$vdownptr($v) 0]
1068 set varcorder
($v) [list
$a]
1069 lset varcix
($v) $a 0
1070 lset varcrow
($v) $a 0
1074 set arcn
[lindex
$varcix($v) $a]
1075 if {[llength
$vrownum($v)] > $arcn + 1} {
1076 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
1077 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
1079 set row
[lindex
$varcrow($v) $a]
1083 incr row
[llength
$varccommits($v,$a)]
1084 # go down if possible
1085 set b
[lindex
$vdownptr($v) $a]
1087 # if not, go left, or go up until we can go left
1089 set b
[lindex
$vleftptr($v) $a]
1091 set a
[lindex
$vupptr($v) $a]
1097 lappend vrownum
($v) $row
1098 lappend varcorder
($v) $a
1099 lset varcix
($v) $a $arcn
1100 lset varcrow
($v) $a $row
1102 set vtokmod
($v) [lindex
$varctok($v) $p]
1104 set vrowmod
($v) $row
1105 if {[info exists currentid
]} {
1106 set selectedline
[rowofcommit
$currentid]
1110 # Test whether view $v contains commit $id
1111 proc commitinview
{id v
} {
1114 return [info exists varcid
($v,$id)]
1117 # Return the row number for commit $id in the current view
1118 proc rowofcommit
{id
} {
1119 global varcid varccommits varcrow curview cached_commitrow
1120 global varctok vtokmod
1123 if {![info exists varcid
($v,$id)]} {
1124 puts
"oops rowofcommit no arc for [shortids $id]"
1127 set a
$varcid($v,$id)
1128 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
1131 if {[info exists cached_commitrow
($id)]} {
1132 return $cached_commitrow($id)
1134 set i
[lsearch
-exact $varccommits($v,$a) $id]
1136 puts
"oops didn't find commit [shortids $id] in arc $a"
1139 incr i
[lindex
$varcrow($v) $a]
1140 set cached_commitrow
($id) $i
1144 # Returns 1 if a is on an earlier row than b, otherwise 0
1145 proc comes_before
{a b
} {
1146 global varcid varctok curview
1149 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
1150 ![info exists varcid
($v,$b)]} {
1153 if {$varcid($v,$a) != $varcid($v,$b)} {
1154 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1155 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
1157 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
1160 proc bsearch
{l elt
} {
1161 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
1166 while {$hi - $lo > 1} {
1167 set mid
[expr {int
(($lo + $hi) / 2)}]
1168 set t
[lindex
$l $mid]
1171 } elseif
{$elt > $t} {
1180 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1181 proc make_disporder
{start end
} {
1182 global vrownum curview commitidx displayorder parentlist
1183 global varccommits varcorder parents vrowmod varcrow
1184 global d_valid_start d_valid_end
1186 if {$end > $vrowmod($curview)} {
1187 update_arcrows
$curview
1189 set ai
[bsearch
$vrownum($curview) $start]
1190 set start
[lindex
$vrownum($curview) $ai]
1191 set narc
[llength
$vrownum($curview)]
1192 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
1193 set a
[lindex
$varcorder($curview) $ai]
1194 set l
[llength
$displayorder]
1195 set al
[llength
$varccommits($curview,$a)]
1196 if {$l < $r + $al} {
1198 set pad
[ntimes
[expr {$r - $l}] {}]
1199 set displayorder
[concat
$displayorder $pad]
1200 set parentlist
[concat
$parentlist $pad]
1201 } elseif
{$l > $r} {
1202 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
1203 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
1205 foreach id
$varccommits($curview,$a) {
1206 lappend displayorder
$id
1207 lappend parentlist
$parents($curview,$id)
1209 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
1211 foreach id
$varccommits($curview,$a) {
1212 lset displayorder
$i $id
1213 lset parentlist
$i $parents($curview,$id)
1221 proc commitonrow
{row
} {
1224 set id
[lindex
$displayorder $row]
1226 make_disporder
$row [expr {$row + 1}]
1227 set id
[lindex
$displayorder $row]
1232 proc closevarcs
{v
} {
1233 global varctok varccommits varcid parents children
1234 global cmitlisted commitidx commitinterest vtokmod
1236 set missing_parents
0
1238 set narcs
[llength
$varctok($v)]
1239 for {set a
1} {$a < $narcs} {incr a
} {
1240 set id
[lindex
$varccommits($v,$a) end
]
1241 foreach p
$parents($v,$id) {
1242 if {[info exists varcid
($v,$p)]} continue
1243 # add p as a new commit
1244 incr missing_parents
1245 set cmitlisted
($v,$p) 0
1246 set parents
($v,$p) {}
1247 if {[llength
$children($v,$p)] == 1 &&
1248 [llength
$parents($v,$id)] == 1} {
1251 set b
[newvarc
$v $p]
1253 set varcid
($v,$p) $b
1254 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1257 lappend varccommits
($v,$b) $p
1259 if {[info exists commitinterest
($p)]} {
1260 foreach
script $commitinterest($p) {
1261 lappend scripts
[string map
[list
"%I" $p] $script]
1263 unset commitinterest
($id)
1267 if {$missing_parents > 0} {
1268 foreach s
$scripts {
1274 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1275 # Assumes we already have an arc for $rwid.
1276 proc rewrite_commit
{v id rwid
} {
1277 global children parents varcid varctok vtokmod varccommits
1279 foreach ch
$children($v,$id) {
1280 # make $rwid be $ch's parent in place of $id
1281 set i
[lsearch
-exact $parents($v,$ch) $id]
1283 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1285 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1286 # add $ch to $rwid's children and sort the list if necessary
1287 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1288 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1289 $children($v,$rwid)]
1291 # fix the graph after joining $id to $rwid
1292 set a
$varcid($v,$ch)
1293 fix_reversal
$rwid $a $v
1294 # parentlist is wrong for the last element of arc $a
1295 # even if displayorder is right, hence the 3rd arg here
1296 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1300 proc getcommitlines
{fd inst view updating
} {
1301 global cmitlisted commitinterest leftover
1302 global commitidx commitdata vdatemode
1303 global parents children curview hlview
1304 global idpending ordertok
1305 global varccommits varcid varctok vtokmod vfilelimit
1307 set stuff
[read $fd 500000]
1308 # git log doesn't terminate the last commit with a null...
1309 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1316 global commfd viewcomplete viewactive viewname
1317 global viewinstances
1319 set i
[lsearch
-exact $viewinstances($view) $inst]
1321 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1323 # set it blocking so we wait for the process to terminate
1324 fconfigure
$fd -blocking 1
1325 if {[catch
{close
$fd} err
]} {
1327 if {$view != $curview} {
1328 set fv
" for the \"$viewname($view)\" view"
1330 if {[string range
$err 0 4] == "usage"} {
1331 set err
"Gitk: error reading commits$fv:\
1332 bad arguments to git log."
1333 if {$viewname($view) eq
"Command line"} {
1335 " (Note: arguments to gitk are passed to git log\
1336 to allow selection of commits to be displayed.)"
1339 set err
"Error reading commits$fv: $err"
1343 if {[incr viewactive
($view) -1] <= 0} {
1344 set viewcomplete
($view) 1
1345 # Check if we have seen any ids listed as parents that haven't
1346 # appeared in the list
1350 if {$view == $curview} {
1359 set i
[string first
"\0" $stuff $start]
1361 append leftover
($inst) [string range
$stuff $start end
]
1365 set cmit
$leftover($inst)
1366 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1367 set leftover
($inst) {}
1369 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1371 set start
[expr {$i + 1}]
1372 set j
[string first
"\n" $cmit]
1375 if {$j >= 0 && [string match
"commit *" $cmit]} {
1376 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1377 if {[string match
{[-^
<>]*} $ids]} {
1378 switch
-- [string index
$ids 0] {
1384 set ids
[string range
$ids 1 end
]
1388 if {[string length
$id] != 40} {
1396 if {[string length
$shortcmit] > 80} {
1397 set shortcmit
"[string range $shortcmit 0 80]..."
1399 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1402 set id [lindex $ids 0]
1405 if {!$listed && $updating && ![info exists varcid($vid)] &&
1406 $vfilelimit($view) ne {}} {
1407 # git log doesn't rewrite parents
for unlisted commits
1408 # when doing path limiting, so work around that here
1409 # by working out the rewritten parent with git rev-list
1410 # and if we already know about it, using the rewritten
1411 # parent as a substitute parent for $id's children.
1413 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1414 $id -- $vfilelimit($view)]
1416 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1417 # use $rwid in place of $id
1418 rewrite_commit
$view $id $rwid
1425 if {[info exists varcid
($vid)]} {
1426 if {$cmitlisted($vid) ||
!$listed} continue
1430 set olds
[lrange
$ids 1 end
]
1434 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1435 set cmitlisted
($vid) $listed
1436 set parents
($vid) $olds
1437 if {![info exists children
($vid)]} {
1438 set children
($vid) {}
1439 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1440 set k
[lindex
$children($vid) 0]
1441 if {[llength
$parents($view,$k)] == 1 &&
1442 (!$vdatemode($view) ||
1443 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1444 set a
$varcid($view,$k)
1449 set a
[newvarc
$view $id]
1451 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1454 if {![info exists varcid
($vid)]} {
1456 lappend varccommits
($view,$a) $id
1457 incr commitidx
($view)
1462 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1464 if {[llength
[lappend children
($vp) $id]] > 1 &&
1465 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1466 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1468 catch
{unset ordertok
}
1470 if {[info exists varcid
($view,$p)]} {
1471 fix_reversal
$p $a $view
1477 if {[info exists commitinterest
($id)]} {
1478 foreach
script $commitinterest($id) {
1479 lappend scripts
[string map
[list
"%I" $id] $script]
1481 unset commitinterest
($id)
1486 global numcommits hlview
1488 if {$view == $curview} {
1489 set numcommits
$commitidx($view)
1492 if {[info exists hlview
] && $view == $hlview} {
1493 # we never actually get here...
1496 foreach s
$scripts {
1503 proc chewcommits
{} {
1504 global curview hlview viewcomplete
1505 global pending_select
1508 if {$viewcomplete($curview)} {
1509 global commitidx varctok
1510 global numcommits startmsecs
1512 if {[info exists pending_select
]} {
1514 reset_pending_select
{}
1516 if {[commitinview
$pending_select $curview]} {
1517 selectline
[rowofcommit
$pending_select] 1
1519 set row
[first_real_row
]
1523 if {$commitidx($curview) > 0} {
1524 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1525 #puts "overall $ms ms for $numcommits commits"
1526 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1528 show_status
[mc
"No commits selected"]
1535 proc readcommit
{id
} {
1536 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
1537 parsecommit
$id $contents 0
1540 proc parsecommit
{id contents listed
} {
1541 global commitinfo cdate
1550 set hdrend
[string first
"\n\n" $contents]
1552 # should never happen...
1553 set hdrend
[string length
$contents]
1555 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1556 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1557 foreach line
[split $header "\n"] {
1558 set tag
[lindex
$line 0]
1559 if {$tag == "author"} {
1560 set audate
[lindex
$line end-1
]
1561 set auname
[lrange
$line 1 end-2
]
1562 } elseif
{$tag == "committer"} {
1563 set comdate
[lindex
$line end-1
]
1564 set comname
[lrange
$line 1 end-2
]
1568 # take the first non-blank line of the comment as the headline
1569 set headline
[string trimleft
$comment]
1570 set i
[string first
"\n" $headline]
1572 set headline
[string range
$headline 0 $i]
1574 set headline
[string trimright
$headline]
1575 set i
[string first
"\r" $headline]
1577 set headline
[string trimright
[string range
$headline 0 $i]]
1580 # git log indents the comment by 4 spaces;
1581 # if we got this via git cat-file, add the indentation
1583 foreach line
[split $comment "\n"] {
1584 append newcomment
" "
1585 append newcomment
$line
1586 append newcomment
"\n"
1588 set comment
$newcomment
1590 if {$comdate != {}} {
1591 set cdate
($id) $comdate
1593 set commitinfo
($id) [list
$headline $auname $audate \
1594 $comname $comdate $comment]
1597 proc getcommit
{id
} {
1598 global commitdata commitinfo
1600 if {[info exists commitdata
($id)]} {
1601 parsecommit
$id $commitdata($id) 1
1604 if {![info exists commitinfo
($id)]} {
1605 set commitinfo
($id) [list
[mc
"No commit information available"]]
1612 global tagids idtags headids idheads tagobjid
1613 global otherrefids idotherrefs mainhead mainheadid
1614 global selecthead selectheadid
1616 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1619 set refd
[open
[list | git show-ref
-d] r
]
1620 while {[gets
$refd line
] >= 0} {
1621 if {[string index
$line 40] ne
" "} continue
1622 set id
[string range
$line 0 39]
1623 set ref
[string range
$line 41 end
]
1624 if {![string match
"refs/*" $ref]} continue
1625 set name
[string range
$ref 5 end
]
1626 if {[string match
"remotes/*" $name]} {
1627 if {![string match
"*/HEAD" $name]} {
1628 set headids
($name) $id
1629 lappend idheads
($id) $name
1631 } elseif
{[string match
"heads/*" $name]} {
1632 set name
[string range
$name 6 end
]
1633 set headids
($name) $id
1634 lappend idheads
($id) $name
1635 } elseif
{[string match
"tags/*" $name]} {
1636 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1637 # which is what we want since the former is the commit ID
1638 set name
[string range
$name 5 end
]
1639 if {[string match
"*^{}" $name]} {
1640 set name
[string range
$name 0 end-3
]
1642 set tagobjid
($name) $id
1644 set tagids
($name) $id
1645 lappend idtags
($id) $name
1647 set otherrefids
($name) $id
1648 lappend idotherrefs
($id) $name
1655 set mainheadid
[exec git rev-parse HEAD
]
1656 set thehead
[exec git symbolic-ref HEAD
]
1657 if {[string match
"refs/heads/*" $thehead]} {
1658 set mainhead
[string range
$thehead 11 end
]
1662 if {$selecthead ne
{}} {
1664 set selectheadid
[exec git rev-parse
--verify $selecthead]
1669 # skip over fake commits
1670 proc first_real_row
{} {
1671 global nullid nullid2 numcommits
1673 for {set row
0} {$row < $numcommits} {incr row
} {
1674 set id
[commitonrow
$row]
1675 if {$id ne
$nullid && $id ne
$nullid2} {
1682 # update things for a head moved to a child of its previous location
1683 proc movehead
{id name
} {
1684 global headids idheads
1686 removehead
$headids($name) $name
1687 set headids
($name) $id
1688 lappend idheads
($id) $name
1691 # update things when a head has been removed
1692 proc removehead
{id name
} {
1693 global headids idheads
1695 if {$idheads($id) eq
$name} {
1698 set i
[lsearch
-exact $idheads($id) $name]
1700 set idheads
($id) [lreplace
$idheads($id) $i $i]
1703 unset headids
($name)
1706 proc show_error
{w top msg
} {
1707 message
$w.m
-text $msg -justify center
-aspect 400
1708 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1709 button
$w.ok
-text [mc OK
] -command "destroy $top"
1710 pack
$w.ok
-side bottom
-fill x
1711 bind $top <Visibility
> "grab $top; focus $top"
1712 bind $top <Key-Return
> "destroy $top"
1716 proc error_popup msg
{
1720 show_error
$w $w $msg
1723 proc confirm_popup msg
{
1729 message
$w.m
-text $msg -justify center
-aspect 400
1730 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1731 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1732 pack
$w.ok
-side left
-fill x
1733 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1734 pack
$w.cancel
-side right
-fill x
1735 bind $w <Visibility
> "grab $w; focus $w"
1740 proc setoptions
{} {
1741 option add
*Panedwindow.showHandle
1 startupFile
1742 option add
*Panedwindow.sashRelief raised startupFile
1743 option add
*Button.font uifont startupFile
1744 option add
*Checkbutton.font uifont startupFile
1745 option add
*Radiobutton.font uifont startupFile
1746 option add
*Menu.font uifont startupFile
1747 option add
*Menubutton.font uifont startupFile
1748 option add
*Label.font uifont startupFile
1749 option add
*Message.font uifont startupFile
1750 option add
*Entry.font uifont startupFile
1753 proc makewindow
{} {
1754 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1756 global findtype findtypemenu findloc findstring fstring geometry
1757 global entries sha1entry sha1string sha1but
1758 global diffcontextstring diffcontext
1760 global maincursor textcursor curtextcursor
1761 global rowctxmenu fakerowmenu mergemax wrapcomment
1762 global highlight_files gdttype
1763 global searchstring sstring
1764 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1765 global headctxmenu progresscanv progressitem progresscoords statusw
1766 global fprogitem fprogcoord lastprogupdate progupdatepending
1767 global rprogitem rprogcoord rownumsel numcommits
1771 .bar add cascade
-label [mc
"File"] -menu .bar.
file
1773 .bar.
file add
command -label [mc
"Update"] -command updatecommits
1774 .bar.
file add
command -label [mc
"Reload"] -command reloadcommits
1775 .bar.
file add
command -label [mc
"Reread references"] -command rereadrefs
1776 .bar.
file add
command -label [mc
"List references"] -command showrefs
1777 .bar.
file add
command -label [mc
"Quit"] -command doquit
1779 .bar add cascade
-label [mc
"Edit"] -menu .bar.edit
1780 .bar.edit add
command -label [mc
"Preferences"] -command doprefs
1783 .bar add cascade
-label [mc
"View"] -menu .bar.view
1784 .bar.view add
command -label [mc
"New view..."] -command {newview
0}
1785 .bar.view add
command -label [mc
"Edit view..."] -command editview \
1787 .bar.view add
command -label [mc
"Delete view"] -command delview
-state disabled
1788 .bar.view add separator
1789 .bar.view add radiobutton
-label [mc
"All files"] -command {showview
0} \
1790 -variable selectedview
-value 0
1793 .bar add cascade
-label [mc
"Help"] -menu .bar.
help
1794 .bar.
help add
command -label [mc
"About gitk"] -command about
1795 .bar.
help add
command -label [mc
"Key bindings"] -command keys
1797 . configure
-menu .bar
1799 # the gui has upper and lower half, parts of a paned window.
1800 panedwindow .ctop
-orient vertical
1802 # possibly use assumed geometry
1803 if {![info exists geometry
(pwsash0
)]} {
1804 set geometry
(topheight
) [expr {15 * $linespc}]
1805 set geometry
(topwidth
) [expr {80 * $charspc}]
1806 set geometry
(botheight
) [expr {15 * $linespc}]
1807 set geometry
(botwidth
) [expr {50 * $charspc}]
1808 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1809 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1812 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1813 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1815 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1817 # create three canvases
1818 set cscroll .tf.histframe.csb
1819 set canv .tf.histframe.pwclist.canv
1821 -selectbackground $selectbgcolor \
1822 -background $bgcolor -bd 0 \
1823 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1824 .tf.histframe.pwclist add
$canv
1825 set canv2 .tf.histframe.pwclist.canv2
1827 -selectbackground $selectbgcolor \
1828 -background $bgcolor -bd 0 -yscrollincr $linespc
1829 .tf.histframe.pwclist add
$canv2
1830 set canv3 .tf.histframe.pwclist.canv3
1832 -selectbackground $selectbgcolor \
1833 -background $bgcolor -bd 0 -yscrollincr $linespc
1834 .tf.histframe.pwclist add
$canv3
1835 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
1836 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
1838 # a scroll bar to rule them
1839 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
1840 pack
$cscroll -side right
-fill y
1841 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
1842 lappend bglist
$canv $canv2 $canv3
1843 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
1845 # we have two button bars at bottom of top frame. Bar 1
1847 frame .tf.lbar
-height 15
1849 set sha1entry .tf.bar.sha1
1850 set entries
$sha1entry
1851 set sha1but .tf.bar.sha1label
1852 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
1853 -command gotocommit
-width 8
1854 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
1855 pack .tf.bar.sha1label
-side left
1856 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
1857 trace add variable sha1string
write sha1change
1858 pack
$sha1entry -side left
-pady 2
1860 image create bitmap bm-left
-data {
1861 #define left_width 16
1862 #define left_height 16
1863 static unsigned char left_bits
[] = {
1864 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1865 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1866 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1868 image create bitmap bm-right
-data {
1869 #define right_width 16
1870 #define right_height 16
1871 static unsigned char right_bits
[] = {
1872 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1873 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1874 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1876 button .tf.bar.leftbut
-image bm-left
-command goback \
1877 -state disabled
-width 26
1878 pack .tf.bar.leftbut
-side left
-fill y
1879 button .tf.bar.rightbut
-image bm-right
-command goforw \
1880 -state disabled
-width 26
1881 pack .tf.bar.rightbut
-side left
-fill y
1883 label .tf.bar.rowlabel
-text [mc
"Row"]
1885 label .tf.bar.rownum
-width 7 -font textfont
-textvariable rownumsel \
1886 -relief sunken
-anchor e
1887 label .tf.bar.rowlabel2
-text "/"
1888 label .tf.bar.numcommits
-width 7 -font textfont
-textvariable numcommits \
1889 -relief sunken
-anchor e
1890 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
1893 trace add variable selectedline
write selectedline_change
1895 # Status label and progress bar
1896 set statusw .tf.bar.status
1897 label
$statusw -width 15 -relief sunken
1898 pack
$statusw -side left
-padx 5
1899 set h
[expr {[font metrics uifont
-linespace] + 2}]
1900 set progresscanv .tf.bar.progress
1901 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
1902 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
1903 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
1904 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
1905 pack
$progresscanv -side right
-expand 1 -fill x
1906 set progresscoords
{0 0}
1909 bind $progresscanv <Configure
> adjustprogress
1910 set lastprogupdate
[clock clicks
-milliseconds]
1911 set progupdatepending
0
1913 # build up the bottom bar of upper window
1914 label .tf.lbar.flabel
-text "[mc "Find
"] "
1915 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
1916 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
1917 label .tf.lbar.flab2
-text " [mc "commit
"] "
1918 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1920 set gdttype
[mc
"containing:"]
1921 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
1922 [mc
"containing:"] \
1923 [mc
"touching paths:"] \
1924 [mc
"adding/removing string:"]]
1925 trace add variable gdttype
write gdttype_change
1926 pack .tf.lbar.gdttype
-side left
-fill y
1929 set fstring .tf.lbar.findstring
1930 lappend entries
$fstring
1931 entry
$fstring -width 30 -font textfont
-textvariable findstring
1932 trace add variable findstring
write find_change
1933 set findtype
[mc
"Exact"]
1934 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
1935 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
1936 trace add variable findtype
write findcom_change
1937 set findloc
[mc
"All fields"]
1938 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
1939 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
1940 trace add variable findloc
write find_change
1941 pack .tf.lbar.findloc
-side right
1942 pack .tf.lbar.findtype
-side right
1943 pack
$fstring -side left
-expand 1 -fill x
1945 # Finish putting the upper half of the viewer together
1946 pack .tf.lbar
-in .tf
-side bottom
-fill x
1947 pack .tf.bar
-in .tf
-side bottom
-fill x
1948 pack .tf.histframe
-fill both
-side top
-expand 1
1950 .ctop paneconfigure .tf
-height $geometry(topheight
)
1951 .ctop paneconfigure .tf
-width $geometry(topwidth
)
1953 # now build up the bottom
1954 panedwindow .pwbottom
-orient horizontal
1956 # lower left, a text box over search bar, scroll bar to the right
1957 # if we know window height, then that will set the lower text height, otherwise
1958 # we set lower text height which will drive window height
1959 if {[info exists geometry
(main
)]} {
1960 frame .bleft
-width $geometry(botwidth
)
1962 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
1968 button .bleft.top.search
-text [mc
"Search"] -command dosearch
1969 pack .bleft.top.search
-side left
-padx 5
1970 set sstring .bleft.top.sstring
1971 entry
$sstring -width 20 -font textfont
-textvariable searchstring
1972 lappend entries
$sstring
1973 trace add variable searchstring
write incrsearch
1974 pack
$sstring -side left
-expand 1 -fill x
1975 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
1976 -command changediffdisp
-variable diffelide
-value {0 0}
1977 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
1978 -command changediffdisp
-variable diffelide
-value {0 1}
1979 radiobutton .bleft.mid.new
-text [mc
"New version"] \
1980 -command changediffdisp
-variable diffelide
-value {1 0}
1981 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
1982 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
1983 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
1984 -from 1 -increment 1 -to 10000000 \
1985 -validate all
-validatecommand "diffcontextvalidate %P" \
1986 -textvariable diffcontextstring
1987 .bleft.mid.diffcontext
set $diffcontext
1988 trace add variable diffcontextstring
write diffcontextchange
1989 lappend entries .bleft.mid.diffcontext
1990 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
1991 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
1992 -command changeignorespace
-variable ignorespace
1993 pack .bleft.mid.ignspace
-side left
-padx 5
1994 set ctext .bleft.bottom.ctext
1995 text
$ctext -background $bgcolor -foreground $fgcolor \
1996 -state disabled
-font textfont \
1997 -yscrollcommand scrolltext
-wrap none \
1998 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2000 $ctext conf
-tabstyle wordprocessor
2002 scrollbar .bleft.bottom.sb
-command "$ctext yview"
2003 scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h \
2005 pack .bleft.top
-side top
-fill x
2006 pack .bleft.mid
-side top
-fill x
2007 grid
$ctext .bleft.bottom.sb
-sticky nsew
2008 grid .bleft.bottom.sbhorizontal
-sticky ew
2009 grid columnconfigure .bleft.bottom
0 -weight 1
2010 grid rowconfigure .bleft.bottom
0 -weight 1
2011 grid rowconfigure .bleft.bottom
1 -weight 0
2012 pack .bleft.bottom
-side top
-fill both
-expand 1
2013 lappend bglist
$ctext
2014 lappend fglist
$ctext
2016 $ctext tag conf comment
-wrap $wrapcomment
2017 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
2018 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
2019 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
2020 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
2021 $ctext tag conf m0
-fore red
2022 $ctext tag conf m1
-fore blue
2023 $ctext tag conf m2
-fore green
2024 $ctext tag conf m3
-fore purple
2025 $ctext tag conf
m4 -fore brown
2026 $ctext tag conf m5
-fore "#009090"
2027 $ctext tag conf m6
-fore magenta
2028 $ctext tag conf m7
-fore "#808000"
2029 $ctext tag conf m8
-fore "#009000"
2030 $ctext tag conf m9
-fore "#ff0080"
2031 $ctext tag conf m10
-fore cyan
2032 $ctext tag conf m11
-fore "#b07070"
2033 $ctext tag conf m12
-fore "#70b0f0"
2034 $ctext tag conf m13
-fore "#70f0b0"
2035 $ctext tag conf m14
-fore "#f0b070"
2036 $ctext tag conf m15
-fore "#ff70b0"
2037 $ctext tag conf mmax
-fore darkgrey
2039 $ctext tag conf mresult
-font textfontbold
2040 $ctext tag conf msep
-font textfontbold
2041 $ctext tag conf found
-back yellow
2043 .pwbottom add .bleft
2044 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
2049 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
2050 -command reselectline
-variable cmitmode
-value "patch"
2051 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
2052 -command reselectline
-variable cmitmode
-value "tree"
2053 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
2054 pack .bright.mode
-side top
-fill x
2055 set cflist .bright.cfiles
2056 set indent
[font measure mainfont
"nn"]
2058 -selectbackground $selectbgcolor \
2059 -background $bgcolor -foreground $fgcolor \
2061 -tabs [list
$indent [expr {2 * $indent}]] \
2062 -yscrollcommand ".bright.sb set" \
2063 -cursor [. cget
-cursor] \
2064 -spacing1 1 -spacing3 1
2065 lappend bglist
$cflist
2066 lappend fglist
$cflist
2067 scrollbar .bright.sb
-command "$cflist yview"
2068 pack .bright.sb
-side right
-fill y
2069 pack
$cflist -side left
-fill both
-expand 1
2070 $cflist tag configure highlight \
2071 -background [$cflist cget
-selectbackground]
2072 $cflist tag configure bold
-font mainfontbold
2074 .pwbottom add .bright
2077 # restore window width & height if known
2078 if {[info exists geometry
(main
)]} {
2079 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
2080 if {$w > [winfo screenwidth .
]} {
2081 set w
[winfo screenwidth .
]
2083 if {$h > [winfo screenheight .
]} {
2084 set h
[winfo screenheight .
]
2086 wm geometry .
"${w}x$h"
2090 if {[tk windowingsystem
] eq
{aqua
}} {
2096 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2097 pack .ctop
-fill both
-expand 1
2098 bindall
<1> {selcanvline
%W
%x
%y
}
2099 #bindall <B1-Motion> {selcanvline %W %x %y}
2100 if {[tk windowingsystem
] == "win32"} {
2101 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2102 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2104 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2105 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2106 if {[tk windowingsystem
] eq
"aqua"} {
2107 bindall
<MouseWheel
> {
2108 set delta
[expr {- (%D
)}]
2109 allcanvs yview scroll
$delta units
2113 bindall
<2> "canvscan mark %W %x %y"
2114 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
2115 bindkey
<Home
> selfirstline
2116 bindkey
<End
> sellastline
2117 bind .
<Key-Up
> "selnextline -1"
2118 bind .
<Key-Down
> "selnextline 1"
2119 bind .
<Shift-Key-Up
> "dofind -1 0"
2120 bind .
<Shift-Key-Down
> "dofind 1 0"
2121 bindkey
<Key-Right
> "goforw"
2122 bindkey
<Key-Left
> "goback"
2123 bind .
<Key-Prior
> "selnextpage -1"
2124 bind .
<Key-Next
> "selnextpage 1"
2125 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2126 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2127 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2128 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2129 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2130 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2131 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2132 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2133 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2134 bindkey p
"selnextline -1"
2135 bindkey n
"selnextline 1"
2138 bindkey i
"selnextline -1"
2139 bindkey k
"selnextline 1"
2143 bindkey d
"$ctext yview scroll 18 units"
2144 bindkey u
"$ctext yview scroll -18 units"
2145 bindkey
/ {dofind
1 1}
2146 bindkey
<Key-Return
> {dofind
1 1}
2147 bindkey ?
{dofind
-1 1}
2149 bindkey
<F5
> updatecommits
2150 bind .
<$M1B-q> doquit
2151 bind .
<$M1B-f> {dofind
1 1}
2152 bind .
<$M1B-g> {dofind
1 0}
2153 bind .
<$M1B-r> dosearchback
2154 bind .
<$M1B-s> dosearch
2155 bind .
<$M1B-equal> {incrfont
1}
2156 bind .
<$M1B-plus> {incrfont
1}
2157 bind .
<$M1B-KP_Add> {incrfont
1}
2158 bind .
<$M1B-minus> {incrfont
-1}
2159 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2160 wm protocol . WM_DELETE_WINDOW doquit
2161 bind .
<Destroy
> {stop_backends
}
2162 bind .
<Button-1
> "click %W"
2163 bind $fstring <Key-Return
> {dofind
1 1}
2164 bind $sha1entry <Key-Return
> gotocommit
2165 bind $sha1entry <<PasteSelection>> clearsha1
2166 bind $cflist <1> {sel_flist %W %x %y; break}
2167 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2168 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2169 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
2171 set maincursor [. cget -cursor]
2172 set textcursor [$ctext cget -cursor]
2173 set curtextcursor $textcursor
2175 set rowctxmenu .rowctxmenu
2176 menu $rowctxmenu -tearoff 0
2177 $rowctxmenu add command -label [mc "Diff this -> selected"] \
2178 -command {diffvssel 0}
2179 $rowctxmenu add command -label [mc "Diff selected -> this"] \
2180 -command {diffvssel 1}
2181 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
2182 $rowctxmenu add command -label [mc "Create tag"] -command mktag
2183 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
2184 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
2185 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
2187 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
2190 set fakerowmenu .fakerowmenu
2191 menu $fakerowmenu -tearoff 0
2192 $fakerowmenu add command -label [mc "Diff this -> selected"] \
2193 -command {diffvssel 0}
2194 $fakerowmenu add command -label [mc "Diff selected -> this"] \
2195 -command {diffvssel 1}
2196 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
2197 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
2198 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
2199 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
2201 set headctxmenu .headctxmenu
2202 menu $headctxmenu -tearoff 0
2203 $headctxmenu add command -label [mc "Check out this branch"] \
2205 $headctxmenu add command -label [mc "Remove this branch"] \
2209 set flist_menu .flistctxmenu
2210 menu $flist_menu -tearoff 0
2211 $flist_menu add command -label [mc "Highlight this too"] \
2212 -command {flist_hl 0}
2213 $flist_menu add command -label [mc "Highlight this only"] \
2214 -command {flist_hl 1}
2215 $flist_menu add command -label [mc "External diff"] \
2216 -command {external_diff}
2217 $flist_menu add command -label [mc "Blame parent commit"] \
2218 -command {external_blame 1}
2221 # Windows sends all mouse wheel events to the current focused window, not
2222 # the one where the mouse hovers, so bind those events here and redirect
2223 # to the correct window
2224 proc windows_mousewheel_redirector {W X Y D} {
2225 global canv canv2 canv3
2226 set w [winfo containing -displayof $W $X $Y]
2228 set u [expr {$D < 0 ? 5 : -5}]
2229 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2230 allcanvs yview scroll $u units
2233 $w yview scroll $u units
2239 # Update row number label when selectedline changes
2240 proc selectedline_change {n1 n2 op} {
2241 global selectedline rownumsel
2243 if {$selectedline eq {}} {
2246 set rownumsel [expr {$selectedline + 1}]
2250 # mouse-2 makes all windows scan vertically, but only the one
2251 # the cursor is in scans horizontally
2252 proc canvscan {op w x y} {
2253 global canv canv2 canv3
2254 foreach c [list $canv $canv2 $canv3] {
2263 proc scrollcanv {cscroll f0 f1} {
2264 $cscroll set $f0 $f1
2269 # when we make a key binding for the toplevel, make sure
2270 # it doesn't get triggered when that key is pressed in the
2271 # find string entry widget.
2272 proc bindkey {ev script} {
2275 set escript [bind Entry $ev]
2276 if {$escript == {}} {
2277 set escript [bind Entry <Key>]
2279 foreach e $entries {
2280 bind $e $ev "$escript; break"
2284 # set the focus back to the toplevel for any click outside
2287 global ctext entries
2288 foreach e [concat $entries $ctext] {
2289 if {$w == $e} return
2294 # Adjust the progress bar for a change in requested extent or canvas size
2295 proc adjustprogress {} {
2296 global progresscanv progressitem progresscoords
2297 global fprogitem fprogcoord lastprogupdate progupdatepending
2298 global rprogitem rprogcoord
2300 set w [expr {[winfo width $progresscanv] - 4}]
2301 set x0 [expr {$w * [lindex $progresscoords 0]}]
2302 set x1 [expr {$w * [lindex $progresscoords 1]}]
2303 set h [winfo height $progresscanv]
2304 $progresscanv coords $progressitem $x0 0 $x1 $h
2305 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2306 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2307 set now [clock clicks -milliseconds]
2308 if {$now >= $lastprogupdate + 100} {
2309 set progupdatepending 0
2311 } elseif {!$progupdatepending} {
2312 set progupdatepending 1
2313 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2317 proc doprogupdate {} {
2318 global lastprogupdate progupdatepending
2320 if {$progupdatepending} {
2321 set progupdatepending 0
2322 set lastprogupdate [clock clicks -milliseconds]
2327 proc savestuff {w} {
2328 global canv canv2 canv3 mainfont textfont uifont tabstop
2329 global stuffsaved findmergefiles maxgraphpct
2330 global maxwidth showneartags showlocalchanges
2331 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2332 global cmitmode wrapcomment datetimeformat limitdiffs
2333 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2334 global autoselect extdifftool
2336 if {$stuffsaved} return
2337 if {![winfo viewable .]} return
2339 set f [open "~/.gitk-new" w]
2340 puts $f [list set mainfont $mainfont]
2341 puts $f [list set textfont $textfont]
2342 puts $f [list set uifont $uifont]
2343 puts $f [list set tabstop $tabstop]
2344 puts $f [list set findmergefiles $findmergefiles]
2345 puts $f [list set maxgraphpct $maxgraphpct]
2346 puts $f [list set maxwidth $maxwidth]
2347 puts $f [list set cmitmode $cmitmode]
2348 puts $f [list set wrapcomment $wrapcomment]
2349 puts $f [list set autoselect $autoselect]
2350 puts $f [list set showneartags $showneartags]
2351 puts $f [list set showlocalchanges $showlocalchanges]
2352 puts $f [list set datetimeformat $datetimeformat]
2353 puts $f [list set limitdiffs $limitdiffs]
2354 puts $f [list set bgcolor $bgcolor]
2355 puts $f [list set fgcolor $fgcolor]
2356 puts $f [list set colors $colors]
2357 puts $f [list set diffcolors $diffcolors]
2358 puts $f [list set diffcontext $diffcontext]
2359 puts $f [list set selectbgcolor $selectbgcolor]
2360 puts $f [list set extdifftool $extdifftool]
2362 puts $f "set geometry(main) [wm geometry .]"
2363 puts $f "set geometry(topwidth) [winfo width .tf]"
2364 puts $f "set geometry(topheight) [winfo height .tf]"
2365 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2366 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2367 puts $f "set geometry(botwidth) [winfo width .bleft]"
2368 puts $f "set geometry(botheight) [winfo height .bleft]"
2370 puts -nonewline $f "set permviews {"
2371 for {set v 0} {$v < $nextviewnum} {incr v} {
2372 if {$viewperm($v)} {
2373 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2378 file rename -force "~/.gitk-new" "~/.gitk"
2383 proc resizeclistpanes {win w} {
2385 if {[info exists oldwidth($win)]} {
2386 set s0 [$win sash coord 0]
2387 set s1 [$win sash coord 1]
2389 set sash0 [expr {int($w/2 - 2)}]
2390 set sash1 [expr {int($w*5/6 - 2)}]
2392 set factor [expr {1.0 * $w / $oldwidth($win)}]
2393 set sash0 [expr {int($factor * [lindex $s0 0])}]
2394 set sash1 [expr {int($factor * [lindex $s1 0])}]
2398 if {$sash1 < $sash0 + 20} {
2399 set sash1 [expr {$sash0 + 20}]
2401 if {$sash1 > $w - 10} {
2402 set sash1 [expr {$w - 10}]
2403 if {$sash0 > $sash1 - 20} {
2404 set sash0 [expr {$sash1 - 20}]
2408 $win sash place 0 $sash0 [lindex $s0 1]
2409 $win sash place 1 $sash1 [lindex $s1 1]
2411 set oldwidth($win) $w
2414 proc resizecdetpanes {win w} {
2416 if {[info exists oldwidth($win)]} {
2417 set s0 [$win sash coord 0]
2419 set sash0 [expr {int($w*3/4 - 2)}]
2421 set factor [expr {1.0 * $w / $oldwidth($win)}]
2422 set sash0 [expr {int($factor * [lindex $s0 0])}]
2426 if {$sash0 > $w - 15} {
2427 set sash0 [expr {$w - 15}]
2430 $win sash place 0 $sash0 [lindex $s0 1]
2432 set oldwidth($win) $w
2435 proc allcanvs args {
2436 global canv canv2 canv3
2442 proc bindall {event action} {
2443 global canv canv2 canv3
2444 bind $canv $event $action
2445 bind $canv2 $event $action
2446 bind $canv3 $event $action
2452 if {[winfo exists $w]} {
2457 wm title $w [mc "About gitk"]
2458 message $w.m -text [mc "
2459 Gitk - a commit viewer for git
2461 Copyright © 2005-2008 Paul Mackerras
2463 Use and redistribute under the terms of the GNU General Public License"] \
2464 -justify center -aspect 400 -border 2 -bg white -relief groove
2465 pack $w.m -side top -fill x -padx 2 -pady 2
2466 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2467 pack $w.ok -side bottom
2468 bind $w <Visibility> "focus $w.ok"
2469 bind $w <Key-Escape> "destroy $w"
2470 bind $w <Key-Return> "destroy $w"
2475 if {[winfo exists $w]} {
2479 if {[tk windowingsystem] eq {aqua}} {
2485 wm title $w [mc "Gitk key bindings"]
2486 message $w.m -text "
2487 [mc "Gitk key bindings:"]
2489 [mc "<%s-Q> Quit" $M1T]
2490 [mc "<Home> Move to first commit"]
2491 [mc "<End> Move to last commit"]
2492 [mc "<Up>, p, i Move up one commit"]
2493 [mc "<Down>, n, k Move down one commit"]
2494 [mc "<Left>, z, j Go back in history list"]
2495 [mc "<Right>, x, l Go forward in history list"]
2496 [mc "<PageUp> Move up one page in commit list"]
2497 [mc "<PageDown> Move down one page in commit list"]
2498 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2499 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2500 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2501 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2502 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2503 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2504 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2505 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2506 [mc "<Delete>, b Scroll diff view up one page"]
2507 [mc "<Backspace> Scroll diff view up one page"]
2508 [mc "<Space> Scroll diff view down one page"]
2509 [mc "u Scroll diff view up 18 lines"]
2510 [mc "d Scroll diff view down 18 lines"]
2511 [mc "<%s-F> Find" $M1T]
2512 [mc "<%s-G> Move to next find hit" $M1T]
2513 [mc "<Return> Move to next find hit"]
2514 [mc "/ Move to next find hit, or redo find"]
2515 [mc "? Move to previous find hit"]
2516 [mc "f Scroll diff view to next file"]
2517 [mc "<%s-S> Search for next hit in diff view" $M1T]
2518 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2519 [mc "<%s-KP+> Increase font size" $M1T]
2520 [mc "<%s-plus> Increase font size" $M1T]
2521 [mc "<%s-KP-> Decrease font size" $M1T]
2522 [mc "<%s-minus> Decrease font size" $M1T]
2525 -justify left -bg white -border 2 -relief groove
2526 pack $w.m -side top -fill both -padx 2 -pady 2
2527 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2528 pack $w.ok -side bottom
2529 bind $w <Visibility> "focus $w.ok"
2530 bind $w <Key-Escape> "destroy $w"
2531 bind $w <Key-Return> "destroy $w"
2534 # Procedures for manipulating the file list window at the
2535 # bottom right of the overall window.
2537 proc treeview {w l openlevs} {
2538 global treecontents treediropen treeheight treeparent treeindex
2548 set treecontents() {}
2549 $w conf -state normal
2551 while {[string range $f 0 $prefixend] ne $prefix} {
2552 if {$lev <= $openlevs} {
2553 $w mark set e:$treeindex($prefix) "end -1c"
2554 $w mark gravity e:$treeindex($prefix) left
2556 set treeheight($prefix) $ht
2557 incr ht [lindex $htstack end]
2558 set htstack [lreplace $htstack end end]
2559 set prefixend [lindex $prefendstack end]
2560 set prefendstack [lreplace $prefendstack end end]
2561 set prefix [string range $prefix 0 $prefixend]
2564 set tail [string range $f [expr {$prefixend+1}] end]
2565 while {[set slash [string first "/" $tail]] >= 0} {
2568 lappend prefendstack $prefixend
2569 incr prefixend [expr {$slash + 1}]
2570 set d [string range $tail 0 $slash]
2571 lappend treecontents($prefix) $d
2572 set oldprefix $prefix
2574 set treecontents($prefix) {}
2575 set treeindex($prefix) [incr ix]
2576 set treeparent($prefix) $oldprefix
2577 set tail [string range $tail [expr {$slash+1}] end]
2578 if {$lev <= $openlevs} {
2580 set treediropen($prefix) [expr {$lev < $openlevs}]
2581 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2582 $w mark set d:$ix "end -1c"
2583 $w mark gravity d:$ix left
2585 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2587 $w image create end -align center -image $bm -padx 1 \
2589 $w insert end $d [highlight_tag $prefix]
2590 $w mark set s:$ix "end -1c"
2591 $w mark gravity s:$ix left
2596 if {$lev <= $openlevs} {
2599 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2601 $w insert end $tail [highlight_tag $f]
2603 lappend treecontents($prefix) $tail
2606 while {$htstack ne {}} {
2607 set treeheight($prefix) $ht
2608 incr ht [lindex $htstack end]
2609 set htstack [lreplace $htstack end end]
2610 set prefixend [lindex $prefendstack end]
2611 set prefendstack [lreplace $prefendstack end end]
2612 set prefix [string range $prefix 0 $prefixend]
2614 $w conf -state disabled
2617 proc linetoelt {l} {
2618 global treeheight treecontents
2623 foreach e $treecontents($prefix) {
2628 if {[string index $e end] eq "/"} {
2629 set n $treeheight($prefix$e)
2641 proc highlight_tree {y prefix} {
2642 global treeheight treecontents cflist
2644 foreach e $treecontents($prefix) {
2646 if {[highlight_tag $path] ne {}} {
2647 $cflist tag add bold $y.0 "$y.0 lineend"
2650 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2651 set y [highlight_tree $y $path]
2657 proc treeclosedir {w dir} {
2658 global treediropen treeheight treeparent treeindex
2660 set ix $treeindex($dir)
2661 $w conf -state normal
2662 $w delete s:$ix e:$ix
2663 set treediropen($dir) 0
2664 $w image configure a:$ix -image tri-rt
2665 $w conf -state disabled
2666 set n [expr {1 - $treeheight($dir)}]
2667 while {$dir ne {}} {
2668 incr treeheight($dir) $n
2669 set dir $treeparent($dir)
2673 proc treeopendir {w dir} {
2674 global treediropen treeheight treeparent treecontents treeindex
2676 set ix $treeindex($dir)
2677 $w conf -state normal
2678 $w image configure a:$ix -image tri-dn
2679 $w mark set e:$ix s:$ix
2680 $w mark gravity e:$ix right
2683 set n [llength $treecontents($dir)]
2684 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2687 incr treeheight($x) $n
2689 foreach e $treecontents($dir) {
2691 if {[string index $e end] eq "/"} {
2692 set iy $treeindex($de)
2693 $w mark set d:$iy e:$ix
2694 $w mark gravity d:$iy left
2695 $w insert e:$ix $str
2696 set treediropen($de) 0
2697 $w image create e:$ix -align center -image tri-rt -padx 1 \
2699 $w insert e:$ix $e [highlight_tag $de]
2700 $w mark set s:$iy e:$ix
2701 $w mark gravity s:$iy left
2702 set treeheight($de) 1
2704 $w insert e:$ix $str
2705 $w insert e:$ix $e [highlight_tag $de]
2708 $w mark gravity e:$ix left
2709 $w conf -state disabled
2710 set treediropen($dir) 1
2711 set top [lindex [split [$w index @0,0] .] 0]
2712 set ht [$w cget -height]
2713 set l [lindex [split [$w index s:$ix] .] 0]
2716 } elseif {$l + $n + 1 > $top + $ht} {
2717 set top [expr {$l + $n + 2 - $ht}]
2725 proc treeclick {w x y} {
2726 global treediropen cmitmode ctext cflist cflist_top
2728 if {$cmitmode ne "tree"} return
2729 if {![info exists cflist_top]} return
2730 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2731 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2732 $cflist tag add highlight $l.0 "$l.0 lineend"
2738 set e [linetoelt $l]
2739 if {[string index $e end] ne "/"} {
2741 } elseif {$treediropen($e)} {
2748 proc setfilelist {id} {
2749 global treefilelist cflist
2751 treeview $cflist $treefilelist($id) 0
2754 image create bitmap tri-rt -background black -foreground blue -data {
2755 #define tri-rt_width 13
2756 #define tri-rt_height 13
2757 static unsigned char tri-rt_bits[] = {
2758 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2759 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2762 #define tri-rt-mask_width 13
2763 #define tri-rt-mask_height 13
2764 static unsigned char tri-rt-mask_bits[] = {
2765 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2766 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2769 image create bitmap tri-dn -background black -foreground blue -data {
2770 #define tri-dn_width 13
2771 #define tri-dn_height 13
2772 static unsigned char tri-dn_bits[] = {
2773 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2774 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2777 #define tri-dn-mask_width 13
2778 #define tri-dn-mask_height 13
2779 static unsigned char tri-dn-mask_bits[] = {
2780 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2781 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2785 image create bitmap reficon-T -background black -foreground yellow -data {
2786 #define tagicon_width 13
2787 #define tagicon_height 9
2788 static unsigned char tagicon_bits[] = {
2789 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2790 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2792 #define tagicon-mask_width 13
2793 #define tagicon-mask_height 9
2794 static unsigned char tagicon-mask_bits[] = {
2795 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2796 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2799 #define headicon_width 13
2800 #define headicon_height 9
2801 static unsigned char headicon_bits[] = {
2802 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2803 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2806 #define headicon-mask_width 13
2807 #define headicon-mask_height 9
2808 static unsigned char headicon-mask_bits[] = {
2809 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2810 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2812 image create bitmap reficon-H -background black -foreground green \
2813 -data $rectdata -maskdata $rectmask
2814 image create bitmap reficon-o -background black -foreground "#ddddff" \
2815 -data $rectdata -maskdata $rectmask
2817 proc init_flist {first} {
2818 global cflist cflist_top difffilestart
2820 $cflist conf -state normal
2821 $cflist delete 0.0 end
2823 $cflist insert end $first
2825 $cflist tag add highlight 1.0 "1.0 lineend"
2827 catch {unset cflist_top}
2829 $cflist conf -state disabled
2830 set difffilestart {}
2833 proc highlight_tag {f} {
2834 global highlight_paths
2836 foreach p $highlight_paths {
2837 if {[string match $p $f]} {
2844 proc highlight_filelist {} {
2845 global cmitmode cflist
2847 $cflist conf -state normal
2848 if {$cmitmode ne "tree"} {
2849 set end [lindex [split [$cflist index end] .] 0]
2850 for {set l 2} {$l < $end} {incr l} {
2851 set line [$cflist get $l.0 "$l.0 lineend"]
2852 if {[highlight_tag $line] ne {}} {
2853 $cflist tag add bold $l.0 "$l.0 lineend"
2859 $cflist conf -state disabled
2862 proc unhighlight_filelist {} {
2865 $cflist conf -state normal
2866 $cflist tag remove bold 1.0 end
2867 $cflist conf -state disabled
2870 proc add_flist {fl} {
2873 $cflist conf -state normal
2875 $cflist insert end "\n"
2876 $cflist insert end $f [highlight_tag $f]
2878 $cflist conf -state disabled
2881 proc sel_flist {w x y} {
2882 global ctext difffilestart cflist cflist_top cmitmode
2884 if {$cmitmode eq "tree"} return
2885 if {![info exists cflist_top]} return
2886 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2887 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2888 $cflist tag add highlight $l.0 "$l.0 lineend"
2893 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2897 proc pop_flist_menu {w X Y x y} {
2898 global ctext cflist cmitmode flist_menu flist_menu_file
2899 global treediffs diffids
2902 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2904 if {$cmitmode eq "tree"} {
2905 set e [linetoelt $l]
2906 if {[string index $e end] eq "/"} return
2908 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2910 set flist_menu_file $e
2911 set xdiffstate "normal"
2912 if {$cmitmode eq "tree"} {
2913 set xdiffstate "disabled"
2915 # Disable "External diff" item in tree mode
2916 $flist_menu entryconf 2 -state $xdiffstate
2917 tk_popup $flist_menu $X $Y
2920 proc flist_hl {only} {
2921 global flist_menu_file findstring gdttype
2923 set x [shellquote $flist_menu_file]
2924 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2927 append findstring " " $x
2929 set gdttype [mc "touching paths:"]
2932 proc save_file_from_commit {filename output what} {
2935 if {[catch {exec git show $filename -- > $output} err]} {
2936 if {[string match "fatal: bad revision *" $err]} {
2939 error_popup "Error getting \"$filename\" from $what: $err"
2945 proc external_diff_get_one_file {diffid filename diffdir} {
2946 global nullid nullid2 nullfile
2949 if {$diffid == $nullid} {
2950 set difffile [file join [file dirname $gitdir] $filename]
2951 if {[file exists $difffile]} {
2956 if {$diffid == $nullid2} {
2957 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
2958 return [save_file_from_commit :$filename $difffile index]
2960 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
2961 return [save_file_from_commit $diffid:$filename $difffile \
2965 proc external_diff {} {
2966 global gitktmpdir nullid nullid2
2967 global flist_menu_file
2970 global gitdir extdifftool
2972 if {[llength $diffids] == 1} {
2973 # no reference commit given
2974 set diffidto [lindex $diffids 0]
2975 if {$diffidto eq $nullid} {
2976 # diffing working copy with index
2977 set diffidfrom $nullid2
2978 } elseif {$diffidto eq $nullid2} {
2979 # diffing index with HEAD
2980 set diffidfrom "HEAD"
2982 # use first parent commit
2983 global parentlist selectedline
2984 set diffidfrom [lindex $parentlist $selectedline 0]
2987 set diffidfrom [lindex $diffids 0]
2988 set diffidto [lindex $diffids 1]
2991 # make sure that several diffs wont collide
2992 if {![info exists gitktmpdir]} {
2993 set gitktmpdir [file join [file dirname $gitdir] \
2994 [format ".gitk-tmp.%s" [pid]]]
2995 if {[catch {file mkdir $gitktmpdir} err]} {
2996 error_popup "Error creating temporary directory $gitktmpdir: $err"
3003 set diffdir [file join $gitktmpdir $diffnum]
3004 if {[catch {file mkdir $diffdir} err]} {
3005 error_popup "Error creating temporary directory $diffdir: $err"
3009 # gather files to diff
3010 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3011 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3013 if {$difffromfile ne {} && $difftofile ne {}} {
3014 set cmd [concat | [shellsplit $extdifftool] \
3015 [list $difffromfile $difftofile]]
3016 if {[catch {set fl [open $cmd r]} err]} {
3017 file delete -force $diffdir
3018 error_popup [mc "$extdifftool: command failed: $err"]
3020 fconfigure $fl -blocking 0
3021 filerun $fl [list delete_at_eof $fl $diffdir]
3026 proc external_blame {parent_idx} {
3027 global flist_menu_file
3028 global nullid nullid2
3029 global parentlist selectedline currentid
3031 if {$parent_idx > 0} {
3032 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3034 set base_commit $currentid
3037 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3038 error_popup [mc "No such commit"]
3042 if {[catch {exec git gui blame $base_commit $flist_menu_file &} err]} {
3043 error_popup [mc "git gui blame: command failed: $err"]
3047 # delete $dir when we see eof on $f (presumably because the child has exited)
3048 proc delete_at_eof {f dir} {
3049 while {[gets $f line] >= 0} {}
3051 if {[catch {close $f} err]} {
3052 error_popup "External diff viewer failed: $err"
3054 file delete -force $dir
3060 # Functions for adding and removing shell-type quoting
3062 proc shellquote {str} {
3063 if {![string match "*\['\"\\ \t]*" $str]} {
3066 if {![string match "*\['\"\\]*" $str]} {
3069 if {![string match "*'*" $str]} {
3072 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3075 proc shellarglist {l} {
3081 append str [shellquote $a]
3086 proc shelldequote {str} {
3091 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3092 append ret [string range $str $used end]
3093 set used [string length $str]
3096 set first [lindex $first 0]
3097 set ch [string index $str $first]
3098 if {$first > $used} {
3099 append ret [string range $str $used [expr {$first - 1}]]
3102 if {$ch eq " " || $ch eq "\t"} break
3105 set first [string first "'" $str $used]
3107 error "unmatched single-quote"
3109 append ret [string range $str $used [expr {$first - 1}]]
3114 if {$used >= [string length $str]} {
3115 error "trailing backslash"
3117 append ret [string index $str $used]
3122 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3123 error "unmatched double-quote"
3125 set first [lindex $first 0]
3126 set ch [string index $str $first]
3127 if {$first > $used} {
3128 append ret [string range $str $used [expr {$first - 1}]]
3131 if {$ch eq "\""} break
3133 append ret [string index $str $used]
3137 return [list $used $ret]
3140 proc shellsplit {str} {
3143 set str [string trimleft $str]
3144 if {$str eq {}} break
3145 set dq [shelldequote $str]
3146 set n [lindex $dq 0]
3147 set word [lindex $dq 1]
3148 set str [string range $str $n end]
3154 # Code to implement multiple views
3156 proc newview {ishighlight} {
3157 global nextviewnum newviewname newviewperm newishighlight
3158 global newviewargs revtreeargs viewargscmd newviewargscmd curview
3160 set newishighlight $ishighlight
3162 if {[winfo exists $top]} {
3166 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3167 set newviewperm($nextviewnum) 0
3168 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
3169 set newviewargscmd($nextviewnum) $viewargscmd($curview)
3170 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3175 global viewname viewperm newviewname newviewperm
3176 global viewargs newviewargs viewargscmd newviewargscmd
3178 set top .gitkvedit-$curview
3179 if {[winfo exists $top]} {
3183 set newviewname($curview) $viewname($curview)
3184 set newviewperm($curview) $viewperm($curview)
3185 set newviewargs($curview) [shellarglist $viewargs($curview)]
3186 set newviewargscmd($curview) $viewargscmd($curview)
3187 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
3190 proc vieweditor {top n title} {
3191 global newviewname newviewperm viewfiles bgcolor
3194 wm title $top $title
3195 label $top.nl -text [mc "Name"]
3196 entry $top.name -width 20 -textvariable newviewname($n)
3197 grid $top.nl $top.name -sticky w -pady 5
3198 checkbutton $top.perm -text [mc "Remember this view"] \
3199 -variable newviewperm($n)
3200 grid $top.perm - -pady 5 -sticky w
3201 message $top.al -aspect 1000 \
3202 -text [mc "Commits to include (arguments to git log):"]
3203 grid $top.al - -sticky w -pady 5
3204 entry $top.args -width 50 -textvariable newviewargs($n) \
3205 -background $bgcolor
3206 grid $top.args - -sticky ew -padx 5
3208 message $top.ac -aspect 1000 \
3209 -text [mc "Command to generate more commits to include:"]
3210 grid $top.ac - -sticky w -pady 5
3211 entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
3213 grid $top.argscmd - -sticky ew -padx 5
3215 message $top.l -aspect 1000 \
3216 -text [mc "Enter files and directories to include, one per line:"]
3217 grid $top.l - -sticky w
3218 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
3219 if {[info exists viewfiles($n)]} {
3220 foreach f $viewfiles($n) {
3221 $top.t insert end $f
3222 $top.t insert end "\n"
3224 $top.t delete {end - 1c} end
3225 $top.t mark set insert 0.0
3227 grid $top.t - -sticky ew -padx 5
3229 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3230 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3231 grid $top.buts.ok $top.buts.can
3232 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3233 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3234 grid $top.buts - -pady 10 -sticky ew
3238 proc doviewmenu {m first cmd op argv} {
3239 set nmenu [$m index end]
3240 for {set i $first} {$i <= $nmenu} {incr i} {
3241 if {[$m entrycget $i -command] eq $cmd} {
3242 eval $m $op $i $argv
3248 proc allviewmenus {n op args} {
3251 doviewmenu .bar.view 5 [list showview $n] $op $args
3252 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3255 proc newviewok {top n} {
3256 global nextviewnum newviewperm newviewname newishighlight
3257 global viewname viewfiles viewperm selectedview curview
3258 global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
3261 set newargs [shellsplit $newviewargs($n)]
3263 error_popup "[mc "Error in commit selection arguments:"] $err"
3269 foreach f [split [$top.t get 0.0 end] "\n"] {
3270 set ft [string trim $f]
3275 if {![info exists viewfiles($n)]} {
3276 # creating a new view
3278 set viewname($n) $newviewname($n)
3279 set viewperm($n) $newviewperm($n)
3280 set viewfiles($n) $files
3281 set viewargs($n) $newargs
3282 set viewargscmd($n) $newviewargscmd($n)
3284 if {!$newishighlight} {
3287 run addvhighlight $n
3290 # editing an existing view
3291 set viewperm($n) $newviewperm($n)
3292 if {$newviewname($n) ne $viewname($n)} {
3293 set viewname($n) $newviewname($n)
3294 doviewmenu .bar.view 5 [list showview $n] \
3295 entryconf [list -label $viewname($n)]
3296 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3297 # entryconf [list -label $viewname($n) -value $viewname($n)]
3299 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3300 $newviewargscmd($n) ne $viewargscmd($n)} {
3301 set viewfiles($n) $files
3302 set viewargs($n) $newargs
3303 set viewargscmd($n) $newviewargscmd($n)
3304 if {$curview == $n} {
3309 catch {destroy $top}
3313 global curview viewperm hlview selectedhlview
3315 if {$curview == 0} return
3316 if {[info exists hlview] && $hlview == $curview} {
3317 set selectedhlview [mc "None"]
3320 allviewmenus $curview delete
3321 set viewperm($curview) 0
3325 proc addviewmenu {n} {
3326 global viewname viewhlmenu
3328 .bar.view add radiobutton -label $viewname($n) \
3329 -command [list showview $n] -variable selectedview -value $n
3330 #$viewhlmenu add radiobutton -label $viewname($n) \
3331 # -command [list addvhighlight $n] -variable selectedhlview
3335 global curview cached_commitrow ordertok
3336 global displayorder parentlist rowidlist rowisopt rowfinal
3337 global colormap rowtextx nextcolor canvxmax
3338 global numcommits viewcomplete
3339 global selectedline currentid canv canvy0
3341 global pending_select mainheadid
3344 global hlview selectedhlview commitinterest
3346 if {$n == $curview} return
3348 set ymax [lindex [$canv cget -scrollregion] 3]
3349 set span [$canv yview]
3350 set ytop [expr {[lindex $span 0] * $ymax}]
3351 set ybot [expr {[lindex $span 1] * $ymax}]
3352 set yscreen [expr {($ybot - $ytop) / 2}]
3353 if {$selectedline ne {}} {
3354 set selid $currentid
3355 set y [yc $selectedline]
3356 if {$ytop < $y && $y < $ybot} {
3357 set yscreen [expr {$y - $ytop}]
3359 } elseif {[info exists pending_select]} {
3360 set selid $pending_select
3361 unset pending_select
3365 catch {unset treediffs}
3367 if {[info exists hlview] && $hlview == $n} {
3369 set selectedhlview [mc "None"]
3371 catch {unset commitinterest}
3372 catch {unset cached_commitrow}
3373 catch {unset ordertok}
3377 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3378 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3381 if {![info exists viewcomplete($n)]} {
3391 set numcommits $commitidx($n)
3393 catch {unset colormap}
3394 catch {unset rowtextx}
3396 set canvxmax [$canv cget -width]
3402 if {$selid ne {} && [commitinview $selid $n]} {
3403 set row [rowofcommit $selid]
3404 # try to get the selected row in the same position on the screen
3405 set ymax [lindex [$canv cget -scrollregion] 3]
3406 set ytop [expr {[yc $row] - $yscreen}]
3410 set yf [expr {$ytop * 1.0 / $ymax}]
3412 allcanvs yview moveto $yf
3416 } elseif {!$viewcomplete($n)} {
3417 reset_pending_select $selid
3419 reset_pending_select {}
3421 if {[commitinview $pending_select $curview]} {
3422 selectline [rowofcommit $pending_select] 1
3424 set row [first_real_row]
3425 if {$row < $numcommits} {
3430 if {!$viewcomplete($n)} {
3431 if {$numcommits == 0} {
3432 show_status [mc "Reading commits..."]
3434 } elseif {$numcommits == 0} {
3435 show_status [mc "No commits selected"]
3439 # Stuff relating to the highlighting facility
3441 proc ishighlighted {id} {
3442 global vhighlights fhighlights nhighlights rhighlights
3444 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3445 return $nhighlights($id)
3447 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3448 return $vhighlights($id)
3450 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
3451 return $fhighlights($id)
3453 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
3454 return $rhighlights($id)
3459 proc bolden {row font} {
3460 global canv linehtag selectedline boldrows
3462 lappend boldrows $row
3463 $canv itemconf $linehtag($row) -font $font
3464 if {$row == $selectedline} {
3466 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
3467 -outline {{}} -tags secsel \
3468 -fill [$canv cget -selectbackground]]
3473 proc bolden_name {row font} {
3474 global canv2 linentag selectedline boldnamerows
3476 lappend boldnamerows $row
3477 $canv2 itemconf $linentag($row) -font $font
3478 if {$row == $selectedline} {
3479 $canv2 delete secsel
3480 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
3481 -outline {{}} -tags secsel \
3482 -fill [$canv2 cget -selectbackground]]
3491 foreach row $boldrows {
3492 if {![ishighlighted [commitonrow $row]]} {
3493 bolden $row mainfont
3495 lappend stillbold $row
3498 set boldrows $stillbold
3501 proc addvhighlight {n} {
3502 global hlview viewcomplete curview vhl_done commitidx
3504 if {[info exists hlview]} {
3508 if {$n != $curview && ![info exists viewcomplete($n)]} {
3511 set vhl_done $commitidx($hlview)
3512 if {$vhl_done > 0} {
3517 proc delvhighlight {} {
3518 global hlview vhighlights
3520 if {![info exists hlview]} return
3522 catch {unset vhighlights}
3526 proc vhighlightmore {} {
3527 global hlview vhl_done commitidx vhighlights curview
3529 set max $commitidx($hlview)
3530 set vr [visiblerows]
3531 set r0 [lindex $vr 0]
3532 set r1 [lindex $vr 1]
3533 for {set i $vhl_done} {$i < $max} {incr i} {
3534 set id [commitonrow $i $hlview]
3535 if {[commitinview $id $curview]} {
3536 set row [rowofcommit $id]
3537 if {$r0 <= $row && $row <= $r1} {
3538 if {![highlighted $row]} {
3539 bolden $row mainfontbold
3541 set vhighlights($id) 1
3549 proc askvhighlight {row id} {
3550 global hlview vhighlights iddrawn
3552 if {[commitinview $id $hlview]} {
3553 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3554 bolden $row mainfontbold
3556 set vhighlights($id) 1
3558 set vhighlights($id) 0
3562 proc hfiles_change {} {
3563 global highlight_files filehighlight fhighlights fh_serial
3564 global highlight_paths gdttype
3566 if {[info exists filehighlight]} {
3567 # delete previous highlights
3568 catch {close $filehighlight}
3570 catch {unset fhighlights}
3572 unhighlight_filelist
3574 set highlight_paths {}
3575 after cancel do_file_hl $fh_serial
3577 if {$highlight_files ne {}} {
3578 after 300 do_file_hl $fh_serial
3582 proc gdttype_change {name ix op} {
3583 global gdttype highlight_files findstring findpattern
3586 if {$findstring ne {}} {
3587 if {$gdttype eq [mc "containing:"]} {
3588 if {$highlight_files ne {}} {
3589 set highlight_files {}
3594 if {$findpattern ne {}} {
3598 set highlight_files $findstring
3603 # enable/disable findtype/findloc menus too
3606 proc find_change {name ix op} {
3607 global gdttype findstring highlight_files
3610 if {$gdttype eq [mc "containing:"]} {
3613 if {$highlight_files ne $findstring} {
3614 set highlight_files $findstring
3621 proc findcom_change args {
3622 global nhighlights boldnamerows
3623 global findpattern findtype findstring gdttype
3626 # delete previous highlights, if any
3627 foreach row $boldnamerows {
3628 bolden_name $row mainfont
3631 catch {unset nhighlights}
3634 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3636 } elseif {$findtype eq [mc "Regexp"]} {
3637 set findpattern $findstring
3639 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3641 set findpattern "*$e*"
3645 proc makepatterns {l} {
3648 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3649 if {[string index $ee end] eq "/"} {
3659 proc do_file_hl {serial} {
3660 global highlight_files filehighlight highlight_paths gdttype fhl_list
3662 if {$gdttype eq [mc "touching paths:"]} {
3663 if {[catch {set paths [shellsplit $highlight_files]}]} return
3664 set highlight_paths [makepatterns $paths]
3666 set gdtargs [concat -- $paths]
3667 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3668 set gdtargs [list "-S$highlight_files"]
3670 # must be "containing:", i.e. we're searching commit info
3673 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3674 set filehighlight [open $cmd r+]
3675 fconfigure $filehighlight -blocking 0
3676 filerun $filehighlight readfhighlight
3682 proc flushhighlights {} {
3683 global filehighlight fhl_list
3685 if {[info exists filehighlight]} {
3687 puts $filehighlight ""
3688 flush $filehighlight
3692 proc askfilehighlight {row id} {
3693 global filehighlight fhighlights fhl_list
3695 lappend fhl_list $id
3696 set fhighlights($id) -1
3697 puts $filehighlight $id
3700 proc readfhighlight {} {
3701 global filehighlight fhighlights curview iddrawn
3702 global fhl_list find_dirn
3704 if {![info exists filehighlight]} {
3708 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3709 set line [string trim $line]
3710 set i [lsearch -exact $fhl_list $line]
3711 if {$i < 0} continue
3712 for {set j 0} {$j < $i} {incr j} {
3713 set id [lindex $fhl_list $j]
3714 set fhighlights($id) 0
3716 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3717 if {$line eq {}} continue
3718 if {![commitinview $line $curview]} continue
3719 set row [rowofcommit $line]
3720 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3721 bolden $row mainfontbold
3723 set fhighlights($line) 1
3725 if {[eof $filehighlight]} {
3727 puts "oops, git diff-tree died"
3728 catch {close $filehighlight}
3732 if {[info exists find_dirn]} {
3738 proc doesmatch {f} {
3739 global findtype findpattern
3741 if {$findtype eq [mc "Regexp"]} {
3742 return [regexp $findpattern $f]
3743 } elseif {$findtype eq [mc "IgnCase"]} {
3744 return [string match -nocase $findpattern $f]
3746 return [string match $findpattern $f]
3750 proc askfindhighlight {row id} {
3751 global nhighlights commitinfo iddrawn
3753 global markingmatches
3755 if {![info exists commitinfo($id)]} {
3758 set info $commitinfo($id)
3760 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3761 foreach f $info ty $fldtypes {
3762 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3764 if {$ty eq [mc "Author"]} {
3771 if {$isbold && [info exists iddrawn($id)]} {
3772 if {![ishighlighted $id]} {
3773 bolden $row mainfontbold
3775 bolden_name $row mainfontbold
3778 if {$markingmatches} {
3779 markrowmatches $row $id
3782 set nhighlights($id) $isbold
3785 proc markrowmatches {row id} {
3786 global canv canv2 linehtag linentag commitinfo findloc
3788 set headline [lindex $commitinfo($id) 0]
3789 set author [lindex $commitinfo($id) 1]
3790 $canv delete match$row
3791 $canv2 delete match$row
3792 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3793 set m [findmatches $headline]
3795 markmatches $canv $row $headline $linehtag($row) $m \
3796 [$canv itemcget $linehtag($row) -font] $row
3799 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3800 set m [findmatches $author]
3802 markmatches $canv2 $row $author $linentag($row) $m \
3803 [$canv2 itemcget $linentag($row) -font] $row
3808 proc vrel_change {name ix op} {
3809 global highlight_related
3812 if {$highlight_related ne [mc "None"]} {
3817 # prepare for testing whether commits are descendents or ancestors of a
3818 proc rhighlight_sel {a} {
3819 global descendent desc_todo ancestor anc_todo
3820 global highlight_related
3822 catch {unset descendent}
3823 set desc_todo [list $a]
3824 catch {unset ancestor}
3825 set anc_todo [list $a]
3826 if {$highlight_related ne [mc "None"]} {
3832 proc rhighlight_none {} {
3835 catch {unset rhighlights}
3839 proc is_descendent {a} {
3840 global curview children descendent desc_todo
3843 set la [rowofcommit $a]
3847 for {set i 0} {$i < [llength $todo]} {incr i} {
3848 set do [lindex $todo $i]
3849 if {[rowofcommit $do] < $la} {
3850 lappend leftover $do
3853 foreach nk $children($v,$do) {
3854 if {![info exists descendent($nk)]} {
3855 set descendent($nk) 1
3863 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3867 set descendent($a) 0
3868 set desc_todo $leftover
3871 proc is_ancestor {a} {
3872 global curview parents ancestor anc_todo
3875 set la [rowofcommit $a]
3879 for {set i 0} {$i < [llength $todo]} {incr i} {
3880 set do [lindex $todo $i]
3881 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3882 lappend leftover $do
3885 foreach np $parents($v,$do) {
3886 if {![info exists ancestor($np)]} {
3895 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3900 set anc_todo $leftover
3903 proc askrelhighlight {row id} {
3904 global descendent highlight_related iddrawn rhighlights
3905 global selectedline ancestor
3907 if {$selectedline eq {}} return
3909 if {$highlight_related eq [mc "Descendant"] ||
3910 $highlight_related eq [mc "Not descendant"]} {
3911 if {![info exists descendent($id)]} {
3914 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
3917 } elseif {$highlight_related eq [mc "Ancestor"] ||
3918 $highlight_related eq [mc "Not ancestor"]} {
3919 if {![info exists ancestor($id)]} {
3922 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3926 if {[info exists iddrawn($id)]} {
3927 if {$isbold && ![ishighlighted $id]} {
3928 bolden $row mainfontbold
3931 set rhighlights($id) $isbold
3934 # Graph layout functions
3936 proc shortids {ids} {
3939 if {[llength $id] > 1} {
3940 lappend res [shortids $id]
3941 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3942 lappend res [string range $id 0 7]
3953 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3954 if {($n & $mask) != 0} {
3955 set ret [concat $ret $o]
3957 set o [concat $o $o]
3962 proc ordertoken {id} {
3963 global ordertok curview varcid varcstart varctok curview parents children
3964 global nullid nullid2
3966 if {[info exists ordertok($id)]} {
3967 return $ordertok($id)
3972 if {[info exists varcid($curview,$id)]} {
3973 set a $varcid($curview,$id)
3974 set p [lindex $varcstart($curview) $a]
3976 set p [lindex $children($curview,$id) 0]
3978 if {[info exists ordertok($p)]} {
3979 set tok $ordertok($p)
3982 set id [first_real_child $curview,$p]
3985 set tok [lindex $varctok($curview) $varcid($curview,$p)]
3988 if {[llength $parents($curview,$id)] == 1} {
3989 lappend todo [list $p {}]
3991 set j [lsearch -exact $parents($curview,$id) $p]
3993 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3995 lappend todo [list $p [strrep $j]]
3998 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3999 set p [lindex $todo $i 0]
4000 append tok [lindex $todo $i 1]
4001 set ordertok($p) $tok
4003 set ordertok($origid) $tok
4007 # Work out where id should go in idlist so that order-token
4008 # values increase from left to right
4009 proc idcol {idlist id {i 0}} {
4010 set t [ordertoken $id]
4014 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4015 if {$i > [llength $idlist]} {
4016 set i [llength $idlist]
4018 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4021 if {$t > [ordertoken [lindex $idlist $i]]} {
4022 while {[incr i] < [llength $idlist] &&
4023 $t >= [ordertoken [lindex $idlist $i]]} {}
4029 proc initlayout {} {
4030 global rowidlist rowisopt rowfinal displayorder parentlist
4031 global numcommits canvxmax canv
4033 global colormap rowtextx
4042 set canvxmax [$canv cget -width]
4043 catch {unset colormap}
4044 catch {unset rowtextx}
4048 proc setcanvscroll {} {
4049 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4050 global lastscrollset lastscrollrows
4052 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4053 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4054 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4055 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4056 set lastscrollset [clock clicks -milliseconds]
4057 set lastscrollrows $numcommits
4060 proc visiblerows {} {
4061 global canv numcommits linespc
4063 set ymax [lindex [$canv cget -scrollregion] 3]
4064 if {$ymax eq {} || $ymax == 0} return
4066 set y0 [expr {int([lindex $f 0] * $ymax)}]
4067 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4071 set y1 [expr {int([lindex $f 1] * $ymax)}]
4072 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4073 if {$r1 >= $numcommits} {
4074 set r1 [expr {$numcommits - 1}]
4076 return [list $r0 $r1]
4079 proc layoutmore {} {
4080 global commitidx viewcomplete curview
4081 global numcommits pending_select curview
4082 global lastscrollset lastscrollrows commitinterest
4084 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4085 [clock clicks -milliseconds] - $lastscrollset > 500} {
4088 if {[info exists pending_select] &&
4089 [commitinview $pending_select $curview]} {
4091 selectline [rowofcommit $pending_select] 1
4096 proc doshowlocalchanges {} {
4097 global curview mainheadid
4099 if {$mainheadid eq {}} return
4100 if {[commitinview $mainheadid $curview]} {
4103 lappend commitinterest($mainheadid) {dodiffindex}
4107 proc dohidelocalchanges {} {
4108 global nullid nullid2 lserial curview
4110 if {[commitinview $nullid $curview]} {
4111 removefakerow $nullid
4113 if {[commitinview $nullid2 $curview]} {
4114 removefakerow $nullid2
4119 # spawn off a process to do git diff-index --cached HEAD
4120 proc dodiffindex {} {
4121 global lserial showlocalchanges
4124 if {!$showlocalchanges || !$isworktree} return
4126 set fd [open "|git diff-index --cached HEAD" r]
4127 fconfigure $fd -blocking 0
4128 set i [reg_instance $fd]
4129 filerun $fd [list readdiffindex $fd $lserial $i]
4132 proc readdiffindex {fd serial inst} {
4133 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4136 if {[gets $fd line] < 0} {
4142 # we only need to see one line and we don't really care what it says...
4145 if {$serial != $lserial} {
4149 # now see if there are any local changes not checked in to the index
4150 set fd [open "|git diff-files" r]
4151 fconfigure $fd -blocking 0
4152 set i [reg_instance $fd]
4153 filerun $fd [list readdifffiles $fd $serial $i]
4155 if {$isdiff && ![commitinview $nullid2 $curview]} {
4156 # add the line for the changes in the index to the graph
4157 set hl [mc "Local changes checked in to index but not committed"]
4158 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4159 set commitdata($nullid2) "\n $hl\n"
4160 if {[commitinview $nullid $curview]} {
4161 removefakerow $nullid
4163 insertfakerow $nullid2 $mainheadid
4164 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4165 removefakerow $nullid2
4170 proc readdifffiles {fd serial inst} {
4171 global mainheadid nullid nullid2 curview
4172 global commitinfo commitdata lserial
4175 if {[gets $fd line] < 0} {
4181 # we only need to see one line and we don't really care what it says...
4184 if {$serial != $lserial} {
4188 if {$isdiff && ![commitinview $nullid $curview]} {
4189 # add the line for the local diff to the graph
4190 set hl [mc "Local uncommitted changes, not checked in to index"]
4191 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4192 set commitdata($nullid) "\n $hl\n"
4193 if {[commitinview $nullid2 $curview]} {
4198 insertfakerow $nullid $p
4199 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4200 removefakerow $nullid
4205 proc nextuse {id row} {
4206 global curview children
4208 if {[info exists children($curview,$id)]} {
4209 foreach kid $children($curview,$id) {
4210 if {![commitinview $kid $curview]} {
4213 if {[rowofcommit $kid] > $row} {
4214 return [rowofcommit $kid]
4218 if {[commitinview $id $curview]} {
4219 return [rowofcommit $id]
4224 proc prevuse {id row} {
4225 global curview children
4228 if {[info exists children($curview,$id)]} {
4229 foreach kid $children($curview,$id) {
4230 if {![commitinview $kid $curview]} break
4231 if {[rowofcommit $kid] < $row} {
4232 set ret [rowofcommit $kid]
4239 proc make_idlist {row} {
4240 global displayorder parentlist uparrowlen downarrowlen mingaplen
4241 global commitidx curview children
4243 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4247 set ra [expr {$row - $downarrowlen}]
4251 set rb [expr {$row + $uparrowlen}]
4252 if {$rb > $commitidx($curview)} {
4253 set rb $commitidx($curview)
4255 make_disporder $r [expr {$rb + 1}]
4257 for {} {$r < $ra} {incr r} {
4258 set nextid [lindex $displayorder [expr {$r + 1}]]
4259 foreach p [lindex $parentlist $r] {
4260 if {$p eq $nextid} continue
4261 set rn [nextuse $p $r]
4263 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4264 lappend ids [list [ordertoken $p] $p]
4268 for {} {$r < $row} {incr r} {
4269 set nextid [lindex $displayorder [expr {$r + 1}]]
4270 foreach p [lindex $parentlist $r] {
4271 if {$p eq $nextid} continue
4272 set rn [nextuse $p $r]
4273 if {$rn < 0 || $rn >= $row} {
4274 lappend ids [list [ordertoken $p] $p]
4278 set id [lindex $displayorder $row]
4279 lappend ids [list [ordertoken $id] $id]
4281 foreach p [lindex $parentlist $r] {
4282 set firstkid [lindex $children($curview,$p) 0]
4283 if {[rowofcommit $firstkid] < $row} {
4284 lappend ids [list [ordertoken $p] $p]
4288 set id [lindex $displayorder $r]
4290 set firstkid [lindex $children($curview,$id) 0]
4291 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4292 lappend ids [list [ordertoken $id] $id]
4297 foreach idx [lsort -unique $ids] {
4298 lappend idlist [lindex $idx 1]
4303 proc rowsequal {a b} {
4304 while {[set i [lsearch -exact $a {}]] >= 0} {
4305 set a [lreplace $a $i $i]
4307 while {[set i [lsearch -exact $b {}]] >= 0} {
4308 set b [lreplace $b $i $i]
4310 return [expr {$a eq $b}]
4313 proc makeupline {id row rend col} {
4314 global rowidlist uparrowlen downarrowlen mingaplen
4316 for {set r $rend} {1} {set r $rstart} {
4317 set rstart [prevuse $id $r]
4318 if {$rstart < 0} return
4319 if {$rstart < $row} break
4321 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4322 set rstart [expr {$rend - $uparrowlen - 1}]
4324 for {set r $rstart} {[incr r] <= $row} {} {
4325 set idlist [lindex $rowidlist $r]
4326 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4327 set col [idcol $idlist $id $col]
4328 lset rowidlist $r [linsert $idlist $col $id]
4334 proc layoutrows {row endrow} {
4335 global rowidlist rowisopt rowfinal displayorder
4336 global uparrowlen downarrowlen maxwidth mingaplen
4337 global children parentlist
4338 global commitidx viewcomplete curview
4340 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4343 set rm1 [expr {$row - 1}]
4344 foreach id [lindex $rowidlist $rm1] {
4349 set final [lindex $rowfinal $rm1]
4351 for {} {$row < $endrow} {incr row} {
4352 set rm1 [expr {$row - 1}]
4353 if {$rm1 < 0 || $idlist eq {}} {
4354 set idlist [make_idlist $row]
4357 set id [lindex $displayorder $rm1]
4358 set col [lsearch -exact $idlist $id]
4359 set idlist [lreplace $idlist $col $col]
4360 foreach p [lindex $parentlist $rm1] {
4361 if {[lsearch -exact $idlist $p] < 0} {
4362 set col [idcol $idlist $p $col]
4363 set idlist [linsert $idlist $col $p]
4364 # if not the first child, we have to insert a line going up
4365 if {$id ne [lindex $children($curview,$p) 0]} {
4366 makeupline $p $rm1 $row $col
4370 set id [lindex $displayorder $row]
4371 if {$row > $downarrowlen} {
4372 set termrow [expr {$row - $downarrowlen - 1}]
4373 foreach p [lindex $parentlist $termrow] {
4374 set i [lsearch -exact $idlist $p]
4375 if {$i < 0} continue
4376 set nr [nextuse $p $termrow]
4377 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4378 set idlist [lreplace $idlist $i $i]
4382 set col [lsearch -exact $idlist $id]
4384 set col [idcol $idlist $id]
4385 set idlist [linsert $idlist $col $id]
4386 if {$children($curview,$id) ne {}} {
4387 makeupline $id $rm1 $row $col
4390 set r [expr {$row + $uparrowlen - 1}]
4391 if {$r < $commitidx($curview)} {
4393 foreach p [lindex $parentlist $r] {
4394 if {[lsearch -exact $idlist $p] >= 0} continue
4395 set fk [lindex $children($curview,$p) 0]
4396 if {[rowofcommit $fk] < $row} {
4397 set x [idcol $idlist $p $x]
4398 set idlist [linsert $idlist $x $p]
4401 if {[incr r] < $commitidx($curview)} {
4402 set p [lindex $displayorder $r]
4403 if {[lsearch -exact $idlist $p] < 0} {
4404 set fk [lindex $children($curview,$p) 0]
4405 if {$fk ne {} && [rowofcommit $fk] < $row} {
4406 set x [idcol $idlist $p $x]
4407 set idlist [linsert $idlist $x $p]
4413 if {$final && !$viewcomplete($curview) &&
4414 $row + $uparrowlen + $mingaplen + $downarrowlen
4415 >= $commitidx($curview)} {
4418 set l [llength $rowidlist]
4420 lappend rowidlist $idlist
4422 lappend rowfinal $final
4423 } elseif {$row < $l} {
4424 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4425 lset rowidlist $row $idlist
4428 lset rowfinal $row $final
4430 set pad [ntimes [expr {$row - $l}] {}]
4431 set rowidlist [concat $rowidlist $pad]
4432 lappend rowidlist $idlist
4433 set rowfinal [concat $rowfinal $pad]
4434 lappend rowfinal $final
4435 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4441 proc changedrow {row} {
4442 global displayorder iddrawn rowisopt need_redisplay
4444 set l [llength $rowisopt]
4446 lset rowisopt $row 0
4447 if {$row + 1 < $l} {
4448 lset rowisopt [expr {$row + 1}] 0
4449 if {$row + 2 < $l} {
4450 lset rowisopt [expr {$row + 2}] 0
4454 set id [lindex $displayorder $row]
4455 if {[info exists iddrawn($id)]} {
4456 set need_redisplay 1
4460 proc insert_pad {row col npad} {
4463 set pad [ntimes $npad {}]
4464 set idlist [lindex $rowidlist $row]
4465 set bef [lrange $idlist 0 [expr {$col - 1}]]
4466 set aft [lrange $idlist $col end]
4467 set i [lsearch -exact $aft {}]
4469 set aft [lreplace $aft $i $i]
4471 lset rowidlist $row [concat $bef $pad $aft]
4475 proc optimize_rows {row col endrow} {
4476 global rowidlist rowisopt displayorder curview children
4481 for {} {$row < $endrow} {incr row; set col 0} {
4482 if {[lindex $rowisopt $row]} continue
4484 set y0 [expr {$row - 1}]
4485 set ym [expr {$row - 2}]
4486 set idlist [lindex $rowidlist $row]
4487 set previdlist [lindex $rowidlist $y0]
4488 if {$idlist eq {} || $previdlist eq {}} continue
4490 set pprevidlist [lindex $rowidlist $ym]
4491 if {$pprevidlist eq {}} continue
4497 for {} {$col < [llength $idlist]} {incr col} {
4498 set id [lindex $idlist $col]
4499 if {[lindex $previdlist $col] eq $id} continue
4504 set x0 [lsearch -exact $previdlist $id]
4505 if {$x0 < 0} continue
4506 set z [expr {$x0 - $col}]
4510 set xm [lsearch -exact $pprevidlist $id]
4512 set z0 [expr {$xm - $x0}]
4516 # if row y0 is the first child of $id then it's not an arrow
4517 if {[lindex $children($curview,$id) 0] ne
4518 [lindex $displayorder $y0]} {
4522 if {!$isarrow && $id ne [lindex $displayorder $row] &&
4523 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4526 # Looking at lines from this row to the previous row,
4527 # make them go straight up if they end in an arrow on
4528 # the previous row; otherwise make them go straight up
4530 if {$z < -1 || ($z < 0 && $isarrow)} {
4531 # Line currently goes left too much;
4532 # insert pads in the previous row, then optimize it
4533 set npad [expr {-1 - $z + $isarrow}]
4534 insert_pad $y0 $x0 $npad
4536 optimize_rows $y0 $x0 $row
4538 set previdlist [lindex $rowidlist $y0]
4539 set x0 [lsearch -exact $previdlist $id]
4540 set z [expr {$x0 - $col}]
4542 set pprevidlist [lindex $rowidlist $ym]
4543 set xm [lsearch -exact $pprevidlist $id]
4544 set z0 [expr {$xm - $x0}]
4546 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4547 # Line currently goes right too much;
4548 # insert pads in this line
4549 set npad [expr {$z - 1 + $isarrow}]
4550 insert_pad $row $col $npad
4551 set idlist [lindex $rowidlist $row]
4553 set z [expr {$x0 - $col}]
4556 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4557 # this line links to its first child on row $row-2
4558 set id [lindex $displayorder $ym]
4559 set xc [lsearch -exact $pprevidlist $id]
4561 set z0 [expr {$xc - $x0}]
4564 # avoid lines jigging left then immediately right
4565 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4566 insert_pad $y0 $x0 1
4568 optimize_rows $y0 $x0 $row
4569 set previdlist [lindex $rowidlist $y0]
4573 # Find the first column that doesn't have a line going right
4574 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4575 set id [lindex $idlist $col]
4576 if {$id eq {}} break
4577 set x0 [lsearch -exact $previdlist $id]
4579 # check if this is the link to the first child
4580 set kid [lindex $displayorder $y0]
4581 if {[lindex $children($curview,$id) 0] eq $kid} {
4582 # it is, work out offset to child
4583 set x0 [lsearch -exact $previdlist $kid]
4586 if {$x0 <= $col} break
4588 # Insert a pad at that column as long as it has a line and
4589 # isn't the last column
4590 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4591 set idlist [linsert $idlist $col {}]
4592 lset rowidlist $row $idlist
4600 global canvx0 linespc
4601 return [expr {$canvx0 + $col * $linespc}]
4605 global canvy0 linespc
4606 return [expr {$canvy0 + $row * $linespc}]
4609 proc linewidth {id} {
4610 global thickerline lthickness
4613 if {[info exists thickerline] && $id eq $thickerline} {
4614 set wid [expr {2 * $lthickness}]
4619 proc rowranges {id} {
4620 global curview children uparrowlen downarrowlen
4623 set kids $children($curview,$id)
4629 foreach child $kids {
4630 if {![commitinview $child $curview]} break
4631 set row [rowofcommit $child]
4632 if {![info exists prev]} {
4633 lappend ret [expr {$row + 1}]
4635 if {$row <= $prevrow} {
4636 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4638 # see if the line extends the whole way from prevrow to row
4639 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4640 [lsearch -exact [lindex $rowidlist \
4641 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4642 # it doesn't, see where it ends
4643 set r [expr {$prevrow + $downarrowlen}]
4644 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4645 while {[incr r -1] > $prevrow &&
4646 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4648 while {[incr r] <= $row &&
4649 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4653 # see where it starts up again
4654 set r [expr {$row - $uparrowlen}]
4655 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4656 while {[incr r] < $row &&
4657 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4659 while {[incr r -1] >= $prevrow &&
4660 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4666 if {$child eq $id} {
4675 proc drawlineseg {id row endrow arrowlow} {
4676 global rowidlist displayorder iddrawn linesegs
4677 global canv colormap linespc curview maxlinelen parentlist
4679 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4680 set le [expr {$row + 1}]
4683 set c [lsearch -exact [lindex $rowidlist $le] $id]
4689 set x [lindex $displayorder $le]
4694 if {[info exists iddrawn($x)] || $le == $endrow} {
4695 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4711 if {[info exists linesegs($id)]} {
4712 set lines $linesegs($id)
4714 set r0 [lindex $li 0]
4716 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4726 set li [lindex $lines [expr {$i-1}]]
4727 set r1 [lindex $li 1]
4728 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4733 set x [lindex $cols [expr {$le - $row}]]
4734 set xp [lindex $cols [expr {$le - 1 - $row}]]
4735 set dir [expr {$xp - $x}]
4737 set ith [lindex $lines $i 2]
4738 set coords [$canv coords $ith]
4739 set ah [$canv itemcget $ith -arrow]
4740 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4741 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4742 if {$x2 ne {} && $x - $x2 == $dir} {
4743 set coords [lrange $coords 0 end-2]
4746 set coords [list [xc $le $x] [yc $le]]
4749 set itl [lindex $lines [expr {$i-1}] 2]
4750 set al [$canv itemcget $itl -arrow]
4751 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4752 } elseif {$arrowlow} {
4753 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4754 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4758 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4759 for {set y $le} {[incr y -1] > $row} {} {
4761 set xp [lindex $cols [expr {$y - 1 - $row}]]
4762 set ndir [expr {$xp - $x}]
4763 if {$dir != $ndir || $xp < 0} {
4764 lappend coords [xc $y $x] [yc $y]
4770 # join parent line to first child
4771 set ch [lindex $displayorder $row]
4772 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4774 puts "oops: drawlineseg: child $ch not on row $row"
4775 } elseif {$xc != $x} {
4776 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4777 set d [expr {int(0.5 * $linespc)}]
4780 set x2 [expr {$x1 - $d}]
4782 set x2 [expr {$x1 + $d}]
4785 set y1 [expr {$y2 + $d}]
4786 lappend coords $x1 $y1 $x2 $y2
4787 } elseif {$xc < $x - 1} {
4788 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4789 } elseif {$xc > $x + 1} {
4790 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4794 lappend coords [xc $row $x] [yc $row]
4796 set xn [xc $row $xp]
4798 lappend coords $xn $yn
4802 set t [$canv create line $coords -width [linewidth $id] \
4803 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4806 set lines [linsert $lines $i [list $row $le $t]]
4808 $canv coords $ith $coords
4809 if {$arrow ne $ah} {
4810 $canv itemconf $ith -arrow $arrow
4812 lset lines $i 0 $row
4815 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4816 set ndir [expr {$xo - $xp}]
4817 set clow [$canv coords $itl]
4818 if {$dir == $ndir} {
4819 set clow [lrange $clow 2 end]
4821 set coords [concat $coords $clow]
4823 lset lines [expr {$i-1}] 1 $le
4825 # coalesce two pieces
4827 set b [lindex $lines [expr {$i-1}] 0]
4828 set e [lindex $lines $i 1]
4829 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4831 $canv coords $itl $coords
4832 if {$arrow ne $al} {
4833 $canv itemconf $itl -arrow $arrow
4837 set linesegs($id) $lines
4841 proc drawparentlinks {id row} {
4842 global rowidlist canv colormap curview parentlist
4843 global idpos linespc
4845 set rowids [lindex $rowidlist $row]
4846 set col [lsearch -exact $rowids $id]
4847 if {$col < 0} return
4848 set olds [lindex $parentlist $row]
4849 set row2 [expr {$row + 1}]
4850 set x [xc $row $col]
4853 set d [expr {int(0.5 * $linespc)}]
4854 set ymid [expr {$y + $d}]
4855 set ids [lindex $rowidlist $row2]
4856 # rmx = right-most X coord used
4859 set i [lsearch -exact $ids $p]
4861 puts "oops, parent $p of $id not in list"
4864 set x2 [xc $row2 $i]
4868 set j [lsearch -exact $rowids $p]
4870 # drawlineseg will do this one for us
4874 # should handle duplicated parents here...
4875 set coords [list $x $y]
4877 # if attaching to a vertical segment, draw a smaller
4878 # slant for visual distinctness
4881 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4883 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4885 } elseif {$i < $col && $i < $j} {
4886 # segment slants towards us already
4887 lappend coords [xc $row $j] $y
4889 if {$i < $col - 1} {
4890 lappend coords [expr {$x2 + $linespc}] $y
4891 } elseif {$i > $col + 1} {
4892 lappend coords [expr {$x2 - $linespc}] $y
4894 lappend coords $x2 $y2
4897 lappend coords $x2 $y2
4899 set t [$canv create line $coords -width [linewidth $p] \
4900 -fill $colormap($p) -tags lines.$p]
4904 if {$rmx > [lindex $idpos($id) 1]} {
4905 lset idpos($id) 1 $rmx
4910 proc drawlines {id} {
4913 $canv itemconf lines.$id -width [linewidth $id]
4916 proc drawcmittext {id row col} {
4917 global linespc canv canv2 canv3 fgcolor curview
4918 global cmitlisted commitinfo rowidlist parentlist
4919 global rowtextx idpos idtags idheads idotherrefs
4920 global linehtag linentag linedtag selectedline
4921 global canvxmax boldrows boldnamerows fgcolor
4922 global mainheadid nullid nullid2 circleitem circlecolors
4924 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
4925 set listed $cmitlisted($curview,$id)
4926 if {$id eq $nullid} {
4928 } elseif {$id eq $nullid2} {
4930 } elseif {$id eq $mainheadid} {
4933 set ofill [lindex $circlecolors $listed]
4935 set x [xc $row $col]
4937 set orad [expr {$linespc / 3}]
4939 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4940 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4941 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4942 } elseif {$listed == 3} {
4943 # triangle pointing left for left-side commits
4944 set t [$canv create polygon \
4945 [expr {$x - $orad}] $y \
4946 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4947 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4948 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4950 # triangle pointing right for right-side commits
4951 set t [$canv create polygon \
4952 [expr {$x + $orad - 1}] $y \
4953 [expr {$x - $orad}] [expr {$y - $orad}] \
4954 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4955 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4957 set circleitem($row) $t
4959 $canv bind $t <1> {selcanvline {} %x %y}
4960 set rmx [llength [lindex $rowidlist $row]]
4961 set olds [lindex $parentlist $row]
4963 set nextids [lindex $rowidlist [expr {$row + 1}]]
4965 set i [lsearch -exact $nextids $p]
4971 set xt [xc $row $rmx]
4972 set rowtextx($row) $xt
4973 set idpos($id) [list $x $xt $y]
4974 if {[info exists idtags($id)] || [info exists idheads($id)]
4975 || [info exists idotherrefs($id)]} {
4976 set xt [drawtags $id $x $xt $y]
4978 set headline [lindex $commitinfo($id) 0]
4979 set name [lindex $commitinfo($id) 1]
4980 set date [lindex $commitinfo($id) 2]
4981 set date [formatdate $date]
4984 set isbold [ishighlighted $id]
4986 lappend boldrows $row
4987 set font mainfontbold
4989 lappend boldnamerows $row
4990 set nfont mainfontbold
4993 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4994 -text $headline -font $font -tags text]
4995 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4996 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4997 -text $name -font $nfont -tags text]
4998 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4999 -text $date -font mainfont -tags text]
5000 if {$selectedline == $row} {
5003 set xr [expr {$xt + [font measure $font $headline]}]
5004 if {$xr > $canvxmax} {
5010 proc drawcmitrow {row} {
5011 global displayorder rowidlist nrows_drawn
5012 global iddrawn markingmatches
5013 global commitinfo numcommits
5014 global filehighlight fhighlights findpattern nhighlights
5015 global hlview vhighlights
5016 global highlight_related rhighlights
5018 if {$row >= $numcommits} return
5020 set id [lindex $displayorder $row]
5021 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5022 askvhighlight $row $id
5024 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5025 askfilehighlight $row $id
5027 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5028 askfindhighlight $row $id
5030 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5031 askrelhighlight $row $id
5033 if {![info exists iddrawn($id)]} {
5034 set col [lsearch -exact [lindex $rowidlist $row] $id]
5036 puts "oops, row $row id $id not in list"
5039 if {![info exists commitinfo($id)]} {
5043 drawcmittext $id $row $col
5047 if {$markingmatches} {
5048 markrowmatches $row $id
5052 proc drawcommits {row {endrow {}}} {
5053 global numcommits iddrawn displayorder curview need_redisplay
5054 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5059 if {$endrow eq {}} {
5062 if {$endrow >= $numcommits} {
5063 set endrow [expr {$numcommits - 1}]
5066 set rl1 [expr {$row - $downarrowlen - 3}]
5070 set ro1 [expr {$row - 3}]
5074 set r2 [expr {$endrow + $uparrowlen + 3}]
5075 if {$r2 > $numcommits} {
5078 for {set r $rl1} {$r < $r2} {incr r} {
5079 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5083 set rl1 [expr {$r + 1}]
5089 optimize_rows $ro1 0 $r2
5090 if {$need_redisplay || $nrows_drawn > 2000} {
5095 # make the lines join to already-drawn rows either side
5096 set r [expr {$row - 1}]
5097 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5100 set er [expr {$endrow + 1}]
5101 if {$er >= $numcommits ||
5102 ![info exists iddrawn([lindex $displayorder $er])]} {
5105 for {} {$r <= $er} {incr r} {
5106 set id [lindex $displayorder $r]
5107 set wasdrawn [info exists iddrawn($id)]
5109 if {$r == $er} break
5110 set nextid [lindex $displayorder [expr {$r + 1}]]
5111 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5112 drawparentlinks $id $r
5114 set rowids [lindex $rowidlist $r]
5115 foreach lid $rowids {
5116 if {$lid eq {}} continue
5117 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5119 # see if this is the first child of any of its parents
5120 foreach p [lindex $parentlist $r] {
5121 if {[lsearch -exact $rowids $p] < 0} {
5122 # make this line extend up to the child
5123 set lineend($p) [drawlineseg $p $r $er 0]
5127 set lineend($lid) [drawlineseg $lid $r $er 1]
5133 proc undolayout {row} {
5134 global uparrowlen mingaplen downarrowlen
5135 global rowidlist rowisopt rowfinal need_redisplay
5137 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5141 if {[llength $rowidlist] > $r} {
5143 set rowidlist [lrange $rowidlist 0 $r]
5144 set rowfinal [lrange $rowfinal 0 $r]
5145 set rowisopt [lrange $rowisopt 0 $r]
5146 set need_redisplay 1
5151 proc drawvisible {} {
5152 global canv linespc curview vrowmod selectedline targetrow targetid
5153 global need_redisplay cscroll numcommits
5155 set fs [$canv yview]
5156 set ymax [lindex [$canv cget -scrollregion] 3]
5157 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5158 set f0 [lindex $fs 0]
5159 set f1 [lindex $fs 1]
5160 set y0 [expr {int($f0 * $ymax)}]
5161 set y1 [expr {int($f1 * $ymax)}]
5163 if {[info exists targetid]} {
5164 if {[commitinview $targetid $curview]} {
5165 set r [rowofcommit $targetid]
5166 if {$r != $targetrow} {
5167 # Fix up the scrollregion and change the scrolling position
5168 # now that our target row has moved.
5169 set diff [expr {($r - $targetrow) * $linespc}]
5172 set ymax [lindex [$canv cget -scrollregion] 3]
5175 set f0 [expr {$y0 / $ymax}]
5176 set f1 [expr {$y1 / $ymax}]
5177 allcanvs yview moveto $f0
5178 $cscroll set $f0 $f1
5179 set need_redisplay 1
5186 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5187 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5188 if {$endrow >= $vrowmod($curview)} {
5189 update_arcrows $curview
5191 if {$selectedline ne {} &&
5192 $row <= $selectedline && $selectedline <= $endrow} {
5193 set targetrow $selectedline
5194 } elseif {[info exists targetid]} {
5195 set targetrow [expr {int(($row + $endrow) / 2)}]
5197 if {[info exists targetrow]} {
5198 if {$targetrow >= $numcommits} {
5199 set targetrow [expr {$numcommits - 1}]
5201 set targetid [commitonrow $targetrow]
5203 drawcommits $row $endrow
5206 proc clear_display {} {
5207 global iddrawn linesegs need_redisplay nrows_drawn
5208 global vhighlights fhighlights nhighlights rhighlights
5209 global linehtag linentag linedtag boldrows boldnamerows
5212 catch {unset iddrawn}
5213 catch {unset linesegs}
5214 catch {unset linehtag}
5215 catch {unset linentag}
5216 catch {unset linedtag}
5219 catch {unset vhighlights}
5220 catch {unset fhighlights}
5221 catch {unset nhighlights}
5222 catch {unset rhighlights}
5223 set need_redisplay 0
5227 proc findcrossings {id} {
5228 global rowidlist parentlist numcommits displayorder
5232 foreach {s e} [rowranges $id] {
5233 if {$e >= $numcommits} {
5234 set e [expr {$numcommits - 1}]
5236 if {$e <= $s} continue
5237 for {set row $e} {[incr row -1] >= $s} {} {
5238 set x [lsearch -exact [lindex $rowidlist $row] $id]
5240 set olds [lindex $parentlist $row]
5241 set kid [lindex $displayorder $row]
5242 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5243 if {$kidx < 0} continue
5244 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5246 set px [lsearch -exact $nextrow $p]
5247 if {$px < 0} continue
5248 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5249 if {[lsearch -exact $ccross $p] >= 0} continue
5250 if {$x == $px + ($kidx < $px? -1: 1)} {
5252 } elseif {[lsearch -exact $cross $p] < 0} {
5259 return [concat $ccross {{}} $cross]
5262 proc assigncolor {id} {
5263 global colormap colors nextcolor
5264 global parents children children curview
5266 if {[info exists colormap($id)]} return
5267 set ncolors [llength $colors]
5268 if {[info exists children($curview,$id)]} {
5269 set kids $children($curview,$id)
5273 if {[llength $kids] == 1} {
5274 set child [lindex $kids 0]
5275 if {[info exists colormap($child)]
5276 && [llength $parents($curview,$child)] == 1} {
5277 set colormap($id) $colormap($child)
5283 foreach x [findcrossings $id] {
5285 # delimiter between corner crossings and other crossings
5286 if {[llength $badcolors] >= $ncolors - 1} break
5287 set origbad $badcolors
5289 if {[info exists colormap($x)]
5290 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5291 lappend badcolors $colormap($x)
5294 if {[llength $badcolors] >= $ncolors} {
5295 set badcolors $origbad
5297 set origbad $badcolors
5298 if {[llength $badcolors] < $ncolors - 1} {
5299 foreach child $kids {
5300 if {[info exists colormap($child)]
5301 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5302 lappend badcolors $colormap($child)
5304 foreach p $parents($curview,$child) {
5305 if {[info exists colormap($p)]
5306 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5307 lappend badcolors $colormap($p)
5311 if {[llength $badcolors] >= $ncolors} {
5312 set badcolors $origbad
5315 for {set i 0} {$i <= $ncolors} {incr i} {
5316 set c [lindex $colors $nextcolor]
5317 if {[incr nextcolor] >= $ncolors} {
5320 if {[lsearch -exact $badcolors $c]} break
5322 set colormap($id) $c
5325 proc bindline {t id} {
5328 $canv bind $t <Enter> "lineenter %x %y $id"
5329 $canv bind $t <Motion> "linemotion %x %y $id"
5330 $canv bind $t <Leave> "lineleave $id"
5331 $canv bind $t <Button-1> "lineclick %x %y $id 1"
5334 proc drawtags {id x xt y1} {
5335 global idtags idheads idotherrefs mainhead
5336 global linespc lthickness
5337 global canv rowtextx curview fgcolor bgcolor
5342 if {[info exists idtags($id)]} {
5343 set marks $idtags($id)
5344 set ntags [llength $marks]
5346 if {[info exists idheads($id)]} {
5347 set marks [concat $marks $idheads($id)]
5348 set nheads [llength $idheads($id)]
5350 if {[info exists idotherrefs($id)]} {
5351 set marks [concat $marks $idotherrefs($id)]
5357 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5358 set yt [expr {$y1 - 0.5 * $linespc}]
5359 set yb [expr {$yt + $linespc - 1}]
5363 foreach tag $marks {
5365 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5366 set wid [font measure mainfontbold $tag]
5368 set wid [font measure mainfont $tag]
5372 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5374 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5375 -width $lthickness -fill black -tags tag.$id]
5377 foreach tag $marks x $xvals wid $wvals {
5378 set xl [expr {$x + $delta}]
5379 set xr [expr {$x + $delta + $wid + $lthickness}]
5381 if {[incr ntags -1] >= 0} {
5383 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5384 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5385 -width 1 -outline black -fill yellow -tags tag.$id]
5386 $canv bind $t <1> [list showtag $tag 1]
5387 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5389 # draw a head or other ref
5390 if {[incr nheads -1] >= 0} {
5392 if {$tag eq $mainhead} {
5393 set font mainfontbold
5398 set xl [expr {$xl - $delta/2}]
5399 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5400 -width 1 -outline black -fill $col -tags tag.$id
5401 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5402 set rwid [font measure mainfont $remoteprefix]
5403 set xi [expr {$x + 1}]
5404 set yti [expr {$yt + 1}]
5405 set xri [expr {$x + $rwid}]
5406 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5407 -width 0 -fill "#ffddaa" -tags tag.$id
5410 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5411 -font $font -tags [list tag.$id text]]
5413 $canv bind $t <1> [list showtag $tag 1]
5414 } elseif {$nheads >= 0} {
5415 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
5421 proc xcoord {i level ln} {
5422 global canvx0 xspc1 xspc2
5424 set x [expr {$canvx0 + $i * $xspc1($ln)}]
5425 if {$i > 0 && $i == $level} {
5426 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5427 } elseif {$i > $level} {
5428 set x [expr {$x + $xspc2 - $xspc1($ln)}]
5433 proc show_status {msg} {
5437 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5438 -tags text -fill $fgcolor
5441 # Don't change the text pane cursor if it is currently the hand cursor,
5442 # showing that we are over a sha1 ID link.
5443 proc settextcursor {c} {
5444 global ctext curtextcursor
5446 if {[$ctext cget -cursor] == $curtextcursor} {
5447 $ctext config -cursor $c
5449 set curtextcursor $c
5452 proc nowbusy {what {name {}}} {
5453 global isbusy busyname statusw
5455 if {[array names isbusy] eq {}} {
5456 . config -cursor watch
5460 set busyname($what) $name
5462 $statusw conf -text $name
5466 proc notbusy {what} {
5467 global isbusy maincursor textcursor busyname statusw
5471 if {$busyname($what) ne {} &&
5472 [$statusw cget -text] eq $busyname($what)} {
5473 $statusw conf -text {}
5476 if {[array names isbusy] eq {}} {
5477 . config -cursor $maincursor
5478 settextcursor $textcursor
5482 proc findmatches {f} {
5483 global findtype findstring
5484 if {$findtype == [mc "Regexp"]} {
5485 set matches [regexp -indices -all -inline $findstring $f]
5488 if {$findtype == [mc "IgnCase"]} {
5489 set f [string tolower $f]
5490 set fs [string tolower $fs]
5494 set l [string length $fs]
5495 while {[set j [string first $fs $f $i]] >= 0} {
5496 lappend matches [list $j [expr {$j+$l-1}]]
5497 set i [expr {$j + $l}]
5503 proc dofind {{dirn 1} {wrap 1}} {
5504 global findstring findstartline findcurline selectedline numcommits
5505 global gdttype filehighlight fh_serial find_dirn findallowwrap
5507 if {[info exists find_dirn]} {
5508 if {$find_dirn == $dirn} return
5512 if {$findstring eq {} || $numcommits == 0} return
5513 if {$selectedline eq {}} {
5514 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5516 set findstartline $selectedline
5518 set findcurline $findstartline
5519 nowbusy finding [mc "Searching"]
5520 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5521 after cancel do_file_hl $fh_serial
5522 do_file_hl $fh_serial
5525 set findallowwrap $wrap
5529 proc stopfinding {} {
5530 global find_dirn findcurline fprogcoord
5532 if {[info exists find_dirn]} {
5542 global commitdata commitinfo numcommits findpattern findloc
5543 global findstartline findcurline findallowwrap
5544 global find_dirn gdttype fhighlights fprogcoord
5545 global curview varcorder vrownum varccommits vrowmod
5547 if {![info exists find_dirn]} {
5550 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5553 if {$find_dirn > 0} {
5555 if {$l >= $numcommits} {
5558 if {$l <= $findstartline} {
5559 set lim [expr {$findstartline + 1}]
5562 set moretodo $findallowwrap
5569 if {$l >= $findstartline} {
5570 set lim [expr {$findstartline - 1}]
5573 set moretodo $findallowwrap
5576 set n [expr {($lim - $l) * $find_dirn}]
5581 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5582 update_arcrows $curview
5586 set ai [bsearch $vrownum($curview) $l]
5587 set a [lindex $varcorder($curview) $ai]
5588 set arow [lindex $vrownum($curview) $ai]
5589 set ids [lindex $varccommits($curview,$a)]
5590 set arowend [expr {$arow + [llength $ids]}]
5591 if {$gdttype eq [mc "containing:"]} {
5592 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5593 if {$l < $arow || $l >= $arowend} {
5595 set a [lindex $varcorder($curview) $ai]
5596 set arow [lindex $vrownum($curview) $ai]
5597 set ids [lindex $varccommits($curview,$a)]
5598 set arowend [expr {$arow + [llength $ids]}]
5600 set id [lindex $ids [expr {$l - $arow}]]
5601 # shouldn't happen unless git log doesn't give all the commits...
5602 if {![info exists commitdata($id)] ||
5603 ![doesmatch $commitdata($id)]} {
5606 if {![info exists commitinfo($id)]} {
5609 set info $commitinfo($id)
5610 foreach f $info ty $fldtypes {
5611 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5620 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5621 if {$l < $arow || $l >= $arowend} {
5623 set a [lindex $varcorder($curview) $ai]
5624 set arow [lindex $vrownum($curview) $ai]
5625 set ids [lindex $varccommits($curview,$a)]
5626 set arowend [expr {$arow + [llength $ids]}]
5628 set id [lindex $ids [expr {$l - $arow}]]
5629 if {![info exists fhighlights($id)]} {
5630 # this sets fhighlights($id) to -1
5631 askfilehighlight $l $id
5633 if {$fhighlights($id) > 0} {
5637 if {$fhighlights($id) < 0} {
5640 set findcurline [expr {$l - $find_dirn}]
5645 if {$found || ($domore && !$moretodo)} {
5661 set findcurline [expr {$l - $find_dirn}]
5663 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5667 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5672 proc findselectline {l} {
5673 global findloc commentend ctext findcurline markingmatches gdttype
5675 set markingmatches 1
5678 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5679 # highlight the matches in the comments
5680 set f [$ctext get 1.0 $commentend]
5681 set matches [findmatches $f]
5682 foreach match $matches {
5683 set start [lindex $match 0]
5684 set end [expr {[lindex $match 1] + 1}]
5685 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5691 # mark the bits of a headline or author that match a find string
5692 proc markmatches {canv l str tag matches font row} {
5695 set bbox [$canv bbox $tag]
5696 set x0 [lindex $bbox 0]
5697 set y0 [lindex $bbox 1]
5698 set y1 [lindex $bbox 3]
5699 foreach match $matches {
5700 set start [lindex $match 0]
5701 set end [lindex $match 1]
5702 if {$start > $end} continue
5703 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5704 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5705 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5706 [expr {$x0+$xlen+2}] $y1 \
5707 -outline {} -tags [list match$l matches] -fill yellow]
5709 if {$row == $selectedline} {
5710 $canv raise $t secsel
5715 proc unmarkmatches {} {
5716 global markingmatches
5718 allcanvs delete matches
5719 set markingmatches 0
5723 proc selcanvline {w x y} {
5724 global canv canvy0 ctext linespc
5726 set ymax [lindex [$canv cget -scrollregion] 3]
5727 if {$ymax == {}} return
5728 set yfrac [lindex [$canv yview] 0]
5729 set y [expr {$y + $yfrac * $ymax}]
5730 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5735 set xmax [lindex [$canv cget -scrollregion] 2]
5736 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5737 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5743 proc commit_descriptor {p} {
5745 if {![info exists commitinfo($p)]} {
5749 if {[llength $commitinfo($p)] > 1} {
5750 set l [lindex $commitinfo($p) 0]
5755 # append some text to the ctext widget, and make any SHA1 ID
5756 # that we know about be a clickable link.
5757 proc appendwithlinks {text tags} {
5758 global ctext linknum curview pendinglinks
5760 set start [$ctext index "end - 1c"]
5761 $ctext insert end $text $tags
5762 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5766 set linkid [string range $text $s $e]
5768 $ctext tag delete link$linknum
5769 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5770 setlink $linkid link$linknum
5775 proc setlink {id lk} {
5776 global curview ctext pendinglinks commitinterest
5778 if {[commitinview $id $curview]} {
5779 $ctext tag conf $lk -foreground blue -underline 1
5780 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5781 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5782 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5784 lappend pendinglinks($id) $lk
5785 lappend commitinterest($id) {makelink %I}
5789 proc makelink {id} {
5792 if {![info exists pendinglinks($id)]} return
5793 foreach lk $pendinglinks($id) {
5796 unset pendinglinks($id)
5799 proc linkcursor {w inc} {
5800 global linkentercount curtextcursor
5802 if {[incr linkentercount $inc] > 0} {
5803 $w configure -cursor hand2
5805 $w configure -cursor $curtextcursor
5806 if {$linkentercount < 0} {
5807 set linkentercount 0
5812 proc viewnextline {dir} {
5816 set ymax [lindex [$canv cget -scrollregion] 3]
5817 set wnow [$canv yview]
5818 set wtop [expr {[lindex $wnow 0] * $ymax}]
5819 set newtop [expr {$wtop + $dir * $linespc}]
5822 } elseif {$newtop > $ymax} {
5825 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5828 # add a list of tag or branch names at position pos
5829 # returns the number of names inserted
5830 proc appendrefs {pos ids var} {
5831 global ctext linknum curview $var maxrefs
5833 if {[catch {$ctext index $pos}]} {
5836 $ctext conf -state normal
5837 $ctext delete $pos "$pos lineend"
5840 foreach tag [set $var\($id\)] {
5841 lappend tags [list $tag $id]
5844 if {[llength $tags] > $maxrefs} {
5845 $ctext insert $pos "many ([llength $tags])"
5847 set tags [lsort -index 0 -decreasing $tags]
5850 set id [lindex $ti 1]
5853 $ctext tag delete $lk
5854 $ctext insert $pos $sep
5855 $ctext insert $pos [lindex $ti 0] $lk
5860 $ctext conf -state disabled
5861 return [llength $tags]
5864 # called when we have finished computing the nearby tags
5865 proc dispneartags {delay} {
5866 global selectedline currentid showneartags tagphase
5868 if {$selectedline eq {} || !$showneartags} return
5869 after cancel dispnexttag
5871 after 200 dispnexttag
5874 after idle dispnexttag
5879 proc dispnexttag {} {
5880 global selectedline currentid showneartags tagphase ctext
5882 if {$selectedline eq {} || !$showneartags} return
5883 switch -- $tagphase {
5885 set dtags [desctags $currentid]
5887 appendrefs precedes $dtags idtags
5891 set atags [anctags $currentid]
5893 appendrefs follows $atags idtags
5897 set dheads [descheads $currentid]
5898 if {$dheads ne {}} {
5899 if {[appendrefs branch $dheads idheads] > 1
5900 && [$ctext get "branch -3c"] eq "h"} {
5901 # turn "Branch" into "Branches"
5902 $ctext conf -state normal
5903 $ctext insert "branch -2c" "es"
5904 $ctext conf -state disabled
5909 if {[incr tagphase] <= 2} {
5910 after idle dispnexttag
5914 proc make_secsel {l} {
5915 global linehtag linentag linedtag canv canv2 canv3
5917 if {![info exists linehtag($l)]} return
5919 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5920 -tags secsel -fill [$canv cget -selectbackground]]
5922 $canv2 delete secsel
5923 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5924 -tags secsel -fill [$canv2 cget -selectbackground]]
5926 $canv3 delete secsel
5927 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5928 -tags secsel -fill [$canv3 cget -selectbackground]]
5932 proc selectline {l isnew} {
5933 global canv ctext commitinfo selectedline
5934 global canvy0 linespc parents children curview
5935 global currentid sha1entry
5936 global commentend idtags linknum
5937 global mergemax numcommits pending_select
5938 global cmitmode showneartags allcommits
5939 global targetrow targetid lastscrollrows
5942 catch {unset pending_select}
5947 if {$l < 0 || $l >= $numcommits} return
5948 set id [commitonrow $l]
5953 if {$lastscrollrows < $numcommits} {
5957 set y [expr {$canvy0 + $l * $linespc}]
5958 set ymax [lindex [$canv cget -scrollregion] 3]
5959 set ytop [expr {$y - $linespc - 1}]
5960 set ybot [expr {$y + $linespc + 1}]
5961 set wnow [$canv yview]
5962 set wtop [expr {[lindex $wnow 0] * $ymax}]
5963 set wbot [expr {[lindex $wnow 1] * $ymax}]
5964 set wh [expr {$wbot - $wtop}]
5966 if {$ytop < $wtop} {
5967 if {$ybot < $wtop} {
5968 set newtop [expr {$y - $wh / 2.0}]
5971 if {$newtop > $wtop - $linespc} {
5972 set newtop [expr {$wtop - $linespc}]
5975 } elseif {$ybot > $wbot} {
5976 if {$ytop > $wbot} {
5977 set newtop [expr {$y - $wh / 2.0}]
5979 set newtop [expr {$ybot - $wh}]
5980 if {$newtop < $wtop + $linespc} {
5981 set newtop [expr {$wtop + $linespc}]
5985 if {$newtop != $wtop} {
5989 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5996 addtohistory [list selbyid $id]
5999 $sha1entry delete 0 end
6000 $sha1entry insert 0 $id
6002 $sha1entry selection from 0
6003 $sha1entry selection to end
6007 $ctext conf -state normal
6010 if {![info exists commitinfo($id)]} {
6013 set info $commitinfo($id)
6014 set date [formatdate [lindex $info 2]]
6015 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6016 set date [formatdate [lindex $info 4]]
6017 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6018 if {[info exists idtags($id)]} {
6019 $ctext insert end [mc "Tags:"]
6020 foreach tag $idtags($id) {
6021 $ctext insert end " $tag"
6023 $ctext insert end "\n"
6027 set olds $parents($curview,$id)
6028 if {[llength $olds] > 1} {
6031 if {$np >= $mergemax} {
6036 $ctext insert end "[mc "Parent"]: " $tag
6037 appendwithlinks [commit_descriptor $p] {}
6042 append headers "[mc "Parent"]: [commit_descriptor $p]"
6046 foreach c $children($curview,$id) {
6047 append headers "[mc "Child"]: [commit_descriptor $c]"
6050 # make anything that looks like a SHA1 ID be a clickable link
6051 appendwithlinks $headers {}
6052 if {$showneartags} {
6053 if {![info exists allcommits]} {
6056 $ctext insert end "[mc "Branch"]: "
6057 $ctext mark set branch "end -1c"
6058 $ctext mark gravity branch left
6059 $ctext insert end "\n[mc "Follows"]: "
6060 $ctext mark set follows "end -1c"
6061 $ctext mark gravity follows left
6062 $ctext insert end "\n[mc "Precedes"]: "
6063 $ctext mark set precedes "end -1c"
6064 $ctext mark gravity precedes left
6065 $ctext insert end "\n"
6068 $ctext insert end "\n"
6069 set comment [lindex $info 5]
6070 if {[string first "\r" $comment] >= 0} {
6071 set comment [string map {"\r" "\n "} $comment]
6073 appendwithlinks $comment {comment}
6075 $ctext tag remove found 1.0 end
6076 $ctext conf -state disabled
6077 set commentend [$ctext index "end - 1c"]
6079 init_flist [mc "Comments"]
6080 if {$cmitmode eq "tree"} {
6082 } elseif {[llength $olds] <= 1} {
6089 proc selfirstline {} {
6094 proc sellastline {} {
6097 set l [expr {$numcommits - 1}]
6101 proc selnextline {dir} {
6104 if {$selectedline eq {}} return
6105 set l [expr {$selectedline + $dir}]
6110 proc selnextpage {dir} {
6111 global canv linespc selectedline numcommits
6113 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6117 allcanvs yview scroll [expr {$dir * $lpp}] units
6119 if {$selectedline eq {}} return
6120 set l [expr {$selectedline + $dir * $lpp}]
6123 } elseif {$l >= $numcommits} {
6124 set l [expr $numcommits - 1]
6130 proc unselectline {} {
6131 global selectedline currentid
6134 catch {unset currentid}
6135 allcanvs delete secsel
6139 proc reselectline {} {
6142 if {$selectedline ne {}} {
6143 selectline $selectedline 0
6147 proc addtohistory {cmd} {
6148 global history historyindex curview
6150 set elt [list $curview $cmd]
6151 if {$historyindex > 0
6152 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6156 if {$historyindex < [llength $history]} {
6157 set history [lreplace $history $historyindex end $elt]
6159 lappend history $elt
6162 if {$historyindex > 1} {
6163 .tf.bar.leftbut conf -state normal
6165 .tf.bar.leftbut conf -state disabled
6167 .tf.bar.rightbut conf -state disabled
6173 set view [lindex $elt 0]
6174 set cmd [lindex $elt 1]
6175 if {$curview != $view} {
6182 global history historyindex
6185 if {$historyindex > 1} {
6186 incr historyindex -1
6187 godo [lindex $history [expr {$historyindex - 1}]]
6188 .tf.bar.rightbut conf -state normal
6190 if {$historyindex <= 1} {
6191 .tf.bar.leftbut conf -state disabled
6196 global history historyindex
6199 if {$historyindex < [llength $history]} {
6200 set cmd [lindex $history $historyindex]
6203 .tf.bar.leftbut conf -state normal
6205 if {$historyindex >= [llength $history]} {
6206 .tf.bar.rightbut conf -state disabled
6211 global treefilelist treeidlist diffids diffmergeid treepending
6212 global nullid nullid2
6215 catch {unset diffmergeid}
6216 if {![info exists treefilelist($id)]} {
6217 if {![info exists treepending]} {
6218 if {$id eq $nullid} {
6219 set cmd [list | git ls-files]
6220 } elseif {$id eq $nullid2} {
6221 set cmd [list | git ls-files --stage -t]
6223 set cmd [list | git ls-tree -r $id]
6225 if {[catch {set gtf [open $cmd r]}]} {
6229 set treefilelist($id) {}
6230 set treeidlist($id) {}
6231 fconfigure $gtf -blocking 0
6232 filerun $gtf [list gettreeline $gtf $id]
6239 proc gettreeline {gtf id} {
6240 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6243 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6244 if {$diffids eq $nullid} {
6247 set i [string first "\t" $line]
6248 if {$i < 0} continue
6249 set fname [string range $line [expr {$i+1}] end]
6250 set line [string range $line 0 [expr {$i-1}]]
6251 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6252 set sha1 [lindex $line 2]
6253 if {[string index $fname 0] eq "\""} {
6254 set fname [lindex $fname 0]
6256 lappend treeidlist($id) $sha1
6258 lappend treefilelist($id) $fname
6261 return [expr {$nl >= 1000? 2: 1}]
6265 if {$cmitmode ne "tree"} {
6266 if {![info exists diffmergeid]} {
6267 gettreediffs $diffids
6269 } elseif {$id ne $diffids} {
6278 global treefilelist treeidlist diffids nullid nullid2
6279 global ctext commentend
6281 set i [lsearch -exact $treefilelist($diffids) $f]
6283 puts "oops, $f not in list for id $diffids"
6286 if {$diffids eq $nullid} {
6287 if {[catch {set bf [open $f r]} err]} {
6288 puts "oops, can't read $f: $err"
6292 set blob [lindex $treeidlist($diffids) $i]
6293 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6294 puts "oops, error reading blob $blob: $err"
6298 fconfigure $bf -blocking 0
6299 filerun $bf [list getblobline $bf $diffids]
6300 $ctext config -state normal
6301 clear_ctext $commentend
6302 $ctext insert end "\n"
6303 $ctext insert end "$f\n" filesep
6304 $ctext config -state disabled
6305 $ctext yview $commentend
6309 proc getblobline {bf id} {
6310 global diffids cmitmode ctext
6312 if {$id ne $diffids || $cmitmode ne "tree"} {
6316 $ctext config -state normal
6318 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6319 $ctext insert end "$line\n"
6322 # delete last newline
6323 $ctext delete "end - 2c" "end - 1c"
6327 $ctext config -state disabled
6328 return [expr {$nl >= 1000? 2: 1}]
6331 proc mergediff {id} {
6332 global diffmergeid mdifffd
6336 global limitdiffs vfilelimit curview
6340 # this doesn't seem to actually affect anything...
6341 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
6342 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6343 set cmd [concat $cmd -- $vfilelimit($curview)]
6345 if {[catch {set mdf [open $cmd r]} err]} {
6346 error_popup "[mc "Error getting merge diffs:"] $err"
6349 fconfigure $mdf -blocking 0
6350 set mdifffd($id) $mdf
6351 set np [llength $parents($curview,$id)]
6353 filerun $mdf [list getmergediffline $mdf $id $np]
6356 proc getmergediffline {mdf id np} {
6357 global diffmergeid ctext cflist mergemax
6358 global difffilestart mdifffd
6360 $ctext conf -state normal
6362 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
6363 if {![info exists diffmergeid] || $id != $diffmergeid
6364 || $mdf != $mdifffd($id)} {
6368 if {[regexp {^diff --cc (.*)} $line match fname]} {
6369 # start of a new file
6370 $ctext insert end "\n"
6371 set here [$ctext index "end - 1c"]
6372 lappend difffilestart $here
6373 add_flist [list $fname]
6374 set l [expr {(78 - [string length $fname]) / 2}]
6375 set pad [string range "----------------------------------------" 1 $l]
6376 $ctext insert end "$pad $fname $pad\n" filesep
6377 } elseif {[regexp {^@@} $line]} {
6378 $ctext insert end "$line\n" hunksep
6379 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
6382 # parse the prefix - one ' ', '-' or '+' for each parent
6387 for {set j 0} {$j < $np} {incr j} {
6388 set c [string range $line $j $j]
6391 } elseif {$c == "-"} {
6393 } elseif {$c == "+"} {
6402 if {!$isbad && $minuses ne {} && $pluses eq {}} {
6403 # line doesn't appear in result, parents in $minuses have the line
6404 set num [lindex $minuses 0]
6405 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
6406 # line appears in result, parents in $pluses don't have the line
6407 lappend tags mresult
6408 set num [lindex $spaces 0]
6411 if {$num >= $mergemax} {
6416 $ctext insert end "$line\n" $tags
6419 $ctext conf -state disabled
6424 return [expr {$nr >= 1000? 2: 1}]
6427 proc startdiff {ids} {
6428 global treediffs diffids treepending diffmergeid nullid nullid2
6432 catch {unset diffmergeid}
6433 if {![info exists treediffs($ids)] ||
6434 [lsearch -exact $ids $nullid] >= 0 ||
6435 [lsearch -exact $ids $nullid2] >= 0} {
6436 if {![info exists treepending]} {
6444 proc path_filter {filter name} {
6446 set l [string length $p]
6447 if {[string index $p end] eq "/"} {
6448 if {[string compare -length $l $p $name] == 0} {
6452 if {[string compare -length $l $p $name] == 0 &&
6453 ([string length $name] == $l ||
6454 [string index $name $l] eq "/")} {
6462 proc addtocflist {ids} {
6465 add_flist $treediffs($ids)
6469 proc diffcmd {ids flags} {
6470 global nullid nullid2
6472 set i [lsearch -exact $ids $nullid]
6473 set j [lsearch -exact $ids $nullid2]
6475 if {[llength $ids] > 1 && $j < 0} {
6476 # comparing working directory with some specific revision
6477 set cmd [concat | git diff-index $flags]
6479 lappend cmd -R [lindex $ids 1]
6481 lappend cmd [lindex $ids 0]
6484 # comparing working directory with index
6485 set cmd [concat | git diff-files $flags]
6490 } elseif {$j >= 0} {
6491 set cmd [concat | git diff-index --cached $flags]
6492 if {[llength $ids] > 1} {
6493 # comparing index with specific revision
6495 lappend cmd -R [lindex $ids 1]
6497 lappend cmd [lindex $ids 0]
6500 # comparing index with HEAD
6504 set cmd [concat | git diff-tree -r $flags $ids]
6509 proc gettreediffs {ids} {
6510 global treediff treepending
6512 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6514 set treepending $ids
6516 fconfigure $gdtf -blocking 0
6517 filerun $gdtf [list gettreediffline $gdtf $ids]
6520 proc gettreediffline {gdtf ids} {
6521 global treediff treediffs treepending diffids diffmergeid
6522 global cmitmode vfilelimit curview limitdiffs
6525 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6526 set i [string first "\t" $line]
6528 set file [string range $line [expr {$i+1}] end]
6529 if {[string index $file 0] eq "\""} {
6530 set file [lindex $file 0]
6532 lappend treediff $file
6536 return [expr {$nr >= 1000? 2: 1}]
6539 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6541 foreach f $treediff {
6542 if {[path_filter $vfilelimit($curview) $f]} {
6546 set treediffs($ids) $flist
6548 set treediffs($ids) $treediff
6551 if {$cmitmode eq "tree"} {
6553 } elseif {$ids != $diffids} {
6554 if {![info exists diffmergeid]} {
6555 gettreediffs $diffids
6563 # empty string or positive integer
6564 proc diffcontextvalidate {v} {
6565 return [regexp {^(|[1-9][0-9]*)$} $v]
6568 proc diffcontextchange {n1 n2 op} {
6569 global diffcontextstring diffcontext
6571 if {[string is integer -strict $diffcontextstring]} {
6572 if {$diffcontextstring > 0} {
6573 set diffcontext $diffcontextstring
6579 proc changeignorespace {} {
6583 proc getblobdiffs {ids} {
6584 global blobdifffd diffids env
6585 global diffinhdr treediffs
6588 global limitdiffs vfilelimit curview
6590 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6594 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6595 set cmd [concat $cmd -- $vfilelimit($curview)]
6597 if {[catch {set bdf [open $cmd r]} err]} {
6598 puts "error getting diffs: $err"
6602 fconfigure $bdf -blocking 0
6603 set blobdifffd($ids) $bdf
6604 filerun $bdf [list getblobdiffline $bdf $diffids]
6607 proc setinlist {var i val} {
6610 while {[llength [set $var]] < $i} {
6613 if {[llength [set $var]] == $i} {
6620 proc makediffhdr {fname ids} {
6621 global ctext curdiffstart treediffs
6623 set i [lsearch -exact $treediffs($ids) $fname]
6625 setinlist difffilestart $i $curdiffstart
6627 set l [expr {(78 - [string length $fname]) / 2}]
6628 set pad [string range "----------------------------------------" 1 $l]
6629 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6632 proc getblobdiffline {bdf ids} {
6633 global diffids blobdifffd ctext curdiffstart
6634 global diffnexthead diffnextnote difffilestart
6635 global diffinhdr treediffs
6638 $ctext conf -state normal
6639 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6640 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6644 if {![string compare -length 11 "diff --git " $line]} {
6645 # trim off "diff --git "
6646 set line [string range $line 11 end]
6648 # start of a new file
6649 $ctext insert end "\n"
6650 set curdiffstart [$ctext index "end - 1c"]
6651 $ctext insert end "\n" filesep
6652 # If the name hasn't changed the length will be odd,
6653 # the middle char will be a space, and the two bits either
6654 # side will be a/name and b/name, or "a/name" and "b/name".
6655 # If the name has changed we'll get "rename from" and
6656 # "rename to" or "copy from" and "copy to" lines following this,
6657 # and we'll use them to get the filenames.
6658 # This complexity is necessary because spaces in the filename(s)
6659 # don't get escaped.
6660 set l [string length $line]
6661 set i [expr {$l / 2}]
6662 if {!(($l & 1) && [string index $line $i] eq " " &&
6663 [string range $line 2 [expr {$i - 1}]] eq \
6664 [string range $line [expr {$i + 3}] end])} {
6667 # unescape if quoted and chop off the a/ from the front
6668 if {[string index $line 0] eq "\""} {
6669 set fname [string range [lindex $line 0] 2 end]
6671 set fname [string range $line 2 [expr {$i - 1}]]
6673 makediffhdr $fname $ids
6675 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6676 $line match f1l f1c f2l f2c rest]} {
6677 $ctext insert end "$line\n" hunksep
6680 } elseif {$diffinhdr} {
6681 if {![string compare -length 12 "rename from " $line]} {
6682 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6683 if {[string index $fname 0] eq "\""} {
6684 set fname [lindex $fname 0]
6686 set i [lsearch -exact $treediffs($ids) $fname]
6688 setinlist difffilestart $i $curdiffstart
6690 } elseif {![string compare -length 10 $line "rename to "] ||
6691 ![string compare -length 8 $line "copy to "]} {
6692 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6693 if {[string index $fname 0] eq "\""} {
6694 set fname [lindex $fname 0]
6696 makediffhdr $fname $ids
6697 } elseif {[string compare -length 3 $line "---"] == 0} {
6700 } elseif {[string compare -length 3 $line "+++"] == 0} {
6704 $ctext insert end "$line\n" filesep
6707 set x [string range $line 0 0]
6708 if {$x == "-" || $x == "+"} {
6709 set tag [expr {$x == "+"}]
6710 $ctext insert end "$line\n" d$tag
6711 } elseif {$x == " "} {
6712 $ctext insert end "$line\n"
6714 # "\ No newline at end of file",
6715 # or something else we don't recognize
6716 $ctext insert end "$line\n" hunksep
6720 $ctext conf -state disabled
6725 return [expr {$nr >= 1000? 2: 1}]
6728 proc changediffdisp {} {
6729 global ctext diffelide
6731 $ctext tag conf d0 -elide [lindex $diffelide 0]
6732 $ctext tag conf d1 -elide [lindex $diffelide 1]
6735 proc highlightfile {loc cline} {
6736 global ctext cflist cflist_top
6739 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
6740 $cflist tag add highlight $cline.0 "$cline.0 lineend"
6741 $cflist see $cline.0
6742 set cflist_top $cline
6746 global difffilestart ctext cmitmode
6748 if {$cmitmode eq "tree"} return
6751 set here [$ctext index @0,0]
6752 foreach loc $difffilestart {
6753 if {[$ctext compare $loc >= $here]} {
6754 highlightfile $prev $prevline
6760 highlightfile $prev $prevline
6764 global difffilestart ctext cmitmode
6766 if {$cmitmode eq "tree"} return
6767 set here [$ctext index @0,0]
6769 foreach loc $difffilestart {
6771 if {[$ctext compare $loc > $here]} {
6772 highlightfile $loc $line
6778 proc clear_ctext {{first 1.0}} {
6779 global ctext smarktop smarkbot
6782 set l [lindex [split $first .] 0]
6783 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6786 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6789 $ctext delete $first end
6790 if {$first eq "1.0"} {
6791 catch {unset pendinglinks}
6795 proc settabs {{firstab {}}} {
6796 global firsttabstop tabstop ctext have_tk85
6798 if {$firstab ne {} && $have_tk85} {
6799 set firsttabstop $firstab
6801 set w [font measure textfont "0"]
6802 if {$firsttabstop != 0} {
6803 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6804 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6805 } elseif {$have_tk85 || $tabstop != 8} {
6806 $ctext conf -tabs [expr {$tabstop * $w}]
6808 $ctext conf -tabs {}
6812 proc incrsearch {name ix op} {
6813 global ctext searchstring searchdirn
6815 $ctext tag remove found 1.0 end
6816 if {[catch {$ctext index anchor}]} {
6817 # no anchor set, use start of selection, or of visible area
6818 set sel [$ctext tag ranges sel]
6820 $ctext mark set anchor [lindex $sel 0]
6821 } elseif {$searchdirn eq "-forwards"} {
6822 $ctext mark set anchor @0,0
6824 $ctext mark set anchor @0,[winfo height $ctext]
6827 if {$searchstring ne {}} {
6828 set here [$ctext search $searchdirn -- $searchstring anchor]
6837 global sstring ctext searchstring searchdirn
6840 $sstring icursor end
6841 set searchdirn -forwards
6842 if {$searchstring ne {}} {
6843 set sel [$ctext tag ranges sel]
6845 set start "[lindex $sel 0] + 1c"
6846 } elseif {[catch {set start [$ctext index anchor]}]} {
6849 set match [$ctext search -count mlen -- $searchstring $start]
6850 $ctext tag remove sel 1.0 end
6856 set mend "$match + $mlen c"
6857 $ctext tag add sel $match $mend
6858 $ctext mark unset anchor
6862 proc dosearchback {} {
6863 global sstring ctext searchstring searchdirn
6866 $sstring icursor end
6867 set searchdirn -backwards
6868 if {$searchstring ne {}} {
6869 set sel [$ctext tag ranges sel]
6871 set start [lindex $sel 0]
6872 } elseif {[catch {set start [$ctext index anchor]}]} {
6873 set start @0,[winfo height $ctext]
6875 set match [$ctext search -backwards -count ml -- $searchstring $start]
6876 $ctext tag remove sel 1.0 end
6882 set mend "$match + $ml c"
6883 $ctext tag add sel $match $mend
6884 $ctext mark unset anchor
6888 proc searchmark {first last} {
6889 global ctext searchstring
6893 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6894 if {$match eq {}} break
6895 set mend "$match + $mlen c"
6896 $ctext tag add found $match $mend
6900 proc searchmarkvisible {doall} {
6901 global ctext smarktop smarkbot
6903 set topline [lindex [split [$ctext index @0,0] .] 0]
6904 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6905 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6906 # no overlap with previous
6907 searchmark $topline $botline
6908 set smarktop $topline
6909 set smarkbot $botline
6911 if {$topline < $smarktop} {
6912 searchmark $topline [expr {$smarktop-1}]
6913 set smarktop $topline
6915 if {$botline > $smarkbot} {
6916 searchmark [expr {$smarkbot+1}] $botline
6917 set smarkbot $botline
6922 proc scrolltext {f0 f1} {
6925 .bleft.bottom.sb set $f0 $f1
6926 if {$searchstring ne {}} {
6932 global linespc charspc canvx0 canvy0
6933 global xspc1 xspc2 lthickness
6935 set linespc [font metrics mainfont -linespace]
6936 set charspc [font measure mainfont "m"]
6937 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6938 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6939 set lthickness [expr {int($linespc / 9) + 1}]
6940 set xspc1(0) $linespc
6948 set ymax [lindex [$canv cget -scrollregion] 3]
6949 if {$ymax eq {} || $ymax == 0} return
6950 set span [$canv yview]
6953 allcanvs yview moveto [lindex $span 0]
6955 if {$selectedline ne {}} {
6956 selectline $selectedline 0
6957 allcanvs yview moveto [lindex $span 0]
6961 proc parsefont {f n} {
6964 set fontattr($f,family) [lindex $n 0]
6966 if {$s eq {} || $s == 0} {
6969 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6971 set fontattr($f,size) $s
6972 set fontattr($f,weight) normal
6973 set fontattr($f,slant) roman
6974 foreach style [lrange $n 2 end] {
6977 "bold" {set fontattr($f,weight) $style}
6979 "italic" {set fontattr($f,slant) $style}
6984 proc fontflags {f {isbold 0}} {
6987 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6988 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6989 -slant $fontattr($f,slant)]
6995 set n [list $fontattr($f,family) $fontattr($f,size)]
6996 if {$fontattr($f,weight) eq "bold"} {
6999 if {$fontattr($f,slant) eq "italic"} {
7005 proc incrfont {inc} {
7006 global mainfont textfont ctext canv cflist showrefstop
7007 global stopped entries fontattr
7010 set s $fontattr(mainfont,size)
7015 set fontattr(mainfont,size) $s
7016 font config mainfont -size $s
7017 font config mainfontbold -size $s
7018 set mainfont [fontname mainfont]
7019 set s $fontattr(textfont,size)
7024 set fontattr(textfont,size) $s
7025 font config textfont -size $s
7026 font config textfontbold -size $s
7027 set textfont [fontname textfont]
7034 global sha1entry sha1string
7035 if {[string length $sha1string] == 40} {
7036 $sha1entry delete 0 end
7040 proc sha1change {n1 n2 op} {
7041 global sha1string currentid sha1but
7042 if {$sha1string == {}
7043 || ([info exists currentid] && $sha1string == $currentid)} {
7048 if {[$sha1but cget -state] == $state} return
7049 if {$state == "normal"} {
7050 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7052 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7056 proc gotocommit {} {
7057 global sha1string tagids headids curview varcid
7059 if {$sha1string == {}
7060 || ([info exists currentid] && $sha1string == $currentid)} return
7061 if {[info exists tagids($sha1string)]} {
7062 set id $tagids($sha1string)
7063 } elseif {[info exists headids($sha1string)]} {
7064 set id $headids($sha1string)
7066 set id [string tolower $sha1string]
7067 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7068 set matches [array names varcid "$curview,$id*"]
7069 if {$matches ne {}} {
7070 if {[llength $matches] > 1} {
7071 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7074 set id [lindex [split [lindex $matches 0] ","] 1]
7078 if {[commitinview $id $curview]} {
7079 selectline [rowofcommit $id] 1
7082 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7083 set msg [mc "SHA1 id %s is not known" $sha1string]
7085 set msg [mc "Tag/Head %s is not known" $sha1string]
7090 proc lineenter {x y id} {
7091 global hoverx hovery hoverid hovertimer
7092 global commitinfo canv
7094 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7098 if {[info exists hovertimer]} {
7099 after cancel $hovertimer
7101 set hovertimer [after 500 linehover]
7105 proc linemotion {x y id} {
7106 global hoverx hovery hoverid hovertimer
7108 if {[info exists hoverid] && $id == $hoverid} {
7111 if {[info exists hovertimer]} {
7112 after cancel $hovertimer
7114 set hovertimer [after 500 linehover]
7118 proc lineleave {id} {
7119 global hoverid hovertimer canv
7121 if {[info exists hoverid] && $id == $hoverid} {
7123 if {[info exists hovertimer]} {
7124 after cancel $hovertimer
7132 global hoverx hovery hoverid hovertimer
7133 global canv linespc lthickness
7136 set text [lindex $commitinfo($hoverid) 0]
7137 set ymax [lindex [$canv cget -scrollregion] 3]
7138 if {$ymax == {}} return
7139 set yfrac [lindex [$canv yview] 0]
7140 set x [expr {$hoverx + 2 * $linespc}]
7141 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7142 set x0 [expr {$x - 2 * $lthickness}]
7143 set y0 [expr {$y - 2 * $lthickness}]
7144 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7145 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7146 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7147 -fill \#ffff80 -outline black -width 1 -tags hover]
7149 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7154 proc clickisonarrow {id y} {
7157 set ranges [rowranges $id]
7158 set thresh [expr {2 * $lthickness + 6}]
7159 set n [expr {[llength $ranges] - 1}]
7160 for {set i 1} {$i < $n} {incr i} {
7161 set row [lindex $ranges $i]
7162 if {abs([yc $row] - $y) < $thresh} {
7169 proc arrowjump {id n y} {
7172 # 1 <-> 2, 3 <-> 4, etc...
7173 set n [expr {(($n - 1) ^ 1) + 1}]
7174 set row [lindex [rowranges $id] $n]
7176 set ymax [lindex [$canv cget -scrollregion] 3]
7177 if {$ymax eq {} || $ymax <= 0} return
7178 set view [$canv yview]
7179 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7180 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7184 allcanvs yview moveto $yfrac
7187 proc lineclick {x y id isnew} {
7188 global ctext commitinfo children canv thickerline curview
7190 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7195 # draw this line thicker than normal
7199 set ymax [lindex [$canv cget -scrollregion] 3]
7200 if {$ymax eq {}} return
7201 set yfrac [lindex [$canv yview] 0]
7202 set y [expr {$y + $yfrac * $ymax}]
7204 set dirn [clickisonarrow $id $y]
7206 arrowjump $id $dirn $y
7211 addtohistory [list lineclick $x $y $id 0]
7213 # fill the details pane with info about this line
7214 $ctext conf -state normal
7217 $ctext insert end "[mc "Parent"]:\t"
7218 $ctext insert end $id link0
7220 set info $commitinfo($id)
7221 $ctext insert end "\n\t[lindex $info 0]\n"
7222 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7223 set date [formatdate [lindex $info 2]]
7224 $ctext insert end "\t[mc "Date"]:\t$date\n"
7225 set kids $children($curview,$id)
7227 $ctext insert end "\n[mc "Children"]:"
7229 foreach child $kids {
7231 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7232 set info $commitinfo($child)
7233 $ctext insert end "\n\t"
7234 $ctext insert end $child link$i
7235 setlink $child link$i
7236 $ctext insert end "\n\t[lindex $info 0]"
7237 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7238 set date [formatdate [lindex $info 2]]
7239 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7242 $ctext conf -state disabled
7246 proc normalline {} {
7248 if {[info exists thickerline]} {
7257 if {[commitinview $id $curview]} {
7258 selectline [rowofcommit $id] 1
7264 if {![info exists startmstime]} {
7265 set startmstime [clock clicks -milliseconds]
7267 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7270 proc rowmenu {x y id} {
7271 global rowctxmenu selectedline rowmenuid curview
7272 global nullid nullid2 fakerowmenu mainhead
7276 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7281 if {$id ne $nullid && $id ne $nullid2} {
7282 set menu $rowctxmenu
7283 if {$mainhead ne {}} {
7284 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7286 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7289 set menu $fakerowmenu
7291 $menu entryconfigure [mc "Diff this -> selected"] -state $state
7292 $menu entryconfigure [mc "Diff selected -> this"] -state $state
7293 $menu entryconfigure [mc "Make patch"] -state $state
7294 tk_popup $menu $x $y
7297 proc diffvssel {dirn} {
7298 global rowmenuid selectedline
7300 if {$selectedline eq {}} return
7302 set oldid [commitonrow $selectedline]
7303 set newid $rowmenuid
7305 set oldid $rowmenuid
7306 set newid [commitonrow $selectedline]
7308 addtohistory [list doseldiff $oldid $newid]
7309 doseldiff $oldid $newid
7312 proc doseldiff {oldid newid} {
7316 $ctext conf -state normal
7318 init_flist [mc "Top"]
7319 $ctext insert end "[mc "From"] "
7320 $ctext insert end $oldid link0
7321 setlink $oldid link0
7322 $ctext insert end "\n "
7323 $ctext insert end [lindex $commitinfo($oldid) 0]
7324 $ctext insert end "\n\n[mc "To"] "
7325 $ctext insert end $newid link1
7326 setlink $newid link1
7327 $ctext insert end "\n "
7328 $ctext insert end [lindex $commitinfo($newid) 0]
7329 $ctext insert end "\n"
7330 $ctext conf -state disabled
7331 $ctext tag remove found 1.0 end
7332 startdiff [list $oldid $newid]
7336 global rowmenuid currentid commitinfo patchtop patchnum
7338 if {![info exists currentid]} return
7339 set oldid $currentid
7340 set oldhead [lindex $commitinfo($oldid) 0]
7341 set newid $rowmenuid
7342 set newhead [lindex $commitinfo($newid) 0]
7345 catch {destroy $top}
7347 label $top.title -text [mc "Generate patch"]
7348 grid $top.title - -pady 10
7349 label $top.from -text [mc "From:"]
7350 entry $top.fromsha1 -width 40 -relief flat
7351 $top.fromsha1 insert 0 $oldid
7352 $top.fromsha1 conf -state readonly
7353 grid $top.from $top.fromsha1 -sticky w
7354 entry $top.fromhead -width 60 -relief flat
7355 $top.fromhead insert 0 $oldhead
7356 $top.fromhead conf -state readonly
7357 grid x $top.fromhead -sticky w
7358 label $top.to -text [mc "To:"]
7359 entry $top.tosha1 -width 40 -relief flat
7360 $top.tosha1 insert 0 $newid
7361 $top.tosha1 conf -state readonly
7362 grid $top.to $top.tosha1 -sticky w
7363 entry $top.tohead -width 60 -relief flat
7364 $top.tohead insert 0 $newhead
7365 $top.tohead conf -state readonly
7366 grid x $top.tohead -sticky w
7367 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7368 grid $top.rev x -pady 10
7369 label $top.flab -text [mc "Output file:"]
7370 entry $top.fname -width 60
7371 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7373 grid $top.flab $top.fname -sticky w
7375 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7376 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7377 grid $top.buts.gen $top.buts.can
7378 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7379 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7380 grid $top.buts - -pady 10 -sticky ew
7384 proc mkpatchrev {} {
7387 set oldid [$patchtop.fromsha1 get]
7388 set oldhead [$patchtop.fromhead get]
7389 set newid [$patchtop.tosha1 get]
7390 set newhead [$patchtop.tohead get]
7391 foreach e [list fromsha1 fromhead tosha1 tohead] \
7392 v [list $newid $newhead $oldid $oldhead] {
7393 $patchtop.$e conf -state normal
7394 $patchtop.$e delete 0 end
7395 $patchtop.$e insert 0 $v
7396 $patchtop.$e conf -state readonly
7401 global patchtop nullid nullid2
7403 set oldid [$patchtop.fromsha1 get]
7404 set newid [$patchtop.tosha1 get]
7405 set fname [$patchtop.fname get]
7406 set cmd [diffcmd [list $oldid $newid] -p]
7407 # trim off the initial "|"
7408 set cmd [lrange $cmd 1 end]
7409 lappend cmd >$fname &
7410 if {[catch {eval exec $cmd} err]} {
7411 error_popup "[mc "Error creating patch:"] $err"
7413 catch {destroy $patchtop}
7417 proc mkpatchcan {} {
7420 catch {destroy $patchtop}
7425 global rowmenuid mktagtop commitinfo
7429 catch {destroy $top}
7431 label $top.title -text [mc "Create tag"]
7432 grid $top.title - -pady 10
7433 label $top.id -text [mc "ID:"]
7434 entry $top.sha1 -width 40 -relief flat
7435 $top.sha1 insert 0 $rowmenuid
7436 $top.sha1 conf -state readonly
7437 grid $top.id $top.sha1 -sticky w
7438 entry $top.head -width 60 -relief flat
7439 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7440 $top.head conf -state readonly
7441 grid x $top.head -sticky w
7442 label $top.tlab -text [mc "Tag name:"]
7443 entry $top.tag -width 60
7444 grid $top.tlab $top.tag -sticky w
7446 button $top.buts.gen -text [mc "Create"] -command mktaggo
7447 button $top.buts.can -text [mc "Cancel"] -command mktagcan
7448 grid $top.buts.gen $top.buts.can
7449 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7450 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7451 grid $top.buts - -pady 10 -sticky ew
7456 global mktagtop env tagids idtags
7458 set id [$mktagtop.sha1 get]
7459 set tag [$mktagtop.tag get]
7461 error_popup [mc "No tag name specified"]
7464 if {[info exists tagids($tag)]} {
7465 error_popup [mc "Tag \"%s\" already exists" $tag]
7469 exec git tag $tag $id
7471 error_popup "[mc "Error creating tag:"] $err"
7475 set tagids($tag) $id
7476 lappend idtags($id) $tag
7483 proc redrawtags {id} {
7484 global canv linehtag idpos currentid curview cmitlisted
7485 global canvxmax iddrawn circleitem mainheadid circlecolors
7487 if {![commitinview $id $curview]} return
7488 if {![info exists iddrawn($id)]} return
7489 set row [rowofcommit $id]
7490 if {$id eq $mainheadid} {
7493 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
7495 $canv itemconf $circleitem($row) -fill $ofill
7496 $canv delete tag.$id
7497 set xt [eval drawtags $id $idpos($id)]
7498 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7499 set text [$canv itemcget $linehtag($row) -text]
7500 set font [$canv itemcget $linehtag($row) -font]
7501 set xr [expr {$xt + [font measure $font $text]}]
7502 if {$xr > $canvxmax} {
7506 if {[info exists currentid] && $currentid == $id} {
7514 catch {destroy $mktagtop}
7523 proc writecommit {} {
7524 global rowmenuid wrcomtop commitinfo wrcomcmd
7526 set top .writecommit
7528 catch {destroy $top}
7530 label $top.title -text [mc "Write commit to file"]
7531 grid $top.title - -pady 10
7532 label $top.id -text [mc "ID:"]
7533 entry $top.sha1 -width 40 -relief flat
7534 $top.sha1 insert 0 $rowmenuid
7535 $top.sha1 conf -state readonly
7536 grid $top.id $top.sha1 -sticky w
7537 entry $top.head -width 60 -relief flat
7538 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7539 $top.head conf -state readonly
7540 grid x $top.head -sticky w
7541 label $top.clab -text [mc "Command:"]
7542 entry $top.cmd -width 60 -textvariable wrcomcmd
7543 grid $top.clab $top.cmd -sticky w -pady 10
7544 label $top.flab -text [mc "Output file:"]
7545 entry $top.fname -width 60
7546 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7547 grid $top.flab $top.fname -sticky w
7549 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7550 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7551 grid $top.buts.gen $top.buts.can
7552 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7553 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7554 grid $top.buts - -pady 10 -sticky ew
7561 set id [$wrcomtop.sha1 get]
7562 set cmd "echo $id | [$wrcomtop.cmd get]"
7563 set fname [$wrcomtop.fname get]
7564 if {[catch {exec sh -c $cmd >$fname &} err]} {
7565 error_popup "[mc "Error writing commit:"] $err"
7567 catch {destroy $wrcomtop}
7574 catch {destroy $wrcomtop}
7579 global rowmenuid mkbrtop
7582 catch {destroy $top}
7584 label $top.title -text [mc "Create new branch"]
7585 grid $top.title - -pady 10
7586 label $top.id -text [mc "ID:"]
7587 entry $top.sha1 -width 40 -relief flat
7588 $top.sha1 insert 0 $rowmenuid
7589 $top.sha1 conf -state readonly
7590 grid $top.id $top.sha1 -sticky w
7591 label $top.nlab -text [mc "Name:"]
7592 entry $top.name -width 40
7593 grid $top.nlab $top.name -sticky w
7595 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7596 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7597 grid $top.buts.go $top.buts.can
7598 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7599 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7600 grid $top.buts - -pady 10 -sticky ew
7605 global headids idheads
7607 set name [$top.name get]
7608 set id [$top.sha1 get]
7610 error_popup [mc "Please specify a name for the new branch"]
7613 catch {destroy $top}
7617 exec git branch $name $id
7622 set headids($name) $id
7623 lappend idheads($id) $name
7632 proc cherrypick {} {
7633 global rowmenuid curview
7634 global mainhead mainheadid
7636 set oldhead [exec git rev-parse HEAD]
7637 set dheads [descheads $rowmenuid]
7638 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7639 set ok [confirm_popup [mc "Commit %s is already\
7640 included in branch %s -- really re-apply it?" \
7641 [string range $rowmenuid 0 7] $mainhead]]
7644 nowbusy cherrypick [mc "Cherry-picking"]
7646 # Unfortunately git-cherry-pick writes stuff to stderr even when
7647 # no error occurs, and exec takes that as an indication of error...
7648 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7653 set newhead [exec git rev-parse HEAD]
7654 if {$newhead eq $oldhead} {
7656 error_popup [mc "No changes committed"]
7659 addnewchild $newhead $oldhead
7660 if {[commitinview $oldhead $curview]} {
7661 insertrow $newhead $oldhead $curview
7662 if {$mainhead ne {}} {
7663 movehead $newhead $mainhead
7664 movedhead $newhead $mainhead
7666 set mainheadid $newhead
7675 global mainhead rowmenuid confirm_ok resettype
7678 set w ".confirmreset"
7681 wm title $w [mc "Confirm reset"]
7682 message $w.m -text \
7683 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7684 -justify center -aspect 1000
7685 pack $w.m -side top -fill x -padx 20 -pady 20
7686 frame $w.f -relief sunken -border 2
7687 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7688 grid $w.f.rt -sticky w
7690 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7691 -text [mc "Soft: Leave working tree and index untouched"]
7692 grid $w.f.soft -sticky w
7693 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7694 -text [mc "Mixed: Leave working tree untouched, reset index"]
7695 grid $w.f.mixed -sticky w
7696 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7697 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7698 grid $w.f.hard -sticky w
7699 pack $w.f -side top -fill x
7700 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7701 pack $w.ok -side left -fill x -padx 20 -pady 20
7702 button $w.cancel -text [mc Cancel] -command "destroy $w"
7703 pack $w.cancel -side right -fill x -padx 20 -pady 20
7704 bind $w <Visibility> "grab $w; focus $w"
7706 if {!$confirm_ok} return
7707 if {[catch {set fd [open \
7708 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
7712 filerun $fd [list readresetstat $fd]
7713 nowbusy reset [mc "Resetting"]
7718 proc readresetstat {fd} {
7719 global mainhead mainheadid showlocalchanges rprogcoord
7721 if {[gets $fd line] >= 0} {
7722 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7723 set rprogcoord [expr {1.0 * $m / $n}]
7731 if {[catch {close $fd} err]} {
7734 set oldhead $mainheadid
7735 set newhead [exec git rev-parse HEAD]
7736 if {$newhead ne $oldhead} {
7737 movehead $newhead $mainhead
7738 movedhead $newhead $mainhead
7739 set mainheadid $newhead
7743 if {$showlocalchanges} {
7749 # context menu for a head
7750 proc headmenu {x y id head} {
7751 global headmenuid headmenuhead headctxmenu mainhead
7755 set headmenuhead $head
7757 if {$head eq $mainhead} {
7760 $headctxmenu entryconfigure 0 -state $state
7761 $headctxmenu entryconfigure 1 -state $state
7762 tk_popup $headctxmenu $x $y
7766 global headmenuid headmenuhead headids
7767 global showlocalchanges mainheadid
7769 # check the tree is clean first??
7770 nowbusy checkout [mc "Checking out"]
7774 set fd [open [list | git checkout $headmenuhead 2>@1] r]
7778 if {$showlocalchanges} {
7782 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
7786 proc readcheckoutstat {fd newhead newheadid} {
7787 global mainhead mainheadid headids showlocalchanges progresscoords
7789 if {[gets $fd line] >= 0} {
7790 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7791 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
7796 set progresscoords {0 0}
7799 if {[catch {close $fd} err]} {
7802 set oldmainid $mainheadid
7803 set mainhead $newhead
7804 set mainheadid $newheadid
7805 redrawtags $oldmainid
7806 redrawtags $newheadid
7808 if {$showlocalchanges} {
7814 global headmenuid headmenuhead mainhead
7817 set head $headmenuhead
7819 # this check shouldn't be needed any more...
7820 if {$head eq $mainhead} {
7821 error_popup [mc "Cannot delete the currently checked-out branch"]
7824 set dheads [descheads $id]
7825 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7826 # the stuff on this branch isn't on any other branch
7827 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7828 branch.\nReally delete branch %s?" $head $head]]} return
7832 if {[catch {exec git branch -D $head} err]} {
7837 removehead $id $head
7838 removedhead $id $head
7845 # Display a list of tags and heads
7847 global showrefstop bgcolor fgcolor selectbgcolor
7848 global bglist fglist reflistfilter reflist maincursor
7851 set showrefstop $top
7852 if {[winfo exists $top]} {
7858 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7859 text $top.list -background $bgcolor -foreground $fgcolor \
7860 -selectbackground $selectbgcolor -font mainfont \
7861 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7862 -width 30 -height 20 -cursor $maincursor \
7863 -spacing1 1 -spacing3 1 -state disabled
7864 $top.list tag configure highlight -background $selectbgcolor
7865 lappend bglist $top.list
7866 lappend fglist $top.list
7867 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7868 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7869 grid $top.list $top.ysb -sticky nsew
7870 grid $top.xsb x -sticky ew
7872 label $top.f.l -text "[mc "Filter"]: "
7873 entry $top.f.e -width 20 -textvariable reflistfilter
7874 set reflistfilter "*"
7875 trace add variable reflistfilter write reflistfilter_change
7876 pack $top.f.e -side right -fill x -expand 1
7877 pack $top.f.l -side left
7878 grid $top.f - -sticky ew -pady 2
7879 button $top.close -command [list destroy $top] -text [mc "Close"]
7881 grid columnconfigure $top 0 -weight 1
7882 grid rowconfigure $top 0 -weight 1
7883 bind $top.list <1> {break}
7884 bind $top.list <B1-Motion> {break}
7885 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7890 proc sel_reflist {w x y} {
7891 global showrefstop reflist headids tagids otherrefids
7893 if {![winfo exists $showrefstop]} return
7894 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7895 set ref [lindex $reflist [expr {$l-1}]]
7896 set n [lindex $ref 0]
7897 switch -- [lindex $ref 1] {
7898 "H" {selbyid $headids($n)}
7899 "T" {selbyid $tagids($n)}
7900 "o" {selbyid $otherrefids($n)}
7902 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7905 proc unsel_reflist {} {
7908 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7909 $showrefstop.list tag remove highlight 0.0 end
7912 proc reflistfilter_change {n1 n2 op} {
7913 global reflistfilter
7915 after cancel refill_reflist
7916 after 200 refill_reflist
7919 proc refill_reflist {} {
7920 global reflist reflistfilter showrefstop headids tagids otherrefids
7921 global curview commitinterest
7923 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7925 foreach n [array names headids] {
7926 if {[string match $reflistfilter $n]} {
7927 if {[commitinview $headids($n) $curview]} {
7928 lappend refs [list $n H]
7930 set commitinterest($headids($n)) {run refill_reflist}
7934 foreach n [array names tagids] {
7935 if {[string match $reflistfilter $n]} {
7936 if {[commitinview $tagids($n) $curview]} {
7937 lappend refs [list $n T]
7939 set commitinterest($tagids($n)) {run refill_reflist}
7943 foreach n [array names otherrefids] {
7944 if {[string match $reflistfilter $n]} {
7945 if {[commitinview $otherrefids($n) $curview]} {
7946 lappend refs [list $n o]
7948 set commitinterest($otherrefids($n)) {run refill_reflist}
7952 set refs [lsort -index 0 $refs]
7953 if {$refs eq $reflist} return
7955 # Update the contents of $showrefstop.list according to the
7956 # differences between $reflist (old) and $refs (new)
7957 $showrefstop.list conf -state normal
7958 $showrefstop.list insert end "\n"
7961 while {$i < [llength $reflist] || $j < [llength $refs]} {
7962 if {$i < [llength $reflist]} {
7963 if {$j < [llength $refs]} {
7964 set cmp [string compare [lindex $reflist $i 0] \
7965 [lindex $refs $j 0]]
7967 set cmp [string compare [lindex $reflist $i 1] \
7968 [lindex $refs $j 1]]
7978 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7986 set l [expr {$j + 1}]
7987 $showrefstop.list image create $l.0 -align baseline \
7988 -image reficon-[lindex $refs $j 1] -padx 2
7989 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7995 # delete last newline
7996 $showrefstop.list delete end-2c end-1c
7997 $showrefstop.list conf -state disabled
8000 # Stuff for finding nearby tags
8001 proc getallcommits {} {
8002 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8003 global idheads idtags idotherrefs allparents tagobjid
8005 if {![info exists allcommits]} {
8011 set allccache [file join [gitdir] "gitk.cache"]
8013 set f [open $allccache r]
8022 set cmd [list | git rev-list --parents]
8023 set allcupdate [expr {$seeds ne {}}]
8027 set refs [concat [array names idheads] [array names idtags] \
8028 [array names idotherrefs]]
8031 foreach name [array names tagobjid] {
8032 lappend tagobjs $tagobjid($name)
8034 foreach id [lsort -unique $refs] {
8035 if {![info exists allparents($id)] &&
8036 [lsearch -exact $tagobjs $id] < 0} {
8047 set fd [open [concat $cmd $ids] r]
8048 fconfigure $fd -blocking 0
8051 filerun $fd [list getallclines $fd]
8057 # Since most commits have 1 parent and 1 child, we group strings of
8058 # such commits into "arcs" joining branch/merge points (BMPs), which
8059 # are commits that either don't have 1 parent or don't have 1 child.
8061 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8062 # arcout(id) - outgoing arcs for BMP
8063 # arcids(a) - list of IDs on arc including end but not start
8064 # arcstart(a) - BMP ID at start of arc
8065 # arcend(a) - BMP ID at end of arc
8066 # growing(a) - arc a is still growing
8067 # arctags(a) - IDs out of arcids (excluding end) that have tags
8068 # archeads(a) - IDs out of arcids (excluding end) that have heads
8069 # The start of an arc is at the descendent end, so "incoming" means
8070 # coming from descendents, and "outgoing" means going towards ancestors.
8072 proc getallclines {fd} {
8073 global allparents allchildren idtags idheads nextarc
8074 global arcnos arcids arctags arcout arcend arcstart archeads growing
8075 global seeds allcommits cachedarcs allcupdate
8078 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8079 set id [lindex $line 0]
8080 if {[info exists allparents($id)]} {
8085 set olds [lrange $line 1 end]
8086 set allparents($id) $olds
8087 if {![info exists allchildren($id)]} {
8088 set allchildren($id) {}
8093 if {[llength $olds] == 1 && [llength $a] == 1} {
8094 lappend arcids($a) $id
8095 if {[info exists idtags($id)]} {
8096 lappend arctags($a) $id
8098 if {[info exists idheads($id)]} {
8099 lappend archeads($a) $id
8101 if {[info exists allparents($olds)]} {
8102 # seen parent already
8103 if {![info exists arcout($olds)]} {
8106 lappend arcids($a) $olds
8107 set arcend($a) $olds
8110 lappend allchildren($olds) $id
8111 lappend arcnos($olds) $a
8115 foreach a $arcnos($id) {
8116 lappend arcids($a) $id
8123 lappend allchildren($p) $id
8124 set a [incr nextarc]
8125 set arcstart($a) $id
8132 if {[info exists allparents($p)]} {
8133 # seen it already, may need to make a new branch
8134 if {![info exists arcout($p)]} {
8137 lappend arcids($a) $p
8141 lappend arcnos($p) $a
8146 global cached_dheads cached_dtags cached_atags
8147 catch {unset cached_dheads}
8148 catch {unset cached_dtags}
8149 catch {unset cached_atags}
8152 return [expr {$nid >= 1000? 2: 1}]
8156 fconfigure $fd -blocking 1
8159 # got an error reading the list of commits
8160 # if we were updating, try rereading the whole thing again
8166 error_popup "[mc "Error reading commit topology information;\
8167 branch and preceding/following tag information\
8168 will be incomplete."]\n($err)"
8171 if {[incr allcommits -1] == 0} {
8181 proc recalcarc {a} {
8182 global arctags archeads arcids idtags idheads
8186 foreach id [lrange $arcids($a) 0 end-1] {
8187 if {[info exists idtags($id)]} {
8190 if {[info exists idheads($id)]} {
8195 set archeads($a) $ah
8199 global arcnos arcids nextarc arctags archeads idtags idheads
8200 global arcstart arcend arcout allparents growing
8203 if {[llength $a] != 1} {
8204 puts "oops splitarc called but [llength $a] arcs already"
8208 set i [lsearch -exact $arcids($a) $p]
8210 puts "oops splitarc $p not in arc $a"
8213 set na [incr nextarc]
8214 if {[info exists arcend($a)]} {
8215 set arcend($na) $arcend($a)
8217 set l [lindex $allparents([lindex $arcids($a) end]) 0]
8218 set j [lsearch -exact $arcnos($l) $a]
8219 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8221 set tail [lrange $arcids($a) [expr {$i+1}] end]
8222 set arcids($a) [lrange $arcids($a) 0 $i]
8224 set arcstart($na) $p
8226 set arcids($na) $tail
8227 if {[info exists growing($a)]} {
8233 if {[llength $arcnos($id)] == 1} {
8236 set j [lsearch -exact $arcnos($id) $a]
8237 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8241 # reconstruct tags and heads lists
8242 if {$arctags($a) ne {} || $archeads($a) ne {}} {
8247 set archeads($na) {}
8251 # Update things for a new commit added that is a child of one
8252 # existing commit. Used when cherry-picking.
8253 proc addnewchild {id p} {
8254 global allparents allchildren idtags nextarc
8255 global arcnos arcids arctags arcout arcend arcstart archeads growing
8256 global seeds allcommits
8258 if {![info exists allcommits] || ![info exists arcnos($p)]} return
8259 set allparents($id) [list $p]
8260 set allchildren($id) {}
8263 lappend allchildren($p) $id
8264 set a [incr nextarc]
8265 set arcstart($a) $id
8268 set arcids($a) [list $p]
8270 if {![info exists arcout($p)]} {
8273 lappend arcnos($p) $a
8274 set arcout($id) [list $a]
8277 # This implements a cache for the topology information.
8278 # The cache saves, for each arc, the start and end of the arc,
8279 # the ids on the arc, and the outgoing arcs from the end.
8280 proc readcache {f} {
8281 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8282 global idtags idheads allparents cachedarcs possible_seeds seeds growing
8287 if {$lim - $a > 500} {
8288 set lim [expr {$a + 500}]
8292 # finish reading the cache and setting up arctags, etc.
8294 if {$line ne "1"} {error "bad final version"}
8296 foreach id [array names idtags] {
8297 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8298 [llength $allparents($id)] == 1} {
8299 set a [lindex $arcnos($id) 0]
8300 if {$arctags($a) eq {}} {
8305 foreach id [array names idheads] {
8306 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8307 [llength $allparents($id)] == 1} {
8308 set a [lindex $arcnos($id) 0]
8309 if {$archeads($a) eq {}} {
8314 foreach id [lsort -unique $possible_seeds] {
8315 if {$arcnos($id) eq {}} {
8321 while {[incr a] <= $lim} {
8323 if {[llength $line] != 3} {error "bad line"}
8324 set s [lindex $line 0]
8326 lappend arcout($s) $a
8327 if {![info exists arcnos($s)]} {
8328 lappend possible_seeds $s
8331 set e [lindex $line 1]
8336 if {![info exists arcout($e)]} {
8340 set arcids($a) [lindex $line 2]
8341 foreach id $arcids($a) {
8342 lappend allparents($s) $id
8344 lappend arcnos($id) $a
8346 if {![info exists allparents($s)]} {
8347 set allparents($s) {}
8352 set nextarc [expr {$a - 1}]
8365 global nextarc cachedarcs possible_seeds
8369 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8370 # make sure it's an integer
8371 set cachedarcs [expr {int([lindex $line 1])}]
8372 if {$cachedarcs < 0} {error "bad number of arcs"}
8374 set possible_seeds {}
8382 proc dropcache {err} {
8383 global allcwait nextarc cachedarcs seeds
8385 #puts "dropping cache ($err)"
8386 foreach v {arcnos arcout arcids arcstart arcend growing \
8387 arctags archeads allparents allchildren} {
8398 proc writecache {f} {
8399 global cachearc cachedarcs allccache
8400 global arcstart arcend arcnos arcids arcout
8404 if {$lim - $a > 1000} {
8405 set lim [expr {$a + 1000}]
8408 while {[incr a] <= $lim} {
8409 if {[info exists arcend($a)]} {
8410 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8412 puts $f [list $arcstart($a) {} $arcids($a)]
8417 catch {file delete $allccache}
8418 #puts "writing cache failed ($err)"
8421 set cachearc [expr {$a - 1}]
8422 if {$a > $cachedarcs} {
8431 global nextarc cachedarcs cachearc allccache
8433 if {$nextarc == $cachedarcs} return
8435 set cachedarcs $nextarc
8437 set f [open $allccache w]
8438 puts $f [list 1 $cachedarcs]
8443 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8444 # or 0 if neither is true.
8445 proc anc_or_desc {a b} {
8446 global arcout arcstart arcend arcnos cached_isanc
8448 if {$arcnos($a) eq $arcnos($b)} {
8449 # Both are on the same arc(s); either both are the same BMP,
8450 # or if one is not a BMP, the other is also not a BMP or is
8451 # the BMP at end of the arc (and it only has 1 incoming arc).
8452 # Or both can be BMPs with no incoming arcs.
8453 if {$a eq $b || $arcnos($a) eq {}} {
8456 # assert {[llength $arcnos($a)] == 1}
8457 set arc [lindex $arcnos($a) 0]
8458 set i [lsearch -exact $arcids($arc) $a]
8459 set j [lsearch -exact $arcids($arc) $b]
8460 if {$i < 0 || $i > $j} {
8467 if {![info exists arcout($a)]} {
8468 set arc [lindex $arcnos($a) 0]
8469 if {[info exists arcend($arc)]} {
8470 set aend $arcend($arc)
8474 set a $arcstart($arc)
8478 if {![info exists arcout($b)]} {
8479 set arc [lindex $arcnos($b) 0]
8480 if {[info exists arcend($arc)]} {
8481 set bend $arcend($arc)
8485 set b $arcstart($arc)
8495 if {[info exists cached_isanc($a,$bend)]} {
8496 if {$cached_isanc($a,$bend)} {
8500 if {[info exists cached_isanc($b,$aend)]} {
8501 if {$cached_isanc($b,$aend)} {
8504 if {[info exists cached_isanc($a,$bend)]} {
8509 set todo [list $a $b]
8512 for {set i 0} {$i < [llength $todo]} {incr i} {
8513 set x [lindex $todo $i]
8514 if {$anc($x) eq {}} {
8517 foreach arc $arcnos($x) {
8518 set xd $arcstart($arc)
8520 set cached_isanc($a,$bend) 1
8521 set cached_isanc($b,$aend) 0
8523 } elseif {$xd eq $aend} {
8524 set cached_isanc($b,$aend) 1
8525 set cached_isanc($a,$bend) 0
8528 if {![info exists anc($xd)]} {
8529 set anc($xd) $anc($x)
8531 } elseif {$anc($xd) ne $anc($x)} {
8536 set cached_isanc($a,$bend) 0
8537 set cached_isanc($b,$aend) 0
8541 # This identifies whether $desc has an ancestor that is
8542 # a growing tip of the graph and which is not an ancestor of $anc
8543 # and returns 0 if so and 1 if not.
8544 # If we subsequently discover a tag on such a growing tip, and that
8545 # turns out to be a descendent of $anc (which it could, since we
8546 # don't necessarily see children before parents), then $desc
8547 # isn't a good choice to display as a descendent tag of
8548 # $anc (since it is the descendent of another tag which is
8549 # a descendent of $anc). Similarly, $anc isn't a good choice to
8550 # display as a ancestor tag of $desc.
8552 proc is_certain {desc anc} {
8553 global arcnos arcout arcstart arcend growing problems
8556 if {[llength $arcnos($anc)] == 1} {
8557 # tags on the same arc are certain
8558 if {$arcnos($desc) eq $arcnos($anc)} {
8561 if {![info exists arcout($anc)]} {
8562 # if $anc is partway along an arc, use the start of the arc instead
8563 set a [lindex $arcnos($anc) 0]
8564 set anc $arcstart($a)
8567 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8570 set a [lindex $arcnos($desc) 0]
8576 set anclist [list $x]
8580 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8581 set x [lindex $anclist $i]
8586 foreach a $arcout($x) {
8587 if {[info exists growing($a)]} {
8588 if {![info exists growanc($x)] && $dl($x)} {
8594 if {[info exists dl($y)]} {
8598 if {![info exists done($y)]} {
8601 if {[info exists growanc($x)]} {
8605 for {set k 0} {$k < [llength $xl]} {incr k} {
8606 set z [lindex $xl $k]
8607 foreach c $arcout($z) {
8608 if {[info exists arcend($c)]} {
8610 if {[info exists dl($v)] && $dl($v)} {
8612 if {![info exists done($v)]} {
8615 if {[info exists growanc($v)]} {
8625 } elseif {$y eq $anc || !$dl($x)} {
8636 foreach x [array names growanc] {
8645 proc validate_arctags {a} {
8646 global arctags idtags
8650 foreach id $arctags($a) {
8652 if {![info exists idtags($id)]} {
8653 set na [lreplace $na $i $i]
8660 proc validate_archeads {a} {
8661 global archeads idheads
8664 set na $archeads($a)
8665 foreach id $archeads($a) {
8667 if {![info exists idheads($id)]} {
8668 set na [lreplace $na $i $i]
8672 set archeads($a) $na
8675 # Return the list of IDs that have tags that are descendents of id,
8676 # ignoring IDs that are descendents of IDs already reported.
8677 proc desctags {id} {
8678 global arcnos arcstart arcids arctags idtags allparents
8679 global growing cached_dtags
8681 if {![info exists allparents($id)]} {
8684 set t1 [clock clicks -milliseconds]
8686 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8687 # part-way along an arc; check that arc first
8688 set a [lindex $arcnos($id) 0]
8689 if {$arctags($a) ne {}} {
8691 set i [lsearch -exact $arcids($a) $id]
8693 foreach t $arctags($a) {
8694 set j [lsearch -exact $arcids($a) $t]
8702 set id $arcstart($a)
8703 if {[info exists idtags($id)]} {
8707 if {[info exists cached_dtags($id)]} {
8708 return $cached_dtags($id)
8715 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8716 set id [lindex $todo $i]
8718 set ta [info exists hastaggedancestor($id)]
8722 # ignore tags on starting node
8723 if {!$ta && $i > 0} {
8724 if {[info exists idtags($id)]} {
8727 } elseif {[info exists cached_dtags($id)]} {
8728 set tagloc($id) $cached_dtags($id)
8732 foreach a $arcnos($id) {
8734 if {!$ta && $arctags($a) ne {}} {
8736 if {$arctags($a) ne {}} {
8737 lappend tagloc($id) [lindex $arctags($a) end]
8740 if {$ta || $arctags($a) ne {}} {
8741 set tomark [list $d]
8742 for {set j 0} {$j < [llength $tomark]} {incr j} {
8743 set dd [lindex $tomark $j]
8744 if {![info exists hastaggedancestor($dd)]} {
8745 if {[info exists done($dd)]} {
8746 foreach b $arcnos($dd) {
8747 lappend tomark $arcstart($b)
8749 if {[info exists tagloc($dd)]} {
8752 } elseif {[info exists queued($dd)]} {
8755 set hastaggedancestor($dd) 1
8759 if {![info exists queued($d)]} {
8762 if {![info exists hastaggedancestor($d)]} {
8769 foreach id [array names tagloc] {
8770 if {![info exists hastaggedancestor($id)]} {
8771 foreach t $tagloc($id) {
8772 if {[lsearch -exact $tags $t] < 0} {
8778 set t2 [clock clicks -milliseconds]
8781 # remove tags that are descendents of other tags
8782 for {set i 0} {$i < [llength $tags]} {incr i} {
8783 set a [lindex $tags $i]
8784 for {set j 0} {$j < $i} {incr j} {
8785 set b [lindex $tags $j]
8786 set r [anc_or_desc $a $b]
8788 set tags [lreplace $tags $j $j]
8791 } elseif {$r == -1} {
8792 set tags [lreplace $tags $i $i]
8799 if {[array names growing] ne {}} {
8800 # graph isn't finished, need to check if any tag could get
8801 # eclipsed by another tag coming later. Simply ignore any
8802 # tags that could later get eclipsed.
8805 if {[is_certain $t $origid]} {
8809 if {$tags eq $ctags} {
8810 set cached_dtags($origid) $tags
8815 set cached_dtags($origid) $tags
8817 set t3 [clock clicks -milliseconds]
8818 if {0 && $t3 - $t1 >= 100} {
8819 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8820 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8826 global arcnos arcids arcout arcend arctags idtags allparents
8827 global growing cached_atags
8829 if {![info exists allparents($id)]} {
8832 set t1 [clock clicks -milliseconds]
8834 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8835 # part-way along an arc; check that arc first
8836 set a [lindex $arcnos($id) 0]
8837 if {$arctags($a) ne {}} {
8839 set i [lsearch -exact $arcids($a) $id]
8840 foreach t $arctags($a) {
8841 set j [lsearch -exact $arcids($a) $t]
8847 if {![info exists arcend($a)]} {
8851 if {[info exists idtags($id)]} {
8855 if {[info exists cached_atags($id)]} {
8856 return $cached_atags($id)
8864 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8865 set id [lindex $todo $i]
8867 set td [info exists hastaggeddescendent($id)]
8871 # ignore tags on starting node
8872 if {!$td && $i > 0} {
8873 if {[info exists idtags($id)]} {
8876 } elseif {[info exists cached_atags($id)]} {
8877 set tagloc($id) $cached_atags($id)
8881 foreach a $arcout($id) {
8882 if {!$td && $arctags($a) ne {}} {
8884 if {$arctags($a) ne {}} {
8885 lappend tagloc($id) [lindex $arctags($a) 0]
8888 if {![info exists arcend($a)]} continue
8890 if {$td || $arctags($a) ne {}} {
8891 set tomark [list $d]
8892 for {set j 0} {$j < [llength $tomark]} {incr j} {
8893 set dd [lindex $tomark $j]
8894 if {![info exists hastaggeddescendent($dd)]} {
8895 if {[info exists done($dd)]} {
8896 foreach b $arcout($dd) {
8897 if {[info exists arcend($b)]} {
8898 lappend tomark $arcend($b)
8901 if {[info exists tagloc($dd)]} {
8904 } elseif {[info exists queued($dd)]} {
8907 set hastaggeddescendent($dd) 1
8911 if {![info exists queued($d)]} {
8914 if {![info exists hastaggeddescendent($d)]} {
8920 set t2 [clock clicks -milliseconds]
8923 foreach id [array names tagloc] {
8924 if {![info exists hastaggeddescendent($id)]} {
8925 foreach t $tagloc($id) {
8926 if {[lsearch -exact $tags $t] < 0} {
8933 # remove tags that are ancestors of other tags
8934 for {set i 0} {$i < [llength $tags]} {incr i} {
8935 set a [lindex $tags $i]
8936 for {set j 0} {$j < $i} {incr j} {
8937 set b [lindex $tags $j]
8938 set r [anc_or_desc $a $b]
8940 set tags [lreplace $tags $j $j]
8943 } elseif {$r == 1} {
8944 set tags [lreplace $tags $i $i]
8951 if {[array names growing] ne {}} {
8952 # graph isn't finished, need to check if any tag could get
8953 # eclipsed by another tag coming later. Simply ignore any
8954 # tags that could later get eclipsed.
8957 if {[is_certain $origid $t]} {
8961 if {$tags eq $ctags} {
8962 set cached_atags($origid) $tags
8967 set cached_atags($origid) $tags
8969 set t3 [clock clicks -milliseconds]
8970 if {0 && $t3 - $t1 >= 100} {
8971 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8972 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8977 # Return the list of IDs that have heads that are descendents of id,
8978 # including id itself if it has a head.
8979 proc descheads {id} {
8980 global arcnos arcstart arcids archeads idheads cached_dheads
8983 if {![info exists allparents($id)]} {
8987 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8988 # part-way along an arc; check it first
8989 set a [lindex $arcnos($id) 0]
8990 if {$archeads($a) ne {}} {
8991 validate_archeads $a
8992 set i [lsearch -exact $arcids($a) $id]
8993 foreach t $archeads($a) {
8994 set j [lsearch -exact $arcids($a) $t]
8999 set id $arcstart($a)
9005 for {set i 0} {$i < [llength $todo]} {incr i} {
9006 set id [lindex $todo $i]
9007 if {[info exists cached_dheads($id)]} {
9008 set ret [concat $ret $cached_dheads($id)]
9010 if {[info exists idheads($id)]} {
9013 foreach a $arcnos($id) {
9014 if {$archeads($a) ne {}} {
9015 validate_archeads $a
9016 if {$archeads($a) ne {}} {
9017 set ret [concat $ret $archeads($a)]
9021 if {![info exists seen($d)]} {
9028 set ret [lsort -unique $ret]
9029 set cached_dheads($origid) $ret
9030 return [concat $ret $aret]
9033 proc addedtag {id} {
9034 global arcnos arcout cached_dtags cached_atags
9036 if {![info exists arcnos($id)]} return
9037 if {![info exists arcout($id)]} {
9038 recalcarc [lindex $arcnos($id) 0]
9040 catch {unset cached_dtags}
9041 catch {unset cached_atags}
9044 proc addedhead {hid head} {
9045 global arcnos arcout cached_dheads
9047 if {![info exists arcnos($hid)]} return
9048 if {![info exists arcout($hid)]} {
9049 recalcarc [lindex $arcnos($hid) 0]
9051 catch {unset cached_dheads}
9054 proc removedhead {hid head} {
9055 global cached_dheads
9057 catch {unset cached_dheads}
9060 proc movedhead {hid head} {
9061 global arcnos arcout cached_dheads
9063 if {![info exists arcnos($hid)]} return
9064 if {![info exists arcout($hid)]} {
9065 recalcarc [lindex $arcnos($hid) 0]
9067 catch {unset cached_dheads}
9070 proc changedrefs {} {
9071 global cached_dheads cached_dtags cached_atags
9072 global arctags archeads arcnos arcout idheads idtags
9074 foreach id [concat [array names idheads] [array names idtags]] {
9075 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9076 set a [lindex $arcnos($id) 0]
9077 if {![info exists donearc($a)]} {
9083 catch {unset cached_dtags}
9084 catch {unset cached_atags}
9085 catch {unset cached_dheads}
9088 proc rereadrefs {} {
9089 global idtags idheads idotherrefs mainheadid
9091 set refids [concat [array names idtags] \
9092 [array names idheads] [array names idotherrefs]]
9093 foreach id $refids {
9094 if {![info exists ref($id)]} {
9095 set ref($id) [listrefs $id]
9098 set oldmainhead $mainheadid
9101 set refids [lsort -unique [concat $refids [array names idtags] \
9102 [array names idheads] [array names idotherrefs]]]
9103 foreach id $refids {
9104 set v [listrefs $id]
9105 if {![info exists ref($id)] || $ref($id) != $v} {
9109 if {$oldmainhead ne $mainheadid} {
9110 redrawtags $oldmainhead
9111 redrawtags $mainheadid
9116 proc listrefs {id} {
9117 global idtags idheads idotherrefs
9120 if {[info exists idtags($id)]} {
9124 if {[info exists idheads($id)]} {
9128 if {[info exists idotherrefs($id)]} {
9129 set z $idotherrefs($id)
9131 return [list $x $y $z]
9134 proc showtag {tag isnew} {
9135 global ctext tagcontents tagids linknum tagobjid
9138 addtohistory [list showtag $tag 0]
9140 $ctext conf -state normal
9144 if {![info exists tagcontents($tag)]} {
9146 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9149 if {[info exists tagcontents($tag)]} {
9150 set text $tagcontents($tag)
9152 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
9154 appendwithlinks $text {}
9155 $ctext conf -state disabled
9167 if {[info exists gitktmpdir]} {
9168 catch {file delete -force $gitktmpdir}
9172 proc mkfontdisp {font top which} {
9173 global fontattr fontpref $font
9175 set fontpref($font) [set $font]
9176 button $top.${font}but -text $which -font optionfont \
9177 -command [list choosefont $font $which]
9178 label $top.$font -relief flat -font $font \
9179 -text $fontattr($font,family) -justify left
9180 grid x $top.${font}but $top.$font -sticky w
9183 proc choosefont {font which} {
9184 global fontparam fontlist fonttop fontattr
9186 set fontparam(which) $which
9187 set fontparam(font) $font
9188 set fontparam(family) [font actual $font -family]
9189 set fontparam(size) $fontattr($font,size)
9190 set fontparam(weight) $fontattr($font,weight)
9191 set fontparam(slant) $fontattr($font,slant)
9194 if {![winfo exists $top]} {
9196 eval font config sample [font actual $font]
9198 wm title $top [mc "Gitk font chooser"]
9199 label $top.l -textvariable fontparam(which)
9200 pack $top.l -side top
9201 set fontlist [lsort [font families]]
9203 listbox $top.f.fam -listvariable fontlist \
9204 -yscrollcommand [list $top.f.sb set]
9205 bind $top.f.fam <<ListboxSelect>> selfontfam
9206 scrollbar $top.f.sb -command [list $top.f.fam yview]
9207 pack $top.f.sb -side right -fill y
9208 pack $top.f.fam -side left -fill both -expand 1
9209 pack $top.f -side top -fill both -expand 1
9211 spinbox $top.g.size -from 4 -to 40 -width 4 \
9212 -textvariable fontparam(size) \
9213 -validatecommand {string is integer -strict %s}
9214 checkbutton $top.g.bold -padx 5 \
9215 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9216 -variable fontparam(weight) -onvalue bold -offvalue normal
9217 checkbutton $top.g.ital -padx 5 \
9218 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9219 -variable fontparam(slant) -onvalue italic -offvalue roman
9220 pack $top.g.size $top.g.bold $top.g.ital -side left
9221 pack $top.g -side top
9222 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9224 $top.c create text 100 25 -anchor center -text $which -font sample \
9225 -fill black -tags text
9226 bind $top.c <Configure> [list centertext $top.c]
9227 pack $top.c -side top -fill x
9229 button $top.buts.ok -text [mc "OK"] -command fontok -default active
9230 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9231 grid $top.buts.ok $top.buts.can
9232 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9233 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9234 pack $top.buts -side bottom -fill x
9235 trace add variable fontparam write chg_fontparam
9238 $top.c itemconf text -text $which
9240 set i [lsearch -exact $fontlist $fontparam(family)]
9242 $top.f.fam selection set $i
9247 proc centertext {w} {
9248 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9252 global fontparam fontpref prefstop
9254 set f $fontparam(font)
9255 set fontpref($f) [list $fontparam(family) $fontparam(size)]
9256 if {$fontparam(weight) eq "bold"} {
9257 lappend fontpref($f) "bold"
9259 if {$fontparam(slant) eq "italic"} {
9260 lappend fontpref($f) "italic"
9263 $w conf -text $fontparam(family) -font $fontpref($f)
9269 global fonttop fontparam
9271 if {[info exists fonttop]} {
9272 catch {destroy $fonttop}
9273 catch {font delete sample}
9279 proc selfontfam {} {
9280 global fonttop fontparam
9282 set i [$fonttop.f.fam curselection]
9284 set fontparam(family) [$fonttop.f.fam get $i]
9288 proc chg_fontparam {v sub op} {
9291 font config sample -$sub $fontparam($sub)
9295 global maxwidth maxgraphpct
9296 global oldprefs prefstop showneartags showlocalchanges
9297 global bgcolor fgcolor ctext diffcolors selectbgcolor
9298 global tabstop limitdiffs autoselect extdifftool
9302 if {[winfo exists $top]} {
9306 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9307 limitdiffs tabstop} {
9308 set oldprefs($v) [set $v]
9311 wm title $top [mc "Gitk preferences"]
9312 label $top.ldisp -text [mc "Commit list display options"]
9313 grid $top.ldisp - -sticky w -pady 10
9314 label $top.spacer -text " "
9315 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9317 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9318 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9319 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9321 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9322 grid x $top.maxpctl $top.maxpct -sticky w
9323 frame $top.showlocal
9324 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9325 checkbutton $top.showlocal.b -variable showlocalchanges
9326 pack $top.showlocal.b $top.showlocal.l -side left
9327 grid x $top.showlocal -sticky w
9328 frame $top.autoselect
9329 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9330 checkbutton $top.autoselect.b -variable autoselect
9331 pack $top.autoselect.b $top.autoselect.l -side left
9332 grid x $top.autoselect -sticky w
9334 label $top.ddisp -text [mc "Diff display options"]
9335 grid $top.ddisp - -sticky w -pady 10
9336 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9337 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9338 grid x $top.tabstopl $top.tabstop -sticky w
9340 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9341 checkbutton $top.ntag.b -variable showneartags
9342 pack $top.ntag.b $top.ntag.l -side left
9343 grid x $top.ntag -sticky w
9345 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9346 checkbutton $top.ldiff.b -variable limitdiffs
9347 pack $top.ldiff.b $top.ldiff.l -side left
9348 grid x $top.ldiff -sticky w
9350 entry $top.extdifft -textvariable extdifftool
9352 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9354 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9355 -command choose_extdiff
9356 pack $top.extdifff.l $top.extdifff.b -side left
9357 grid x $top.extdifff $top.extdifft -sticky w
9359 label $top.cdisp -text [mc "Colors: press to choose"]
9360 grid $top.cdisp - -sticky w -pady 10
9361 label $top.bg -padx 40 -relief sunk -background $bgcolor
9362 button $top.bgbut -text [mc "Background"] -font optionfont \
9363 -command [list choosecolor bgcolor {} $top.bg background setbg]
9364 grid x $top.bgbut $top.bg -sticky w
9365 label $top.fg -padx 40 -relief sunk -background $fgcolor
9366 button $top.fgbut -text [mc "Foreground"] -font optionfont \
9367 -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9368 grid x $top.fgbut $top.fg -sticky w
9369 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9370 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9371 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9372 [list $ctext tag conf d0 -foreground]]
9373 grid x $top.diffoldbut $top.diffold -sticky w
9374 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9375 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9376 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9377 [list $ctext tag conf d1 -foreground]]
9378 grid x $top.diffnewbut $top.diffnew -sticky w
9379 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9380 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9381 -command [list choosecolor diffcolors 2 $top.hunksep \
9382 "diff hunk header" \
9383 [list $ctext tag conf hunksep -foreground]]
9384 grid x $top.hunksepbut $top.hunksep -sticky w
9385 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9386 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9387 -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9388 grid x $top.selbgbut $top.selbgsep -sticky w
9390 label $top.cfont -text [mc "Fonts: press to choose"]
9391 grid $top.cfont - -sticky w -pady 10
9392 mkfontdisp mainfont $top [mc "Main font"]
9393 mkfontdisp textfont $top [mc "Diff display font"]
9394 mkfontdisp uifont $top [mc "User interface font"]
9397 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9398 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9399 grid $top.buts.ok $top.buts.can
9400 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9401 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9402 grid $top.buts - - -pady 10 -sticky ew
9403 bind $top <Visibility> "focus $top.buts.ok"
9406 proc choose_extdiff {} {
9409 set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9411 set extdifftool $prog
9415 proc choosecolor {v vi w x cmd} {
9418 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9419 -title [mc "Gitk: choose color for %s" $x]]
9420 if {$c eq {}} return
9421 $w conf -background $c
9427 global bglist cflist
9429 $w configure -selectbackground $c
9431 $cflist tag configure highlight \
9432 -background [$cflist cget -selectbackground]
9433 allcanvs itemconf secsel -fill $c
9440 $w conf -background $c
9448 $w conf -foreground $c
9450 allcanvs itemconf text -fill $c
9451 $canv itemconf circle -outline $c
9455 global oldprefs prefstop
9457 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9458 limitdiffs tabstop} {
9460 set $v $oldprefs($v)
9462 catch {destroy $prefstop}
9468 global maxwidth maxgraphpct
9469 global oldprefs prefstop showneartags showlocalchanges
9470 global fontpref mainfont textfont uifont
9471 global limitdiffs treediffs
9473 catch {destroy $prefstop}
9477 if {$mainfont ne $fontpref(mainfont)} {
9478 set mainfont $fontpref(mainfont)
9479 parsefont mainfont $mainfont
9480 eval font configure mainfont [fontflags mainfont]
9481 eval font configure mainfontbold [fontflags mainfont 1]
9485 if {$textfont ne $fontpref(textfont)} {
9486 set textfont $fontpref(textfont)
9487 parsefont textfont $textfont
9488 eval font configure textfont [fontflags textfont]
9489 eval font configure textfontbold [fontflags textfont 1]
9491 if {$uifont ne $fontpref(uifont)} {
9492 set uifont $fontpref(uifont)
9493 parsefont uifont $uifont
9494 eval font configure uifont [fontflags uifont]
9497 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9498 if {$showlocalchanges} {
9504 if {$limitdiffs != $oldprefs(limitdiffs)} {
9505 # treediffs elements are limited by path
9506 catch {unset treediffs}
9508 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9509 || $maxgraphpct != $oldprefs(maxgraphpct)} {
9511 } elseif {$showneartags != $oldprefs(showneartags) ||
9512 $limitdiffs != $oldprefs(limitdiffs)} {
9517 proc formatdate {d} {
9518 global datetimeformat
9520 set d [clock format $d -format $datetimeformat]
9525 # This list of encoding names and aliases is distilled from
9526 # http://www.iana.org/assignments/character-sets.
9527 # Not all of them are supported by Tcl.
9528 set encoding_aliases {
9529 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9530 ISO646-US US-ASCII us IBM367 cp367 csASCII }
9531 { ISO-10646-UTF-1 csISO10646UTF1 }
9532 { ISO_646.basic:1983 ref csISO646basic1983 }
9533 { INVARIANT csINVARIANT }
9534 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9535 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9536 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9537 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9538 { NATS-DANO iso-ir-9-1 csNATSDANO }
9539 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9540 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9541 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9542 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9543 { ISO-2022-KR csISO2022KR }
9545 { ISO-2022-JP csISO2022JP }
9546 { ISO-2022-JP-2 csISO2022JP2 }
9547 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9549 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9550 { IT iso-ir-15 ISO646-IT csISO15Italian }
9551 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9552 { ES iso-ir-17 ISO646-ES csISO17Spanish }
9553 { greek7-old iso-ir-18 csISO18Greek7Old }
9554 { latin-greek iso-ir-19 csISO19LatinGreek }
9555 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9556 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9557 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9558 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9559 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9560 { BS_viewdata iso-ir-47 csISO47BSViewdata }
9561 { INIS iso-ir-49 csISO49INIS }
9562 { INIS-8 iso-ir-50 csISO50INIS8 }
9563 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9564 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9565 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9566 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9567 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9568 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9570 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9571 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9572 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9573 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9574 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9575 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9576 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9577 { greek7 iso-ir-88 csISO88Greek7 }
9578 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9579 { iso-ir-90 csISO90 }
9580 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9581 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9582 csISO92JISC62991984b }
9583 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9584 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9585 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9586 csISO95JIS62291984handadd }
9587 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9588 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9589 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9590 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9592 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9593 { T.61-7bit iso-ir-102 csISO102T617bit }
9594 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9595 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9596 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9597 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9598 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9599 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9600 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9601 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9602 arabic csISOLatinArabic }
9603 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9604 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9605 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9606 greek greek8 csISOLatinGreek }
9607 { T.101-G2 iso-ir-128 csISO128T101G2 }
9608 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9610 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9611 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9612 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9613 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9614 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9615 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9616 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9617 csISOLatinCyrillic }
9618 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9619 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9620 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9621 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9622 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9623 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9624 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9625 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9626 { ISO_10367-box iso-ir-155 csISO10367Box }
9627 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9628 { latin-lap lap iso-ir-158 csISO158Lap }
9629 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9630 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9633 { JIS_X0201 X0201 csHalfWidthKatakana }
9634 { KSC5636 ISO646-KR csKSC5636 }
9635 { ISO-10646-UCS-2 csUnicode }
9636 { ISO-10646-UCS-4 csUCS4 }
9637 { DEC-MCS dec csDECMCS }
9638 { hp-roman8 roman8 r8 csHPRoman8 }
9639 { macintosh mac csMacintosh }
9640 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9642 { IBM038 EBCDIC-INT cp038 csIBM038 }
9643 { IBM273 CP273 csIBM273 }
9644 { IBM274 EBCDIC-BE CP274 csIBM274 }
9645 { IBM275 EBCDIC-BR cp275 csIBM275 }
9646 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9647 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9648 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9649 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9650 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9651 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9652 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9653 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9654 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9655 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9656 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9657 { IBM437 cp437 437 csPC8CodePage437 }
9658 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9659 { IBM775 cp775 csPC775Baltic }
9660 { IBM850 cp850 850 csPC850Multilingual }
9661 { IBM851 cp851 851 csIBM851 }
9662 { IBM852 cp852 852 csPCp852 }
9663 { IBM855 cp855 855 csIBM855 }
9664 { IBM857 cp857 857 csIBM857 }
9665 { IBM860 cp860 860 csIBM860 }
9666 { IBM861 cp861 861 cp-is csIBM861 }
9667 { IBM862 cp862 862 csPC862LatinHebrew }
9668 { IBM863 cp863 863 csIBM863 }
9669 { IBM864 cp864 csIBM864 }
9670 { IBM865 cp865 865 csIBM865 }
9671 { IBM866 cp866 866 csIBM866 }
9672 { IBM868 CP868 cp-ar csIBM868 }
9673 { IBM869 cp869 869 cp-gr csIBM869 }
9674 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9675 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9676 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9677 { IBM891 cp891 csIBM891 }
9678 { IBM903 cp903 csIBM903 }
9679 { IBM904 cp904 904 csIBBM904 }
9680 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9681 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9682 { IBM1026 CP1026 csIBM1026 }
9683 { EBCDIC-AT-DE csIBMEBCDICATDE }
9684 { EBCDIC-AT-DE-A csEBCDICATDEA }
9685 { EBCDIC-CA-FR csEBCDICCAFR }
9686 { EBCDIC-DK-NO csEBCDICDKNO }
9687 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9688 { EBCDIC-FI-SE csEBCDICFISE }
9689 { EBCDIC-FI-SE-A csEBCDICFISEA }
9690 { EBCDIC-FR csEBCDICFR }
9691 { EBCDIC-IT csEBCDICIT }
9692 { EBCDIC-PT csEBCDICPT }
9693 { EBCDIC-ES csEBCDICES }
9694 { EBCDIC-ES-A csEBCDICESA }
9695 { EBCDIC-ES-S csEBCDICESS }
9696 { EBCDIC-UK csEBCDICUK }
9697 { EBCDIC-US csEBCDICUS }
9698 { UNKNOWN-8BIT csUnknown8BiT }
9699 { MNEMONIC csMnemonic }
9704 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9705 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9706 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9707 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9708 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9709 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9710 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9711 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9712 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9713 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9714 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9715 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9716 { IBM1047 IBM-1047 }
9717 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9718 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9719 { UNICODE-1-1 csUnicode11 }
9722 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9723 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9725 { ISO-8859-15 ISO_8859-15 Latin-9 }
9726 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9727 { GBK CP936 MS936 windows-936 }
9728 { JIS_Encoding csJISEncoding }
9729 { Shift_JIS MS_Kanji csShiftJIS }
9730 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9732 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9733 { ISO-10646-UCS-Basic csUnicodeASCII }
9734 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9735 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9736 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9737 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9738 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9739 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9740 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9741 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9742 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9743 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9744 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9745 { Ventura-US csVenturaUS }
9746 { Ventura-International csVenturaInternational }
9747 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9748 { PC8-Turkish csPC8Turkish }
9749 { IBM-Symbols csIBMSymbols }
9750 { IBM-Thai csIBMThai }
9751 { HP-Legal csHPLegal }
9752 { HP-Pi-font csHPPiFont }
9753 { HP-Math8 csHPMath8 }
9754 { Adobe-Symbol-Encoding csHPPSMath }
9755 { HP-DeskTop csHPDesktop }
9756 { Ventura-Math csVenturaMath }
9757 { Microsoft-Publishing csMicrosoftPublishing }
9758 { Windows-31J csWindows31J }
9763 proc tcl_encoding {enc} {
9764 global encoding_aliases
9765 set names [encoding names]
9766 set lcnames [string tolower $names]
9767 set enc [string tolower $enc]
9768 set i [lsearch -exact $lcnames $enc]
9770 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9771 if {[regsub {^iso[-_]} $enc iso encx]} {
9772 set i [lsearch -exact $lcnames $encx]
9776 foreach l $encoding_aliases {
9777 set ll [string tolower $l]
9778 if {[lsearch -exact $ll $enc] < 0} continue
9779 # look through the aliases for one that tcl knows about
9781 set i [lsearch -exact $lcnames $e]
9783 if {[regsub {^iso[-_]} $e iso ex]} {
9784 set i [lsearch -exact $lcnames $ex]
9793 return [lindex $names $i]
9798 # First check that Tcl/Tk is recent enough
9799 if {[catch {package require Tk 8.4} err]} {
9800 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9801 Gitk requires at least Tcl/Tk 8.4."]
9806 set wrcomcmd "git diff-tree --stdin -p --pretty"
9810 set gitencoding [exec git config --get i18n.commitencoding]
9812 if {$gitencoding == ""} {
9813 set gitencoding "utf-8"
9815 set tclencoding [tcl_encoding $gitencoding]
9816 if {$tclencoding == {}} {
9817 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9820 set mainfont {Helvetica 9}
9821 set textfont {Courier 9}
9822 set uifont {Helvetica 9 bold}
9824 set findmergefiles 0
9832 set cmitmode "patch"
9833 set wrapcomment "none"
9837 set showlocalchanges 1
9839 set datetimeformat "%Y-%m-%d %H:%M:%S"
9842 set extdifftool "meld"
9844 set colors {green red blue magenta darkgrey brown orange}
9847 set diffcolors {red "#00a000" blue}
9850 set selectbgcolor gray85
9852 set circlecolors {white blue gray blue blue}
9854 ## For msgcat loading, first locate the installation location.
9855 if { [info exists ::env(GITK_MSGSDIR)] } {
9856 ## Msgsdir was manually set in the environment.
9857 set gitk_msgsdir $::env(GITK_MSGSDIR)
9859 ## Let's guess the prefix from argv0.
9860 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9861 set gitk_libdir [file join $gitk_prefix share gitk lib]
9862 set gitk_msgsdir [file join $gitk_libdir msgs]
9866 ## Internationalization (i18n) through msgcat and gettext. See
9867 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9868 package require msgcat
9869 namespace import ::msgcat::mc
9870 ## And eventually load the actual message catalog
9871 ::msgcat::mcload $gitk_msgsdir
9873 catch {source ~/.gitk}
9875 font create optionfont -family sans-serif -size -12
9877 parsefont mainfont $mainfont
9878 eval font create mainfont [fontflags mainfont]
9879 eval font create mainfontbold [fontflags mainfont 1]
9881 parsefont textfont $textfont
9882 eval font create textfont [fontflags textfont]
9883 eval font create textfontbold [fontflags textfont 1]
9885 parsefont uifont $uifont
9886 eval font create uifont [fontflags uifont]
9890 # check that we can find a .git directory somewhere...
9891 if {[catch {set gitdir [gitdir]}]} {
9892 show_error {} . [mc "Cannot find a git repository here."]
9895 if {![file isdirectory $gitdir]} {
9896 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9904 set cmdline_files {}
9906 set revtreeargscmd {}
9908 switch -glob -- $arg {
9911 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9914 "--select-commit=*" {
9915 set selecthead [string range $arg 16 end]
9918 set revtreeargscmd [string range $arg 10 end]
9921 lappend revtreeargs $arg
9927 if {$selecthead eq "HEAD"} {
9931 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9932 # no -- on command line, but some arguments (other than --argscmd)
9934 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9935 set cmdline_files [split $f "\n"]
9936 set n [llength $cmdline_files]
9937 set revtreeargs [lrange $revtreeargs 0 end-$n]
9938 # Unfortunately git rev-parse doesn't produce an error when
9939 # something is both a revision and a filename. To be consistent
9940 # with git log and git rev-list, check revtreeargs for filenames.
9941 foreach arg $revtreeargs {
9942 if {[file exists $arg]} {
9943 show_error {} . [mc "Ambiguous argument '%s': both revision\
9949 # unfortunately we get both stdout and stderr in $err,
9950 # so look for "fatal:".
9951 set i [string first "fatal:" $err]
9953 set err [string range $err [expr {$i + 6}] end]
9955 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9960 set nullid "0000000000000000000000000000000000000000"
9961 set nullid2 "0000000000000000000000000000000000000001"
9962 set nullfile "/dev/null"
9964 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9971 set highlight_paths {}
9973 set searchdirn -forwards
9977 set markingmatches 0
9978 set linkentercount 0
9979 set need_redisplay 0
9986 set selectedhlview [mc "None"]
9987 set highlight_related [mc "None"]
9988 set highlight_files {}
9992 set viewargscmd(0) {}
10002 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10005 # wait for the window to become visible
10006 tkwait visibility .
10007 wm title . "[file tail $argv0]: [file tail [pwd]]"
10010 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10011 # create a view for the files/dirs specified on the command line
10015 set viewname(1) [mc "Command line"]
10016 set viewfiles(1) $cmdline_files
10017 set viewargs(1) $revtreeargs
10018 set viewargscmd(1) $revtreeargscmd
10022 .bar.view entryconf [mc "Edit view..."] -state normal
10023 .bar.view entryconf [mc "Delete view"] -state normal
10026 if {[info exists permviews]} {
10027 foreach v $permviews {
10030 set viewname($n) [lindex $v 0]
10031 set viewfiles($n) [lindex $v 1]
10032 set viewargs($n) [lindex $v 2]
10033 set viewargscmd($n) [lindex $v 3]