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
"[mc "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
"[mc "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
"[mc "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 # Make a menu and submenus.
1754 # m is the window name for the menu, items is the list of menu items to add.
1755 # Each item is a list {mc label type description options...}
1756 # mc is ignored; it's so we can put mc there to alert xgettext
1757 # label is the string that appears in the menu
1758 # type is cascade, command or radiobutton (should add checkbutton)
1759 # description depends on type; it's the sublist for cascade, the
1760 # command to invoke for command, or {variable value} for radiobutton
1761 proc makemenu
{m items
} {
1764 set name
[mc
[lindex
$i 1]]
1765 set type [lindex
$i 2]
1766 set thing
[lindex
$i 3]
1767 set params
[list
$type]
1769 set u
[string first
"&" [string map
{&& x
} $name]]
1770 lappend params
-label [string map
{&& & & {}} $name]
1772 lappend params
-underline $u
1777 set submenu
[string tolower
[string map
{& ""} [lindex
$i 1]]]
1778 lappend params
-menu $m.
$submenu
1781 lappend params
-command $thing
1784 lappend params
-variable [lindex
$thing 0] \
1785 -value [lindex
$thing 1]
1788 eval $m add
$params [lrange
$i 4 end
]
1789 if {$type eq
"cascade"} {
1790 makemenu
$m.
$submenu $thing
1795 # translate string and remove ampersands
1797 return [string map
{&& & & {}} [mc
$str]]
1800 proc makewindow
{} {
1801 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1803 global findtype findtypemenu findloc findstring fstring geometry
1804 global entries sha1entry sha1string sha1but
1805 global diffcontextstring diffcontext
1807 global maincursor textcursor curtextcursor
1808 global rowctxmenu fakerowmenu mergemax wrapcomment
1809 global highlight_files gdttype
1810 global searchstring sstring
1811 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1812 global headctxmenu progresscanv progressitem progresscoords statusw
1813 global fprogitem fprogcoord lastprogupdate progupdatepending
1814 global rprogitem rprogcoord rownumsel numcommits
1817 # The "mc" arguments here are purely so that xgettext
1818 # sees the following string as needing to be translated
1820 {mc
"File" cascade
{
1821 {mc
"Update" command updatecommits
-accelerator F5
}
1822 {mc
"Reload" command reloadcommits
}
1823 {mc
"Reread references" command rereadrefs
}
1824 {mc
"List references" command showrefs
}
1825 {mc
"Quit" command doquit
}
1827 {mc
"Edit" cascade
{
1828 {mc
"Preferences" command doprefs
}
1830 {mc
"View" cascade
{
1831 {mc
"New view..." command {newview
0}}
1832 {mc
"Edit view..." command editview
-state disabled
}
1833 {mc
"Delete view" command delview
-state disabled
}
1835 {mc
"All files" radiobutton
{selectedview
0} -command {showview
0}}
1837 {mc
"Help" cascade
{
1838 {mc
"About gitk" command about
}
1839 {mc
"Key bindings" command keys
}
1842 . configure
-menu .bar
1844 # the gui has upper and lower half, parts of a paned window.
1845 panedwindow .ctop
-orient vertical
1847 # possibly use assumed geometry
1848 if {![info exists geometry
(pwsash0
)]} {
1849 set geometry
(topheight
) [expr {15 * $linespc}]
1850 set geometry
(topwidth
) [expr {80 * $charspc}]
1851 set geometry
(botheight
) [expr {15 * $linespc}]
1852 set geometry
(botwidth
) [expr {50 * $charspc}]
1853 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1854 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1857 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1858 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1860 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1862 # create three canvases
1863 set cscroll .tf.histframe.csb
1864 set canv .tf.histframe.pwclist.canv
1866 -selectbackground $selectbgcolor \
1867 -background $bgcolor -bd 0 \
1868 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1869 .tf.histframe.pwclist add
$canv
1870 set canv2 .tf.histframe.pwclist.canv2
1872 -selectbackground $selectbgcolor \
1873 -background $bgcolor -bd 0 -yscrollincr $linespc
1874 .tf.histframe.pwclist add
$canv2
1875 set canv3 .tf.histframe.pwclist.canv3
1877 -selectbackground $selectbgcolor \
1878 -background $bgcolor -bd 0 -yscrollincr $linespc
1879 .tf.histframe.pwclist add
$canv3
1880 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
1881 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
1883 # a scroll bar to rule them
1884 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
1885 pack
$cscroll -side right
-fill y
1886 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
1887 lappend bglist
$canv $canv2 $canv3
1888 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
1890 # we have two button bars at bottom of top frame. Bar 1
1892 frame .tf.lbar
-height 15
1894 set sha1entry .tf.bar.sha1
1895 set entries
$sha1entry
1896 set sha1but .tf.bar.sha1label
1897 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
1898 -command gotocommit
-width 8
1899 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
1900 pack .tf.bar.sha1label
-side left
1901 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
1902 trace add variable sha1string
write sha1change
1903 pack
$sha1entry -side left
-pady 2
1905 image create bitmap bm-left
-data {
1906 #define left_width 16
1907 #define left_height 16
1908 static unsigned char left_bits
[] = {
1909 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1910 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1911 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1913 image create bitmap bm-right
-data {
1914 #define right_width 16
1915 #define right_height 16
1916 static unsigned char right_bits
[] = {
1917 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1918 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1919 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1921 button .tf.bar.leftbut
-image bm-left
-command goback \
1922 -state disabled
-width 26
1923 pack .tf.bar.leftbut
-side left
-fill y
1924 button .tf.bar.rightbut
-image bm-right
-command goforw \
1925 -state disabled
-width 26
1926 pack .tf.bar.rightbut
-side left
-fill y
1928 label .tf.bar.rowlabel
-text [mc
"Row"]
1930 label .tf.bar.rownum
-width 7 -font textfont
-textvariable rownumsel \
1931 -relief sunken
-anchor e
1932 label .tf.bar.rowlabel2
-text "/"
1933 label .tf.bar.numcommits
-width 7 -font textfont
-textvariable numcommits \
1934 -relief sunken
-anchor e
1935 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
1938 trace add variable selectedline
write selectedline_change
1940 # Status label and progress bar
1941 set statusw .tf.bar.status
1942 label
$statusw -width 15 -relief sunken
1943 pack
$statusw -side left
-padx 5
1944 set h
[expr {[font metrics uifont
-linespace] + 2}]
1945 set progresscanv .tf.bar.progress
1946 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
1947 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
1948 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
1949 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
1950 pack
$progresscanv -side right
-expand 1 -fill x
1951 set progresscoords
{0 0}
1954 bind $progresscanv <Configure
> adjustprogress
1955 set lastprogupdate
[clock clicks
-milliseconds]
1956 set progupdatepending
0
1958 # build up the bottom bar of upper window
1959 label .tf.lbar.flabel
-text "[mc "Find
"] "
1960 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
1961 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
1962 label .tf.lbar.flab2
-text " [mc "commit
"] "
1963 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1965 set gdttype
[mc
"containing:"]
1966 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
1967 [mc
"containing:"] \
1968 [mc
"touching paths:"] \
1969 [mc
"adding/removing string:"]]
1970 trace add variable gdttype
write gdttype_change
1971 pack .tf.lbar.gdttype
-side left
-fill y
1974 set fstring .tf.lbar.findstring
1975 lappend entries
$fstring
1976 entry
$fstring -width 30 -font textfont
-textvariable findstring
1977 trace add variable findstring
write find_change
1978 set findtype
[mc
"Exact"]
1979 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
1980 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
1981 trace add variable findtype
write findcom_change
1982 set findloc
[mc
"All fields"]
1983 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
1984 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
1985 trace add variable findloc
write find_change
1986 pack .tf.lbar.findloc
-side right
1987 pack .tf.lbar.findtype
-side right
1988 pack
$fstring -side left
-expand 1 -fill x
1990 # Finish putting the upper half of the viewer together
1991 pack .tf.lbar
-in .tf
-side bottom
-fill x
1992 pack .tf.bar
-in .tf
-side bottom
-fill x
1993 pack .tf.histframe
-fill both
-side top
-expand 1
1995 .ctop paneconfigure .tf
-height $geometry(topheight
)
1996 .ctop paneconfigure .tf
-width $geometry(topwidth
)
1998 # now build up the bottom
1999 panedwindow .pwbottom
-orient horizontal
2001 # lower left, a text box over search bar, scroll bar to the right
2002 # if we know window height, then that will set the lower text height, otherwise
2003 # we set lower text height which will drive window height
2004 if {[info exists geometry
(main
)]} {
2005 frame .bleft
-width $geometry(botwidth
)
2007 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
2013 button .bleft.top.search
-text [mc
"Search"] -command dosearch
2014 pack .bleft.top.search
-side left
-padx 5
2015 set sstring .bleft.top.sstring
2016 entry
$sstring -width 20 -font textfont
-textvariable searchstring
2017 lappend entries
$sstring
2018 trace add variable searchstring
write incrsearch
2019 pack
$sstring -side left
-expand 1 -fill x
2020 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
2021 -command changediffdisp
-variable diffelide
-value {0 0}
2022 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
2023 -command changediffdisp
-variable diffelide
-value {0 1}
2024 radiobutton .bleft.mid.new
-text [mc
"New version"] \
2025 -command changediffdisp
-variable diffelide
-value {1 0}
2026 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
2027 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
2028 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
2029 -from 1 -increment 1 -to 10000000 \
2030 -validate all
-validatecommand "diffcontextvalidate %P" \
2031 -textvariable diffcontextstring
2032 .bleft.mid.diffcontext
set $diffcontext
2033 trace add variable diffcontextstring
write diffcontextchange
2034 lappend entries .bleft.mid.diffcontext
2035 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
2036 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
2037 -command changeignorespace
-variable ignorespace
2038 pack .bleft.mid.ignspace
-side left
-padx 5
2039 set ctext .bleft.bottom.ctext
2040 text
$ctext -background $bgcolor -foreground $fgcolor \
2041 -state disabled
-font textfont \
2042 -yscrollcommand scrolltext
-wrap none \
2043 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2045 $ctext conf
-tabstyle wordprocessor
2047 scrollbar .bleft.bottom.sb
-command "$ctext yview"
2048 scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h \
2050 pack .bleft.top
-side top
-fill x
2051 pack .bleft.mid
-side top
-fill x
2052 grid
$ctext .bleft.bottom.sb
-sticky nsew
2053 grid .bleft.bottom.sbhorizontal
-sticky ew
2054 grid columnconfigure .bleft.bottom
0 -weight 1
2055 grid rowconfigure .bleft.bottom
0 -weight 1
2056 grid rowconfigure .bleft.bottom
1 -weight 0
2057 pack .bleft.bottom
-side top
-fill both
-expand 1
2058 lappend bglist
$ctext
2059 lappend fglist
$ctext
2061 $ctext tag conf comment
-wrap $wrapcomment
2062 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
2063 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
2064 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
2065 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
2066 $ctext tag conf m0
-fore red
2067 $ctext tag conf m1
-fore blue
2068 $ctext tag conf m2
-fore green
2069 $ctext tag conf m3
-fore purple
2070 $ctext tag conf
m4 -fore brown
2071 $ctext tag conf m5
-fore "#009090"
2072 $ctext tag conf m6
-fore magenta
2073 $ctext tag conf m7
-fore "#808000"
2074 $ctext tag conf m8
-fore "#009000"
2075 $ctext tag conf m9
-fore "#ff0080"
2076 $ctext tag conf m10
-fore cyan
2077 $ctext tag conf m11
-fore "#b07070"
2078 $ctext tag conf m12
-fore "#70b0f0"
2079 $ctext tag conf m13
-fore "#70f0b0"
2080 $ctext tag conf m14
-fore "#f0b070"
2081 $ctext tag conf m15
-fore "#ff70b0"
2082 $ctext tag conf mmax
-fore darkgrey
2084 $ctext tag conf mresult
-font textfontbold
2085 $ctext tag conf msep
-font textfontbold
2086 $ctext tag conf found
-back yellow
2088 .pwbottom add .bleft
2089 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
2094 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
2095 -command reselectline
-variable cmitmode
-value "patch"
2096 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
2097 -command reselectline
-variable cmitmode
-value "tree"
2098 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
2099 pack .bright.mode
-side top
-fill x
2100 set cflist .bright.cfiles
2101 set indent
[font measure mainfont
"nn"]
2103 -selectbackground $selectbgcolor \
2104 -background $bgcolor -foreground $fgcolor \
2106 -tabs [list
$indent [expr {2 * $indent}]] \
2107 -yscrollcommand ".bright.sb set" \
2108 -cursor [. cget
-cursor] \
2109 -spacing1 1 -spacing3 1
2110 lappend bglist
$cflist
2111 lappend fglist
$cflist
2112 scrollbar .bright.sb
-command "$cflist yview"
2113 pack .bright.sb
-side right
-fill y
2114 pack
$cflist -side left
-fill both
-expand 1
2115 $cflist tag configure highlight \
2116 -background [$cflist cget
-selectbackground]
2117 $cflist tag configure bold
-font mainfontbold
2119 .pwbottom add .bright
2122 # restore window width & height if known
2123 if {[info exists geometry
(main
)]} {
2124 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
2125 if {$w > [winfo screenwidth .
]} {
2126 set w
[winfo screenwidth .
]
2128 if {$h > [winfo screenheight .
]} {
2129 set h
[winfo screenheight .
]
2131 wm geometry .
"${w}x$h"
2135 if {[tk windowingsystem
] eq
{aqua
}} {
2141 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2142 pack .ctop
-fill both
-expand 1
2143 bindall
<1> {selcanvline
%W
%x
%y
}
2144 #bindall <B1-Motion> {selcanvline %W %x %y}
2145 if {[tk windowingsystem
] == "win32"} {
2146 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2147 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2149 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2150 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2151 if {[tk windowingsystem
] eq
"aqua"} {
2152 bindall
<MouseWheel
> {
2153 set delta
[expr {- (%D
)}]
2154 allcanvs yview scroll
$delta units
2158 bindall
<2> "canvscan mark %W %x %y"
2159 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
2160 bindkey
<Home
> selfirstline
2161 bindkey
<End
> sellastline
2162 bind .
<Key-Up
> "selnextline -1"
2163 bind .
<Key-Down
> "selnextline 1"
2164 bind .
<Shift-Key-Up
> "dofind -1 0"
2165 bind .
<Shift-Key-Down
> "dofind 1 0"
2166 bindkey
<Key-Right
> "goforw"
2167 bindkey
<Key-Left
> "goback"
2168 bind .
<Key-Prior
> "selnextpage -1"
2169 bind .
<Key-Next
> "selnextpage 1"
2170 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2171 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2172 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2173 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2174 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2175 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2176 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2177 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2178 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2179 bindkey p
"selnextline -1"
2180 bindkey n
"selnextline 1"
2183 bindkey i
"selnextline -1"
2184 bindkey k
"selnextline 1"
2188 bindkey d
"$ctext yview scroll 18 units"
2189 bindkey u
"$ctext yview scroll -18 units"
2190 bindkey
/ {dofind
1 1}
2191 bindkey
<Key-Return
> {dofind
1 1}
2192 bindkey ?
{dofind
-1 1}
2194 bindkey
<F5
> updatecommits
2195 bind .
<$M1B-q> doquit
2196 bind .
<$M1B-f> {dofind
1 1}
2197 bind .
<$M1B-g> {dofind
1 0}
2198 bind .
<$M1B-r> dosearchback
2199 bind .
<$M1B-s> dosearch
2200 bind .
<$M1B-equal> {incrfont
1}
2201 bind .
<$M1B-plus> {incrfont
1}
2202 bind .
<$M1B-KP_Add> {incrfont
1}
2203 bind .
<$M1B-minus> {incrfont
-1}
2204 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2205 wm protocol . WM_DELETE_WINDOW doquit
2206 bind .
<Destroy
> {stop_backends
}
2207 bind .
<Button-1
> "click %W"
2208 bind $fstring <Key-Return
> {dofind
1 1}
2209 bind $sha1entry <Key-Return
> {gotocommit
; break}
2210 bind $sha1entry <<PasteSelection>> clearsha1
2211 bind $cflist <1> {sel_flist %W %x %y; break}
2212 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2213 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2215 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2217 set maincursor [. cget -cursor]
2218 set textcursor [$ctext cget -cursor]
2219 set curtextcursor $textcursor
2221 set rowctxmenu .rowctxmenu
2222 makemenu $rowctxmenu {
2223 {mc "Diff this -> selected" command {diffvssel 0}}
2224 {mc "Diff selected -> this" command {diffvssel 1}}
2225 {mc "Make patch" command mkpatch}
2226 {mc "Create tag" command mktag}
2227 {mc "Write commit to file" command writecommit}
2228 {mc "Create new branch" command mkbranch}
2229 {mc "Cherry-pick this commit" command cherrypick}
2230 {mc "Reset HEAD branch to here" command resethead}
2232 $rowctxmenu configure -tearoff 0
2234 set fakerowmenu .fakerowmenu
2235 makemenu $fakerowmenu {
2236 {mc "Diff this -> selected" command {diffvssel 0}}
2237 {mc "Diff selected -> this" command {diffvssel 1}}
2238 {mc "Make patch" command mkpatch}
2240 $fakerowmenu configure -tearoff 0
2242 set headctxmenu .headctxmenu
2243 makemenu $headctxmenu {
2244 {mc "Check out this branch" command cobranch}
2245 {mc "Remove this branch" command rmbranch}
2247 $headctxmenu configure -tearoff 0
2250 set flist_menu .flistctxmenu
2251 makemenu $flist_menu {
2252 {mc "Highlight this too" command {flist_hl 0}}
2253 {mc "Highlight this only" command {flist_hl 1}}
2254 {mc "External diff" command {external_diff}}
2255 {mc "Blame parent commit" command {external_blame 1}}
2257 $flist_menu configure -tearoff 0
2260 # Windows sends all mouse wheel events to the current focused window, not
2261 # the one where the mouse hovers, so bind those events here and redirect
2262 # to the correct window
2263 proc windows_mousewheel_redirector {W X Y D} {
2264 global canv canv2 canv3
2265 set w [winfo containing -displayof $W $X $Y]
2267 set u [expr {$D < 0 ? 5 : -5}]
2268 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2269 allcanvs yview scroll $u units
2272 $w yview scroll $u units
2278 # Update row number label when selectedline changes
2279 proc selectedline_change {n1 n2 op} {
2280 global selectedline rownumsel
2282 if {$selectedline eq {}} {
2285 set rownumsel [expr {$selectedline + 1}]
2289 # mouse-2 makes all windows scan vertically, but only the one
2290 # the cursor is in scans horizontally
2291 proc canvscan {op w x y} {
2292 global canv canv2 canv3
2293 foreach c [list $canv $canv2 $canv3] {
2302 proc scrollcanv {cscroll f0 f1} {
2303 $cscroll set $f0 $f1
2308 # when we make a key binding for the toplevel, make sure
2309 # it doesn't get triggered when that key is pressed in the
2310 # find string entry widget.
2311 proc bindkey {ev script} {
2314 set escript [bind Entry $ev]
2315 if {$escript == {}} {
2316 set escript [bind Entry <Key>]
2318 foreach e $entries {
2319 bind $e $ev "$escript; break"
2323 # set the focus back to the toplevel for any click outside
2326 global ctext entries
2327 foreach e [concat $entries $ctext] {
2328 if {$w == $e} return
2333 # Adjust the progress bar for a change in requested extent or canvas size
2334 proc adjustprogress {} {
2335 global progresscanv progressitem progresscoords
2336 global fprogitem fprogcoord lastprogupdate progupdatepending
2337 global rprogitem rprogcoord
2339 set w [expr {[winfo width $progresscanv] - 4}]
2340 set x0 [expr {$w * [lindex $progresscoords 0]}]
2341 set x1 [expr {$w * [lindex $progresscoords 1]}]
2342 set h [winfo height $progresscanv]
2343 $progresscanv coords $progressitem $x0 0 $x1 $h
2344 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2345 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2346 set now [clock clicks -milliseconds]
2347 if {$now >= $lastprogupdate + 100} {
2348 set progupdatepending 0
2350 } elseif {!$progupdatepending} {
2351 set progupdatepending 1
2352 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2356 proc doprogupdate {} {
2357 global lastprogupdate progupdatepending
2359 if {$progupdatepending} {
2360 set progupdatepending 0
2361 set lastprogupdate [clock clicks -milliseconds]
2366 proc savestuff {w} {
2367 global canv canv2 canv3 mainfont textfont uifont tabstop
2368 global stuffsaved findmergefiles maxgraphpct
2369 global maxwidth showneartags showlocalchanges
2370 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2371 global cmitmode wrapcomment datetimeformat limitdiffs
2372 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2373 global autoselect extdifftool perfile_attrs
2375 if {$stuffsaved} return
2376 if {![winfo viewable .]} return
2378 set f [open "~/.gitk-new" w]
2379 puts $f [list set mainfont $mainfont]
2380 puts $f [list set textfont $textfont]
2381 puts $f [list set uifont $uifont]
2382 puts $f [list set tabstop $tabstop]
2383 puts $f [list set findmergefiles $findmergefiles]
2384 puts $f [list set maxgraphpct $maxgraphpct]
2385 puts $f [list set maxwidth $maxwidth]
2386 puts $f [list set cmitmode $cmitmode]
2387 puts $f [list set wrapcomment $wrapcomment]
2388 puts $f [list set autoselect $autoselect]
2389 puts $f [list set showneartags $showneartags]
2390 puts $f [list set showlocalchanges $showlocalchanges]
2391 puts $f [list set datetimeformat $datetimeformat]
2392 puts $f [list set limitdiffs $limitdiffs]
2393 puts $f [list set bgcolor $bgcolor]
2394 puts $f [list set fgcolor $fgcolor]
2395 puts $f [list set colors $colors]
2396 puts $f [list set diffcolors $diffcolors]
2397 puts $f [list set diffcontext $diffcontext]
2398 puts $f [list set selectbgcolor $selectbgcolor]
2399 puts $f [list set extdifftool $extdifftool]
2400 puts $f [list set perfile_attrs $perfile_attrs]
2402 puts $f "set geometry(main) [wm geometry .]"
2403 puts $f "set geometry(topwidth) [winfo width .tf]"
2404 puts $f "set geometry(topheight) [winfo height .tf]"
2405 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2406 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2407 puts $f "set geometry(botwidth) [winfo width .bleft]"
2408 puts $f "set geometry(botheight) [winfo height .bleft]"
2410 puts -nonewline $f "set permviews {"
2411 for {set v 0} {$v < $nextviewnum} {incr v} {
2412 if {$viewperm($v)} {
2413 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2418 file rename -force "~/.gitk-new" "~/.gitk"
2423 proc resizeclistpanes {win w} {
2425 if {[info exists oldwidth($win)]} {
2426 set s0 [$win sash coord 0]
2427 set s1 [$win sash coord 1]
2429 set sash0 [expr {int($w/2 - 2)}]
2430 set sash1 [expr {int($w*5/6 - 2)}]
2432 set factor [expr {1.0 * $w / $oldwidth($win)}]
2433 set sash0 [expr {int($factor * [lindex $s0 0])}]
2434 set sash1 [expr {int($factor * [lindex $s1 0])}]
2438 if {$sash1 < $sash0 + 20} {
2439 set sash1 [expr {$sash0 + 20}]
2441 if {$sash1 > $w - 10} {
2442 set sash1 [expr {$w - 10}]
2443 if {$sash0 > $sash1 - 20} {
2444 set sash0 [expr {$sash1 - 20}]
2448 $win sash place 0 $sash0 [lindex $s0 1]
2449 $win sash place 1 $sash1 [lindex $s1 1]
2451 set oldwidth($win) $w
2454 proc resizecdetpanes {win w} {
2456 if {[info exists oldwidth($win)]} {
2457 set s0 [$win sash coord 0]
2459 set sash0 [expr {int($w*3/4 - 2)}]
2461 set factor [expr {1.0 * $w / $oldwidth($win)}]
2462 set sash0 [expr {int($factor * [lindex $s0 0])}]
2466 if {$sash0 > $w - 15} {
2467 set sash0 [expr {$w - 15}]
2470 $win sash place 0 $sash0 [lindex $s0 1]
2472 set oldwidth($win) $w
2475 proc allcanvs args {
2476 global canv canv2 canv3
2482 proc bindall {event action} {
2483 global canv canv2 canv3
2484 bind $canv $event $action
2485 bind $canv2 $event $action
2486 bind $canv3 $event $action
2492 if {[winfo exists $w]} {
2497 wm title $w [mc "About gitk"]
2498 message $w.m -text [mc "
2499 Gitk - a commit viewer for git
2501 Copyright © 2005-2008 Paul Mackerras
2503 Use and redistribute under the terms of the GNU General Public License"] \
2504 -justify center -aspect 400 -border 2 -bg white -relief groove
2505 pack $w.m -side top -fill x -padx 2 -pady 2
2506 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2507 pack $w.ok -side bottom
2508 bind $w <Visibility> "focus $w.ok"
2509 bind $w <Key-Escape> "destroy $w"
2510 bind $w <Key-Return> "destroy $w"
2515 if {[winfo exists $w]} {
2519 if {[tk windowingsystem] eq {aqua}} {
2525 wm title $w [mc "Gitk key bindings"]
2526 message $w.m -text "
2527 [mc "Gitk key bindings:"]
2529 [mc "<%s-Q> Quit" $M1T]
2530 [mc "<Home> Move to first commit"]
2531 [mc "<End> Move to last commit"]
2532 [mc "<Up>, p, i Move up one commit"]
2533 [mc "<Down>, n, k Move down one commit"]
2534 [mc "<Left>, z, j Go back in history list"]
2535 [mc "<Right>, x, l Go forward in history list"]
2536 [mc "<PageUp> Move up one page in commit list"]
2537 [mc "<PageDown> Move down one page in commit list"]
2538 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2539 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2540 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2541 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2542 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2543 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2544 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2545 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2546 [mc "<Delete>, b Scroll diff view up one page"]
2547 [mc "<Backspace> Scroll diff view up one page"]
2548 [mc "<Space> Scroll diff view down one page"]
2549 [mc "u Scroll diff view up 18 lines"]
2550 [mc "d Scroll diff view down 18 lines"]
2551 [mc "<%s-F> Find" $M1T]
2552 [mc "<%s-G> Move to next find hit" $M1T]
2553 [mc "<Return> Move to next find hit"]
2554 [mc "/ Move to next find hit, or redo find"]
2555 [mc "? Move to previous find hit"]
2556 [mc "f Scroll diff view to next file"]
2557 [mc "<%s-S> Search for next hit in diff view" $M1T]
2558 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2559 [mc "<%s-KP+> Increase font size" $M1T]
2560 [mc "<%s-plus> Increase font size" $M1T]
2561 [mc "<%s-KP-> Decrease font size" $M1T]
2562 [mc "<%s-minus> Decrease font size" $M1T]
2565 -justify left -bg white -border 2 -relief groove
2566 pack $w.m -side top -fill both -padx 2 -pady 2
2567 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2568 pack $w.ok -side bottom
2569 bind $w <Visibility> "focus $w.ok"
2570 bind $w <Key-Escape> "destroy $w"
2571 bind $w <Key-Return> "destroy $w"
2574 # Procedures for manipulating the file list window at the
2575 # bottom right of the overall window.
2577 proc treeview {w l openlevs} {
2578 global treecontents treediropen treeheight treeparent treeindex
2588 set treecontents() {}
2589 $w conf -state normal
2591 while {[string range $f 0 $prefixend] ne $prefix} {
2592 if {$lev <= $openlevs} {
2593 $w mark set e:$treeindex($prefix) "end -1c"
2594 $w mark gravity e:$treeindex($prefix) left
2596 set treeheight($prefix) $ht
2597 incr ht [lindex $htstack end]
2598 set htstack [lreplace $htstack end end]
2599 set prefixend [lindex $prefendstack end]
2600 set prefendstack [lreplace $prefendstack end end]
2601 set prefix [string range $prefix 0 $prefixend]
2604 set tail [string range $f [expr {$prefixend+1}] end]
2605 while {[set slash [string first "/" $tail]] >= 0} {
2608 lappend prefendstack $prefixend
2609 incr prefixend [expr {$slash + 1}]
2610 set d [string range $tail 0 $slash]
2611 lappend treecontents($prefix) $d
2612 set oldprefix $prefix
2614 set treecontents($prefix) {}
2615 set treeindex($prefix) [incr ix]
2616 set treeparent($prefix) $oldprefix
2617 set tail [string range $tail [expr {$slash+1}] end]
2618 if {$lev <= $openlevs} {
2620 set treediropen($prefix) [expr {$lev < $openlevs}]
2621 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2622 $w mark set d:$ix "end -1c"
2623 $w mark gravity d:$ix left
2625 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2627 $w image create end -align center -image $bm -padx 1 \
2629 $w insert end $d [highlight_tag $prefix]
2630 $w mark set s:$ix "end -1c"
2631 $w mark gravity s:$ix left
2636 if {$lev <= $openlevs} {
2639 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2641 $w insert end $tail [highlight_tag $f]
2643 lappend treecontents($prefix) $tail
2646 while {$htstack ne {}} {
2647 set treeheight($prefix) $ht
2648 incr ht [lindex $htstack end]
2649 set htstack [lreplace $htstack end end]
2650 set prefixend [lindex $prefendstack end]
2651 set prefendstack [lreplace $prefendstack end end]
2652 set prefix [string range $prefix 0 $prefixend]
2654 $w conf -state disabled
2657 proc linetoelt {l} {
2658 global treeheight treecontents
2663 foreach e $treecontents($prefix) {
2668 if {[string index $e end] eq "/"} {
2669 set n $treeheight($prefix$e)
2681 proc highlight_tree {y prefix} {
2682 global treeheight treecontents cflist
2684 foreach e $treecontents($prefix) {
2686 if {[highlight_tag $path] ne {}} {
2687 $cflist tag add bold $y.0 "$y.0 lineend"
2690 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2691 set y [highlight_tree $y $path]
2697 proc treeclosedir {w dir} {
2698 global treediropen treeheight treeparent treeindex
2700 set ix $treeindex($dir)
2701 $w conf -state normal
2702 $w delete s:$ix e:$ix
2703 set treediropen($dir) 0
2704 $w image configure a:$ix -image tri-rt
2705 $w conf -state disabled
2706 set n [expr {1 - $treeheight($dir)}]
2707 while {$dir ne {}} {
2708 incr treeheight($dir) $n
2709 set dir $treeparent($dir)
2713 proc treeopendir {w dir} {
2714 global treediropen treeheight treeparent treecontents treeindex
2716 set ix $treeindex($dir)
2717 $w conf -state normal
2718 $w image configure a:$ix -image tri-dn
2719 $w mark set e:$ix s:$ix
2720 $w mark gravity e:$ix right
2723 set n [llength $treecontents($dir)]
2724 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2727 incr treeheight($x) $n
2729 foreach e $treecontents($dir) {
2731 if {[string index $e end] eq "/"} {
2732 set iy $treeindex($de)
2733 $w mark set d:$iy e:$ix
2734 $w mark gravity d:$iy left
2735 $w insert e:$ix $str
2736 set treediropen($de) 0
2737 $w image create e:$ix -align center -image tri-rt -padx 1 \
2739 $w insert e:$ix $e [highlight_tag $de]
2740 $w mark set s:$iy e:$ix
2741 $w mark gravity s:$iy left
2742 set treeheight($de) 1
2744 $w insert e:$ix $str
2745 $w insert e:$ix $e [highlight_tag $de]
2748 $w mark gravity e:$ix right
2749 $w conf -state disabled
2750 set treediropen($dir) 1
2751 set top [lindex [split [$w index @0,0] .] 0]
2752 set ht [$w cget -height]
2753 set l [lindex [split [$w index s:$ix] .] 0]
2756 } elseif {$l + $n + 1 > $top + $ht} {
2757 set top [expr {$l + $n + 2 - $ht}]
2765 proc treeclick {w x y} {
2766 global treediropen cmitmode ctext cflist cflist_top
2768 if {$cmitmode ne "tree"} return
2769 if {![info exists cflist_top]} return
2770 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2771 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2772 $cflist tag add highlight $l.0 "$l.0 lineend"
2778 set e [linetoelt $l]
2779 if {[string index $e end] ne "/"} {
2781 } elseif {$treediropen($e)} {
2788 proc setfilelist {id} {
2789 global treefilelist cflist
2791 treeview $cflist $treefilelist($id) 0
2794 image create bitmap tri-rt -background black -foreground blue -data {
2795 #define tri-rt_width 13
2796 #define tri-rt_height 13
2797 static unsigned char tri-rt_bits[] = {
2798 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2799 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2802 #define tri-rt-mask_width 13
2803 #define tri-rt-mask_height 13
2804 static unsigned char tri-rt-mask_bits[] = {
2805 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2806 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2809 image create bitmap tri-dn -background black -foreground blue -data {
2810 #define tri-dn_width 13
2811 #define tri-dn_height 13
2812 static unsigned char tri-dn_bits[] = {
2813 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2814 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2817 #define tri-dn-mask_width 13
2818 #define tri-dn-mask_height 13
2819 static unsigned char tri-dn-mask_bits[] = {
2820 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2821 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2825 image create bitmap reficon-T -background black -foreground yellow -data {
2826 #define tagicon_width 13
2827 #define tagicon_height 9
2828 static unsigned char tagicon_bits[] = {
2829 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2830 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2832 #define tagicon-mask_width 13
2833 #define tagicon-mask_height 9
2834 static unsigned char tagicon-mask_bits[] = {
2835 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2836 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2839 #define headicon_width 13
2840 #define headicon_height 9
2841 static unsigned char headicon_bits[] = {
2842 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2843 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2846 #define headicon-mask_width 13
2847 #define headicon-mask_height 9
2848 static unsigned char headicon-mask_bits[] = {
2849 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2850 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2852 image create bitmap reficon-H -background black -foreground green \
2853 -data $rectdata -maskdata $rectmask
2854 image create bitmap reficon-o -background black -foreground "#ddddff" \
2855 -data $rectdata -maskdata $rectmask
2857 proc init_flist {first} {
2858 global cflist cflist_top difffilestart
2860 $cflist conf -state normal
2861 $cflist delete 0.0 end
2863 $cflist insert end $first
2865 $cflist tag add highlight 1.0 "1.0 lineend"
2867 catch {unset cflist_top}
2869 $cflist conf -state disabled
2870 set difffilestart {}
2873 proc highlight_tag {f} {
2874 global highlight_paths
2876 foreach p $highlight_paths {
2877 if {[string match $p $f]} {
2884 proc highlight_filelist {} {
2885 global cmitmode cflist
2887 $cflist conf -state normal
2888 if {$cmitmode ne "tree"} {
2889 set end [lindex [split [$cflist index end] .] 0]
2890 for {set l 2} {$l < $end} {incr l} {
2891 set line [$cflist get $l.0 "$l.0 lineend"]
2892 if {[highlight_tag $line] ne {}} {
2893 $cflist tag add bold $l.0 "$l.0 lineend"
2899 $cflist conf -state disabled
2902 proc unhighlight_filelist {} {
2905 $cflist conf -state normal
2906 $cflist tag remove bold 1.0 end
2907 $cflist conf -state disabled
2910 proc add_flist {fl} {
2913 $cflist conf -state normal
2915 $cflist insert end "\n"
2916 $cflist insert end $f [highlight_tag $f]
2918 $cflist conf -state disabled
2921 proc sel_flist {w x y} {
2922 global ctext difffilestart cflist cflist_top cmitmode
2924 if {$cmitmode eq "tree"} return
2925 if {![info exists cflist_top]} return
2926 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2927 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2928 $cflist tag add highlight $l.0 "$l.0 lineend"
2933 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2937 proc pop_flist_menu {w X Y x y} {
2938 global ctext cflist cmitmode flist_menu flist_menu_file
2939 global treediffs diffids
2942 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2944 if {$cmitmode eq "tree"} {
2945 set e [linetoelt $l]
2946 if {[string index $e end] eq "/"} return
2948 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2950 set flist_menu_file $e
2951 set xdiffstate "normal"
2952 if {$cmitmode eq "tree"} {
2953 set xdiffstate "disabled"
2955 # Disable "External diff" item in tree mode
2956 $flist_menu entryconf 2 -state $xdiffstate
2957 tk_popup $flist_menu $X $Y
2960 proc flist_hl {only} {
2961 global flist_menu_file findstring gdttype
2963 set x [shellquote $flist_menu_file]
2964 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2967 append findstring " " $x
2969 set gdttype [mc "touching paths:"]
2972 proc save_file_from_commit {filename output what} {
2975 if {[catch {exec git show $filename -- > $output} err]} {
2976 if {[string match "fatal: bad revision *" $err]} {
2979 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
2985 proc external_diff_get_one_file {diffid filename diffdir} {
2986 global nullid nullid2 nullfile
2989 if {$diffid == $nullid} {
2990 set difffile [file join [file dirname $gitdir] $filename]
2991 if {[file exists $difffile]} {
2996 if {$diffid == $nullid2} {
2997 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
2998 return [save_file_from_commit :$filename $difffile index]
3000 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3001 return [save_file_from_commit $diffid:$filename $difffile \
3005 proc external_diff {} {
3006 global gitktmpdir nullid nullid2
3007 global flist_menu_file
3010 global gitdir extdifftool
3012 if {[llength $diffids] == 1} {
3013 # no reference commit given
3014 set diffidto [lindex $diffids 0]
3015 if {$diffidto eq $nullid} {
3016 # diffing working copy with index
3017 set diffidfrom $nullid2
3018 } elseif {$diffidto eq $nullid2} {
3019 # diffing index with HEAD
3020 set diffidfrom "HEAD"
3022 # use first parent commit
3023 global parentlist selectedline
3024 set diffidfrom [lindex $parentlist $selectedline 0]
3027 set diffidfrom [lindex $diffids 0]
3028 set diffidto [lindex $diffids 1]
3031 # make sure that several diffs wont collide
3032 if {![info exists gitktmpdir]} {
3033 set gitktmpdir [file join [file dirname $gitdir] \
3034 [format ".gitk-tmp.%s" [pid]]]
3035 if {[catch {file mkdir $gitktmpdir} err]} {
3036 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3043 set diffdir [file join $gitktmpdir $diffnum]
3044 if {[catch {file mkdir $diffdir} err]} {
3045 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3049 # gather files to diff
3050 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3051 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3053 if {$difffromfile ne {} && $difftofile ne {}} {
3054 set cmd [concat | [shellsplit $extdifftool] \
3055 [list $difffromfile $difftofile]]
3056 if {[catch {set fl [open $cmd r]} err]} {
3057 file delete -force $diffdir
3058 error_popup "$extdifftool: [mc "command failed:"] $err"
3060 fconfigure $fl -blocking 0
3061 filerun $fl [list delete_at_eof $fl $diffdir]
3066 proc external_blame {parent_idx} {
3067 global flist_menu_file
3068 global nullid nullid2
3069 global parentlist selectedline currentid
3071 if {$parent_idx > 0} {
3072 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3074 set base_commit $currentid
3077 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3078 error_popup [mc "No such commit"]
3082 if {[catch {exec git gui blame $base_commit $flist_menu_file &} err]} {
3083 error_popup "[mc "git gui blame: command failed:"] $err"
3087 # delete $dir when we see eof on $f (presumably because the child has exited)
3088 proc delete_at_eof {f dir} {
3089 while {[gets $f line] >= 0} {}
3091 if {[catch {close $f} err]} {
3092 error_popup "[mc "External diff viewer failed:"] $err"
3094 file delete -force $dir
3100 # Functions for adding and removing shell-type quoting
3102 proc shellquote {str} {
3103 if {![string match "*\['\"\\ \t]*" $str]} {
3106 if {![string match "*\['\"\\]*" $str]} {
3109 if {![string match "*'*" $str]} {
3112 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3115 proc shellarglist {l} {
3121 append str [shellquote $a]
3126 proc shelldequote {str} {
3131 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3132 append ret [string range $str $used end]
3133 set used [string length $str]
3136 set first [lindex $first 0]
3137 set ch [string index $str $first]
3138 if {$first > $used} {
3139 append ret [string range $str $used [expr {$first - 1}]]
3142 if {$ch eq " " || $ch eq "\t"} break
3145 set first [string first "'" $str $used]
3147 error "unmatched single-quote"
3149 append ret [string range $str $used [expr {$first - 1}]]
3154 if {$used >= [string length $str]} {
3155 error "trailing backslash"
3157 append ret [string index $str $used]
3162 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3163 error "unmatched double-quote"
3165 set first [lindex $first 0]
3166 set ch [string index $str $first]
3167 if {$first > $used} {
3168 append ret [string range $str $used [expr {$first - 1}]]
3171 if {$ch eq "\""} break
3173 append ret [string index $str $used]
3177 return [list $used $ret]
3180 proc shellsplit {str} {
3183 set str [string trimleft $str]
3184 if {$str eq {}} break
3185 set dq [shelldequote $str]
3186 set n [lindex $dq 0]
3187 set word [lindex $dq 1]
3188 set str [string range $str $n end]
3194 # Code to implement multiple views
3196 proc newview {ishighlight} {
3197 global nextviewnum newviewname newviewperm newishighlight
3198 global newviewargs revtreeargs viewargscmd newviewargscmd curview
3200 set newishighlight $ishighlight
3202 if {[winfo exists $top]} {
3206 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3207 set newviewperm($nextviewnum) 0
3208 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
3209 set newviewargscmd($nextviewnum) $viewargscmd($curview)
3210 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3215 global viewname viewperm newviewname newviewperm
3216 global viewargs newviewargs viewargscmd newviewargscmd
3218 set top .gitkvedit-$curview
3219 if {[winfo exists $top]} {
3223 set newviewname($curview) $viewname($curview)
3224 set newviewperm($curview) $viewperm($curview)
3225 set newviewargs($curview) [shellarglist $viewargs($curview)]
3226 set newviewargscmd($curview) $viewargscmd($curview)
3227 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
3230 proc vieweditor {top n title} {
3231 global newviewname newviewperm viewfiles bgcolor
3234 wm title $top $title
3235 label $top.nl -text [mc "Name"]
3236 entry $top.name -width 20 -textvariable newviewname($n)
3237 grid $top.nl $top.name -sticky w -pady 5
3238 checkbutton $top.perm -text [mc "Remember this view"] \
3239 -variable newviewperm($n)
3240 grid $top.perm - -pady 5 -sticky w
3241 message $top.al -aspect 1000 \
3242 -text [mc "Commits to include (arguments to git log):"]
3243 grid $top.al - -sticky w -pady 5
3244 entry $top.args -width 50 -textvariable newviewargs($n) \
3245 -background $bgcolor
3246 grid $top.args - -sticky ew -padx 5
3248 message $top.ac -aspect 1000 \
3249 -text [mc "Command to generate more commits to include:"]
3250 grid $top.ac - -sticky w -pady 5
3251 entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
3253 grid $top.argscmd - -sticky ew -padx 5
3255 message $top.l -aspect 1000 \
3256 -text [mc "Enter files and directories to include, one per line:"]
3257 grid $top.l - -sticky w
3258 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
3259 if {[info exists viewfiles($n)]} {
3260 foreach f $viewfiles($n) {
3261 $top.t insert end $f
3262 $top.t insert end "\n"
3264 $top.t delete {end - 1c} end
3265 $top.t mark set insert 0.0
3267 grid $top.t - -sticky ew -padx 5
3269 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3270 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3271 grid $top.buts.ok $top.buts.can
3272 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3273 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3274 grid $top.buts - -pady 10 -sticky ew
3278 proc doviewmenu {m first cmd op argv} {
3279 set nmenu [$m index end]
3280 for {set i $first} {$i <= $nmenu} {incr i} {
3281 if {[$m entrycget $i -command] eq $cmd} {
3282 eval $m $op $i $argv
3288 proc allviewmenus {n op args} {
3291 doviewmenu .bar.view 5 [list showview $n] $op $args
3292 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3295 proc newviewok {top n} {
3296 global nextviewnum newviewperm newviewname newishighlight
3297 global viewname viewfiles viewperm selectedview curview
3298 global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
3301 set newargs [shellsplit $newviewargs($n)]
3303 error_popup "[mc "Error in commit selection arguments:"] $err"
3309 foreach f [split [$top.t get 0.0 end] "\n"] {
3310 set ft [string trim $f]
3315 if {![info exists viewfiles($n)]} {
3316 # creating a new view
3318 set viewname($n) $newviewname($n)
3319 set viewperm($n) $newviewperm($n)
3320 set viewfiles($n) $files
3321 set viewargs($n) $newargs
3322 set viewargscmd($n) $newviewargscmd($n)
3324 if {!$newishighlight} {
3327 run addvhighlight $n
3330 # editing an existing view
3331 set viewperm($n) $newviewperm($n)
3332 if {$newviewname($n) ne $viewname($n)} {
3333 set viewname($n) $newviewname($n)
3334 doviewmenu .bar.view 5 [list showview $n] \
3335 entryconf [list -label $viewname($n)]
3336 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3337 # entryconf [list -label $viewname($n) -value $viewname($n)]
3339 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3340 $newviewargscmd($n) ne $viewargscmd($n)} {
3341 set viewfiles($n) $files
3342 set viewargs($n) $newargs
3343 set viewargscmd($n) $newviewargscmd($n)
3344 if {$curview == $n} {
3349 catch {destroy $top}
3353 global curview viewperm hlview selectedhlview
3355 if {$curview == 0} return
3356 if {[info exists hlview] && $hlview == $curview} {
3357 set selectedhlview [mc "None"]
3360 allviewmenus $curview delete
3361 set viewperm($curview) 0
3365 proc addviewmenu {n} {
3366 global viewname viewhlmenu
3368 .bar.view add radiobutton -label $viewname($n) \
3369 -command [list showview $n] -variable selectedview -value $n
3370 #$viewhlmenu add radiobutton -label $viewname($n) \
3371 # -command [list addvhighlight $n] -variable selectedhlview
3375 global curview cached_commitrow ordertok
3376 global displayorder parentlist rowidlist rowisopt rowfinal
3377 global colormap rowtextx nextcolor canvxmax
3378 global numcommits viewcomplete
3379 global selectedline currentid canv canvy0
3381 global pending_select mainheadid
3384 global hlview selectedhlview commitinterest
3386 if {$n == $curview} return
3388 set ymax [lindex [$canv cget -scrollregion] 3]
3389 set span [$canv yview]
3390 set ytop [expr {[lindex $span 0] * $ymax}]
3391 set ybot [expr {[lindex $span 1] * $ymax}]
3392 set yscreen [expr {($ybot - $ytop) / 2}]
3393 if {$selectedline ne {}} {
3394 set selid $currentid
3395 set y [yc $selectedline]
3396 if {$ytop < $y && $y < $ybot} {
3397 set yscreen [expr {$y - $ytop}]
3399 } elseif {[info exists pending_select]} {
3400 set selid $pending_select
3401 unset pending_select
3405 catch {unset treediffs}
3407 if {[info exists hlview] && $hlview == $n} {
3409 set selectedhlview [mc "None"]
3411 catch {unset commitinterest}
3412 catch {unset cached_commitrow}
3413 catch {unset ordertok}
3417 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3418 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3421 if {![info exists viewcomplete($n)]} {
3431 set numcommits $commitidx($n)
3433 catch {unset colormap}
3434 catch {unset rowtextx}
3436 set canvxmax [$canv cget -width]
3442 if {$selid ne {} && [commitinview $selid $n]} {
3443 set row [rowofcommit $selid]
3444 # try to get the selected row in the same position on the screen
3445 set ymax [lindex [$canv cget -scrollregion] 3]
3446 set ytop [expr {[yc $row] - $yscreen}]
3450 set yf [expr {$ytop * 1.0 / $ymax}]
3452 allcanvs yview moveto $yf
3456 } elseif {!$viewcomplete($n)} {
3457 reset_pending_select $selid
3459 reset_pending_select {}
3461 if {[commitinview $pending_select $curview]} {
3462 selectline [rowofcommit $pending_select] 1
3464 set row [first_real_row]
3465 if {$row < $numcommits} {
3470 if {!$viewcomplete($n)} {
3471 if {$numcommits == 0} {
3472 show_status [mc "Reading commits..."]
3474 } elseif {$numcommits == 0} {
3475 show_status [mc "No commits selected"]
3479 # Stuff relating to the highlighting facility
3481 proc ishighlighted {id} {
3482 global vhighlights fhighlights nhighlights rhighlights
3484 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3485 return $nhighlights($id)
3487 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3488 return $vhighlights($id)
3490 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
3491 return $fhighlights($id)
3493 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
3494 return $rhighlights($id)
3499 proc bolden {row font} {
3500 global canv linehtag selectedline boldrows
3502 lappend boldrows $row
3503 $canv itemconf $linehtag($row) -font $font
3504 if {$row == $selectedline} {
3506 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
3507 -outline {{}} -tags secsel \
3508 -fill [$canv cget -selectbackground]]
3513 proc bolden_name {row font} {
3514 global canv2 linentag selectedline boldnamerows
3516 lappend boldnamerows $row
3517 $canv2 itemconf $linentag($row) -font $font
3518 if {$row == $selectedline} {
3519 $canv2 delete secsel
3520 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
3521 -outline {{}} -tags secsel \
3522 -fill [$canv2 cget -selectbackground]]
3531 foreach row $boldrows {
3532 if {![ishighlighted [commitonrow $row]]} {
3533 bolden $row mainfont
3535 lappend stillbold $row
3538 set boldrows $stillbold
3541 proc addvhighlight {n} {
3542 global hlview viewcomplete curview vhl_done commitidx
3544 if {[info exists hlview]} {
3548 if {$n != $curview && ![info exists viewcomplete($n)]} {
3551 set vhl_done $commitidx($hlview)
3552 if {$vhl_done > 0} {
3557 proc delvhighlight {} {
3558 global hlview vhighlights
3560 if {![info exists hlview]} return
3562 catch {unset vhighlights}
3566 proc vhighlightmore {} {
3567 global hlview vhl_done commitidx vhighlights curview
3569 set max $commitidx($hlview)
3570 set vr [visiblerows]
3571 set r0 [lindex $vr 0]
3572 set r1 [lindex $vr 1]
3573 for {set i $vhl_done} {$i < $max} {incr i} {
3574 set id [commitonrow $i $hlview]
3575 if {[commitinview $id $curview]} {
3576 set row [rowofcommit $id]
3577 if {$r0 <= $row && $row <= $r1} {
3578 if {![highlighted $row]} {
3579 bolden $row mainfontbold
3581 set vhighlights($id) 1
3589 proc askvhighlight {row id} {
3590 global hlview vhighlights iddrawn
3592 if {[commitinview $id $hlview]} {
3593 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3594 bolden $row mainfontbold
3596 set vhighlights($id) 1
3598 set vhighlights($id) 0
3602 proc hfiles_change {} {
3603 global highlight_files filehighlight fhighlights fh_serial
3604 global highlight_paths gdttype
3606 if {[info exists filehighlight]} {
3607 # delete previous highlights
3608 catch {close $filehighlight}
3610 catch {unset fhighlights}
3612 unhighlight_filelist
3614 set highlight_paths {}
3615 after cancel do_file_hl $fh_serial
3617 if {$highlight_files ne {}} {
3618 after 300 do_file_hl $fh_serial
3622 proc gdttype_change {name ix op} {
3623 global gdttype highlight_files findstring findpattern
3626 if {$findstring ne {}} {
3627 if {$gdttype eq [mc "containing:"]} {
3628 if {$highlight_files ne {}} {
3629 set highlight_files {}
3634 if {$findpattern ne {}} {
3638 set highlight_files $findstring
3643 # enable/disable findtype/findloc menus too
3646 proc find_change {name ix op} {
3647 global gdttype findstring highlight_files
3650 if {$gdttype eq [mc "containing:"]} {
3653 if {$highlight_files ne $findstring} {
3654 set highlight_files $findstring
3661 proc findcom_change args {
3662 global nhighlights boldnamerows
3663 global findpattern findtype findstring gdttype
3666 # delete previous highlights, if any
3667 foreach row $boldnamerows {
3668 bolden_name $row mainfont
3671 catch {unset nhighlights}
3674 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3676 } elseif {$findtype eq [mc "Regexp"]} {
3677 set findpattern $findstring
3679 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3681 set findpattern "*$e*"
3685 proc makepatterns {l} {
3688 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3689 if {[string index $ee end] eq "/"} {
3699 proc do_file_hl {serial} {
3700 global highlight_files filehighlight highlight_paths gdttype fhl_list
3702 if {$gdttype eq [mc "touching paths:"]} {
3703 if {[catch {set paths [shellsplit $highlight_files]}]} return
3704 set highlight_paths [makepatterns $paths]
3706 set gdtargs [concat -- $paths]
3707 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3708 set gdtargs [list "-S$highlight_files"]
3710 # must be "containing:", i.e. we're searching commit info
3713 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3714 set filehighlight [open $cmd r+]
3715 fconfigure $filehighlight -blocking 0
3716 filerun $filehighlight readfhighlight
3722 proc flushhighlights {} {
3723 global filehighlight fhl_list
3725 if {[info exists filehighlight]} {
3727 puts $filehighlight ""
3728 flush $filehighlight
3732 proc askfilehighlight {row id} {
3733 global filehighlight fhighlights fhl_list
3735 lappend fhl_list $id
3736 set fhighlights($id) -1
3737 puts $filehighlight $id
3740 proc readfhighlight {} {
3741 global filehighlight fhighlights curview iddrawn
3742 global fhl_list find_dirn
3744 if {![info exists filehighlight]} {
3748 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3749 set line [string trim $line]
3750 set i [lsearch -exact $fhl_list $line]
3751 if {$i < 0} continue
3752 for {set j 0} {$j < $i} {incr j} {
3753 set id [lindex $fhl_list $j]
3754 set fhighlights($id) 0
3756 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3757 if {$line eq {}} continue
3758 if {![commitinview $line $curview]} continue
3759 set row [rowofcommit $line]
3760 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3761 bolden $row mainfontbold
3763 set fhighlights($line) 1
3765 if {[eof $filehighlight]} {
3767 puts "oops, git diff-tree died"
3768 catch {close $filehighlight}
3772 if {[info exists find_dirn]} {
3778 proc doesmatch {f} {
3779 global findtype findpattern
3781 if {$findtype eq [mc "Regexp"]} {
3782 return [regexp $findpattern $f]
3783 } elseif {$findtype eq [mc "IgnCase"]} {
3784 return [string match -nocase $findpattern $f]
3786 return [string match $findpattern $f]
3790 proc askfindhighlight {row id} {
3791 global nhighlights commitinfo iddrawn
3793 global markingmatches
3795 if {![info exists commitinfo($id)]} {
3798 set info $commitinfo($id)
3800 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3801 foreach f $info ty $fldtypes {
3802 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3804 if {$ty eq [mc "Author"]} {
3811 if {$isbold && [info exists iddrawn($id)]} {
3812 if {![ishighlighted $id]} {
3813 bolden $row mainfontbold
3815 bolden_name $row mainfontbold
3818 if {$markingmatches} {
3819 markrowmatches $row $id
3822 set nhighlights($id) $isbold
3825 proc markrowmatches {row id} {
3826 global canv canv2 linehtag linentag commitinfo findloc
3828 set headline [lindex $commitinfo($id) 0]
3829 set author [lindex $commitinfo($id) 1]
3830 $canv delete match$row
3831 $canv2 delete match$row
3832 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3833 set m [findmatches $headline]
3835 markmatches $canv $row $headline $linehtag($row) $m \
3836 [$canv itemcget $linehtag($row) -font] $row
3839 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3840 set m [findmatches $author]
3842 markmatches $canv2 $row $author $linentag($row) $m \
3843 [$canv2 itemcget $linentag($row) -font] $row
3848 proc vrel_change {name ix op} {
3849 global highlight_related
3852 if {$highlight_related ne [mc "None"]} {
3857 # prepare for testing whether commits are descendents or ancestors of a
3858 proc rhighlight_sel {a} {
3859 global descendent desc_todo ancestor anc_todo
3860 global highlight_related
3862 catch {unset descendent}
3863 set desc_todo [list $a]
3864 catch {unset ancestor}
3865 set anc_todo [list $a]
3866 if {$highlight_related ne [mc "None"]} {
3872 proc rhighlight_none {} {
3875 catch {unset rhighlights}
3879 proc is_descendent {a} {
3880 global curview children descendent desc_todo
3883 set la [rowofcommit $a]
3887 for {set i 0} {$i < [llength $todo]} {incr i} {
3888 set do [lindex $todo $i]
3889 if {[rowofcommit $do] < $la} {
3890 lappend leftover $do
3893 foreach nk $children($v,$do) {
3894 if {![info exists descendent($nk)]} {
3895 set descendent($nk) 1
3903 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3907 set descendent($a) 0
3908 set desc_todo $leftover
3911 proc is_ancestor {a} {
3912 global curview parents ancestor anc_todo
3915 set la [rowofcommit $a]
3919 for {set i 0} {$i < [llength $todo]} {incr i} {
3920 set do [lindex $todo $i]
3921 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3922 lappend leftover $do
3925 foreach np $parents($v,$do) {
3926 if {![info exists ancestor($np)]} {
3935 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3940 set anc_todo $leftover
3943 proc askrelhighlight {row id} {
3944 global descendent highlight_related iddrawn rhighlights
3945 global selectedline ancestor
3947 if {$selectedline eq {}} return
3949 if {$highlight_related eq [mc "Descendant"] ||
3950 $highlight_related eq [mc "Not descendant"]} {
3951 if {![info exists descendent($id)]} {
3954 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
3957 } elseif {$highlight_related eq [mc "Ancestor"] ||
3958 $highlight_related eq [mc "Not ancestor"]} {
3959 if {![info exists ancestor($id)]} {
3962 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3966 if {[info exists iddrawn($id)]} {
3967 if {$isbold && ![ishighlighted $id]} {
3968 bolden $row mainfontbold
3971 set rhighlights($id) $isbold
3974 # Graph layout functions
3976 proc shortids {ids} {
3979 if {[llength $id] > 1} {
3980 lappend res [shortids $id]
3981 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3982 lappend res [string range $id 0 7]
3993 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3994 if {($n & $mask) != 0} {
3995 set ret [concat $ret $o]
3997 set o [concat $o $o]
4002 proc ordertoken {id} {
4003 global ordertok curview varcid varcstart varctok curview parents children
4004 global nullid nullid2
4006 if {[info exists ordertok($id)]} {
4007 return $ordertok($id)
4012 if {[info exists varcid($curview,$id)]} {
4013 set a $varcid($curview,$id)
4014 set p [lindex $varcstart($curview) $a]
4016 set p [lindex $children($curview,$id) 0]
4018 if {[info exists ordertok($p)]} {
4019 set tok $ordertok($p)
4022 set id [first_real_child $curview,$p]
4025 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4028 if {[llength $parents($curview,$id)] == 1} {
4029 lappend todo [list $p {}]
4031 set j [lsearch -exact $parents($curview,$id) $p]
4033 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4035 lappend todo [list $p [strrep $j]]
4038 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4039 set p [lindex $todo $i 0]
4040 append tok [lindex $todo $i 1]
4041 set ordertok($p) $tok
4043 set ordertok($origid) $tok
4047 # Work out where id should go in idlist so that order-token
4048 # values increase from left to right
4049 proc idcol {idlist id {i 0}} {
4050 set t [ordertoken $id]
4054 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4055 if {$i > [llength $idlist]} {
4056 set i [llength $idlist]
4058 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4061 if {$t > [ordertoken [lindex $idlist $i]]} {
4062 while {[incr i] < [llength $idlist] &&
4063 $t >= [ordertoken [lindex $idlist $i]]} {}
4069 proc initlayout {} {
4070 global rowidlist rowisopt rowfinal displayorder parentlist
4071 global numcommits canvxmax canv
4073 global colormap rowtextx
4082 set canvxmax [$canv cget -width]
4083 catch {unset colormap}
4084 catch {unset rowtextx}
4088 proc setcanvscroll {} {
4089 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4090 global lastscrollset lastscrollrows
4092 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4093 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4094 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4095 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4096 set lastscrollset [clock clicks -milliseconds]
4097 set lastscrollrows $numcommits
4100 proc visiblerows {} {
4101 global canv numcommits linespc
4103 set ymax [lindex [$canv cget -scrollregion] 3]
4104 if {$ymax eq {} || $ymax == 0} return
4106 set y0 [expr {int([lindex $f 0] * $ymax)}]
4107 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4111 set y1 [expr {int([lindex $f 1] * $ymax)}]
4112 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4113 if {$r1 >= $numcommits} {
4114 set r1 [expr {$numcommits - 1}]
4116 return [list $r0 $r1]
4119 proc layoutmore {} {
4120 global commitidx viewcomplete curview
4121 global numcommits pending_select curview
4122 global lastscrollset lastscrollrows commitinterest
4124 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4125 [clock clicks -milliseconds] - $lastscrollset > 500} {
4128 if {[info exists pending_select] &&
4129 [commitinview $pending_select $curview]} {
4131 selectline [rowofcommit $pending_select] 1
4136 proc doshowlocalchanges {} {
4137 global curview mainheadid
4139 if {$mainheadid eq {}} return
4140 if {[commitinview $mainheadid $curview]} {
4143 lappend commitinterest($mainheadid) {dodiffindex}
4147 proc dohidelocalchanges {} {
4148 global nullid nullid2 lserial curview
4150 if {[commitinview $nullid $curview]} {
4151 removefakerow $nullid
4153 if {[commitinview $nullid2 $curview]} {
4154 removefakerow $nullid2
4159 # spawn off a process to do git diff-index --cached HEAD
4160 proc dodiffindex {} {
4161 global lserial showlocalchanges
4164 if {!$showlocalchanges || !$isworktree} return
4166 set fd [open "|git diff-index --cached HEAD" r]
4167 fconfigure $fd -blocking 0
4168 set i [reg_instance $fd]
4169 filerun $fd [list readdiffindex $fd $lserial $i]
4172 proc readdiffindex {fd serial inst} {
4173 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4176 if {[gets $fd line] < 0} {
4182 # we only need to see one line and we don't really care what it says...
4185 if {$serial != $lserial} {
4189 # now see if there are any local changes not checked in to the index
4190 set fd [open "|git diff-files" r]
4191 fconfigure $fd -blocking 0
4192 set i [reg_instance $fd]
4193 filerun $fd [list readdifffiles $fd $serial $i]
4195 if {$isdiff && ![commitinview $nullid2 $curview]} {
4196 # add the line for the changes in the index to the graph
4197 set hl [mc "Local changes checked in to index but not committed"]
4198 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4199 set commitdata($nullid2) "\n $hl\n"
4200 if {[commitinview $nullid $curview]} {
4201 removefakerow $nullid
4203 insertfakerow $nullid2 $mainheadid
4204 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4205 removefakerow $nullid2
4210 proc readdifffiles {fd serial inst} {
4211 global mainheadid nullid nullid2 curview
4212 global commitinfo commitdata lserial
4215 if {[gets $fd line] < 0} {
4221 # we only need to see one line and we don't really care what it says...
4224 if {$serial != $lserial} {
4228 if {$isdiff && ![commitinview $nullid $curview]} {
4229 # add the line for the local diff to the graph
4230 set hl [mc "Local uncommitted changes, not checked in to index"]
4231 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4232 set commitdata($nullid) "\n $hl\n"
4233 if {[commitinview $nullid2 $curview]} {
4238 insertfakerow $nullid $p
4239 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4240 removefakerow $nullid
4245 proc nextuse {id row} {
4246 global curview children
4248 if {[info exists children($curview,$id)]} {
4249 foreach kid $children($curview,$id) {
4250 if {![commitinview $kid $curview]} {
4253 if {[rowofcommit $kid] > $row} {
4254 return [rowofcommit $kid]
4258 if {[commitinview $id $curview]} {
4259 return [rowofcommit $id]
4264 proc prevuse {id row} {
4265 global curview children
4268 if {[info exists children($curview,$id)]} {
4269 foreach kid $children($curview,$id) {
4270 if {![commitinview $kid $curview]} break
4271 if {[rowofcommit $kid] < $row} {
4272 set ret [rowofcommit $kid]
4279 proc make_idlist {row} {
4280 global displayorder parentlist uparrowlen downarrowlen mingaplen
4281 global commitidx curview children
4283 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4287 set ra [expr {$row - $downarrowlen}]
4291 set rb [expr {$row + $uparrowlen}]
4292 if {$rb > $commitidx($curview)} {
4293 set rb $commitidx($curview)
4295 make_disporder $r [expr {$rb + 1}]
4297 for {} {$r < $ra} {incr r} {
4298 set nextid [lindex $displayorder [expr {$r + 1}]]
4299 foreach p [lindex $parentlist $r] {
4300 if {$p eq $nextid} continue
4301 set rn [nextuse $p $r]
4303 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4304 lappend ids [list [ordertoken $p] $p]
4308 for {} {$r < $row} {incr r} {
4309 set nextid [lindex $displayorder [expr {$r + 1}]]
4310 foreach p [lindex $parentlist $r] {
4311 if {$p eq $nextid} continue
4312 set rn [nextuse $p $r]
4313 if {$rn < 0 || $rn >= $row} {
4314 lappend ids [list [ordertoken $p] $p]
4318 set id [lindex $displayorder $row]
4319 lappend ids [list [ordertoken $id] $id]
4321 foreach p [lindex $parentlist $r] {
4322 set firstkid [lindex $children($curview,$p) 0]
4323 if {[rowofcommit $firstkid] < $row} {
4324 lappend ids [list [ordertoken $p] $p]
4328 set id [lindex $displayorder $r]
4330 set firstkid [lindex $children($curview,$id) 0]
4331 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4332 lappend ids [list [ordertoken $id] $id]
4337 foreach idx [lsort -unique $ids] {
4338 lappend idlist [lindex $idx 1]
4343 proc rowsequal {a b} {
4344 while {[set i [lsearch -exact $a {}]] >= 0} {
4345 set a [lreplace $a $i $i]
4347 while {[set i [lsearch -exact $b {}]] >= 0} {
4348 set b [lreplace $b $i $i]
4350 return [expr {$a eq $b}]
4353 proc makeupline {id row rend col} {
4354 global rowidlist uparrowlen downarrowlen mingaplen
4356 for {set r $rend} {1} {set r $rstart} {
4357 set rstart [prevuse $id $r]
4358 if {$rstart < 0} return
4359 if {$rstart < $row} break
4361 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4362 set rstart [expr {$rend - $uparrowlen - 1}]
4364 for {set r $rstart} {[incr r] <= $row} {} {
4365 set idlist [lindex $rowidlist $r]
4366 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4367 set col [idcol $idlist $id $col]
4368 lset rowidlist $r [linsert $idlist $col $id]
4374 proc layoutrows {row endrow} {
4375 global rowidlist rowisopt rowfinal displayorder
4376 global uparrowlen downarrowlen maxwidth mingaplen
4377 global children parentlist
4378 global commitidx viewcomplete curview
4380 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4383 set rm1 [expr {$row - 1}]
4384 foreach id [lindex $rowidlist $rm1] {
4389 set final [lindex $rowfinal $rm1]
4391 for {} {$row < $endrow} {incr row} {
4392 set rm1 [expr {$row - 1}]
4393 if {$rm1 < 0 || $idlist eq {}} {
4394 set idlist [make_idlist $row]
4397 set id [lindex $displayorder $rm1]
4398 set col [lsearch -exact $idlist $id]
4399 set idlist [lreplace $idlist $col $col]
4400 foreach p [lindex $parentlist $rm1] {
4401 if {[lsearch -exact $idlist $p] < 0} {
4402 set col [idcol $idlist $p $col]
4403 set idlist [linsert $idlist $col $p]
4404 # if not the first child, we have to insert a line going up
4405 if {$id ne [lindex $children($curview,$p) 0]} {
4406 makeupline $p $rm1 $row $col
4410 set id [lindex $displayorder $row]
4411 if {$row > $downarrowlen} {
4412 set termrow [expr {$row - $downarrowlen - 1}]
4413 foreach p [lindex $parentlist $termrow] {
4414 set i [lsearch -exact $idlist $p]
4415 if {$i < 0} continue
4416 set nr [nextuse $p $termrow]
4417 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4418 set idlist [lreplace $idlist $i $i]
4422 set col [lsearch -exact $idlist $id]
4424 set col [idcol $idlist $id]
4425 set idlist [linsert $idlist $col $id]
4426 if {$children($curview,$id) ne {}} {
4427 makeupline $id $rm1 $row $col
4430 set r [expr {$row + $uparrowlen - 1}]
4431 if {$r < $commitidx($curview)} {
4433 foreach p [lindex $parentlist $r] {
4434 if {[lsearch -exact $idlist $p] >= 0} continue
4435 set fk [lindex $children($curview,$p) 0]
4436 if {[rowofcommit $fk] < $row} {
4437 set x [idcol $idlist $p $x]
4438 set idlist [linsert $idlist $x $p]
4441 if {[incr r] < $commitidx($curview)} {
4442 set p [lindex $displayorder $r]
4443 if {[lsearch -exact $idlist $p] < 0} {
4444 set fk [lindex $children($curview,$p) 0]
4445 if {$fk ne {} && [rowofcommit $fk] < $row} {
4446 set x [idcol $idlist $p $x]
4447 set idlist [linsert $idlist $x $p]
4453 if {$final && !$viewcomplete($curview) &&
4454 $row + $uparrowlen + $mingaplen + $downarrowlen
4455 >= $commitidx($curview)} {
4458 set l [llength $rowidlist]
4460 lappend rowidlist $idlist
4462 lappend rowfinal $final
4463 } elseif {$row < $l} {
4464 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4465 lset rowidlist $row $idlist
4468 lset rowfinal $row $final
4470 set pad [ntimes [expr {$row - $l}] {}]
4471 set rowidlist [concat $rowidlist $pad]
4472 lappend rowidlist $idlist
4473 set rowfinal [concat $rowfinal $pad]
4474 lappend rowfinal $final
4475 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4481 proc changedrow {row} {
4482 global displayorder iddrawn rowisopt need_redisplay
4484 set l [llength $rowisopt]
4486 lset rowisopt $row 0
4487 if {$row + 1 < $l} {
4488 lset rowisopt [expr {$row + 1}] 0
4489 if {$row + 2 < $l} {
4490 lset rowisopt [expr {$row + 2}] 0
4494 set id [lindex $displayorder $row]
4495 if {[info exists iddrawn($id)]} {
4496 set need_redisplay 1
4500 proc insert_pad {row col npad} {
4503 set pad [ntimes $npad {}]
4504 set idlist [lindex $rowidlist $row]
4505 set bef [lrange $idlist 0 [expr {$col - 1}]]
4506 set aft [lrange $idlist $col end]
4507 set i [lsearch -exact $aft {}]
4509 set aft [lreplace $aft $i $i]
4511 lset rowidlist $row [concat $bef $pad $aft]
4515 proc optimize_rows {row col endrow} {
4516 global rowidlist rowisopt displayorder curview children
4521 for {} {$row < $endrow} {incr row; set col 0} {
4522 if {[lindex $rowisopt $row]} continue
4524 set y0 [expr {$row - 1}]
4525 set ym [expr {$row - 2}]
4526 set idlist [lindex $rowidlist $row]
4527 set previdlist [lindex $rowidlist $y0]
4528 if {$idlist eq {} || $previdlist eq {}} continue
4530 set pprevidlist [lindex $rowidlist $ym]
4531 if {$pprevidlist eq {}} continue
4537 for {} {$col < [llength $idlist]} {incr col} {
4538 set id [lindex $idlist $col]
4539 if {[lindex $previdlist $col] eq $id} continue
4544 set x0 [lsearch -exact $previdlist $id]
4545 if {$x0 < 0} continue
4546 set z [expr {$x0 - $col}]
4550 set xm [lsearch -exact $pprevidlist $id]
4552 set z0 [expr {$xm - $x0}]
4556 # if row y0 is the first child of $id then it's not an arrow
4557 if {[lindex $children($curview,$id) 0] ne
4558 [lindex $displayorder $y0]} {
4562 if {!$isarrow && $id ne [lindex $displayorder $row] &&
4563 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4566 # Looking at lines from this row to the previous row,
4567 # make them go straight up if they end in an arrow on
4568 # the previous row; otherwise make them go straight up
4570 if {$z < -1 || ($z < 0 && $isarrow)} {
4571 # Line currently goes left too much;
4572 # insert pads in the previous row, then optimize it
4573 set npad [expr {-1 - $z + $isarrow}]
4574 insert_pad $y0 $x0 $npad
4576 optimize_rows $y0 $x0 $row
4578 set previdlist [lindex $rowidlist $y0]
4579 set x0 [lsearch -exact $previdlist $id]
4580 set z [expr {$x0 - $col}]
4582 set pprevidlist [lindex $rowidlist $ym]
4583 set xm [lsearch -exact $pprevidlist $id]
4584 set z0 [expr {$xm - $x0}]
4586 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4587 # Line currently goes right too much;
4588 # insert pads in this line
4589 set npad [expr {$z - 1 + $isarrow}]
4590 insert_pad $row $col $npad
4591 set idlist [lindex $rowidlist $row]
4593 set z [expr {$x0 - $col}]
4596 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4597 # this line links to its first child on row $row-2
4598 set id [lindex $displayorder $ym]
4599 set xc [lsearch -exact $pprevidlist $id]
4601 set z0 [expr {$xc - $x0}]
4604 # avoid lines jigging left then immediately right
4605 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4606 insert_pad $y0 $x0 1
4608 optimize_rows $y0 $x0 $row
4609 set previdlist [lindex $rowidlist $y0]
4613 # Find the first column that doesn't have a line going right
4614 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4615 set id [lindex $idlist $col]
4616 if {$id eq {}} break
4617 set x0 [lsearch -exact $previdlist $id]
4619 # check if this is the link to the first child
4620 set kid [lindex $displayorder $y0]
4621 if {[lindex $children($curview,$id) 0] eq $kid} {
4622 # it is, work out offset to child
4623 set x0 [lsearch -exact $previdlist $kid]
4626 if {$x0 <= $col} break
4628 # Insert a pad at that column as long as it has a line and
4629 # isn't the last column
4630 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4631 set idlist [linsert $idlist $col {}]
4632 lset rowidlist $row $idlist
4640 global canvx0 linespc
4641 return [expr {$canvx0 + $col * $linespc}]
4645 global canvy0 linespc
4646 return [expr {$canvy0 + $row * $linespc}]
4649 proc linewidth {id} {
4650 global thickerline lthickness
4653 if {[info exists thickerline] && $id eq $thickerline} {
4654 set wid [expr {2 * $lthickness}]
4659 proc rowranges {id} {
4660 global curview children uparrowlen downarrowlen
4663 set kids $children($curview,$id)
4669 foreach child $kids {
4670 if {![commitinview $child $curview]} break
4671 set row [rowofcommit $child]
4672 if {![info exists prev]} {
4673 lappend ret [expr {$row + 1}]
4675 if {$row <= $prevrow} {
4676 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4678 # see if the line extends the whole way from prevrow to row
4679 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4680 [lsearch -exact [lindex $rowidlist \
4681 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4682 # it doesn't, see where it ends
4683 set r [expr {$prevrow + $downarrowlen}]
4684 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4685 while {[incr r -1] > $prevrow &&
4686 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4688 while {[incr r] <= $row &&
4689 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4693 # see where it starts up again
4694 set r [expr {$row - $uparrowlen}]
4695 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4696 while {[incr r] < $row &&
4697 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4699 while {[incr r -1] >= $prevrow &&
4700 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4706 if {$child eq $id} {
4715 proc drawlineseg {id row endrow arrowlow} {
4716 global rowidlist displayorder iddrawn linesegs
4717 global canv colormap linespc curview maxlinelen parentlist
4719 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4720 set le [expr {$row + 1}]
4723 set c [lsearch -exact [lindex $rowidlist $le] $id]
4729 set x [lindex $displayorder $le]
4734 if {[info exists iddrawn($x)] || $le == $endrow} {
4735 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4751 if {[info exists linesegs($id)]} {
4752 set lines $linesegs($id)
4754 set r0 [lindex $li 0]
4756 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4766 set li [lindex $lines [expr {$i-1}]]
4767 set r1 [lindex $li 1]
4768 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4773 set x [lindex $cols [expr {$le - $row}]]
4774 set xp [lindex $cols [expr {$le - 1 - $row}]]
4775 set dir [expr {$xp - $x}]
4777 set ith [lindex $lines $i 2]
4778 set coords [$canv coords $ith]
4779 set ah [$canv itemcget $ith -arrow]
4780 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4781 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4782 if {$x2 ne {} && $x - $x2 == $dir} {
4783 set coords [lrange $coords 0 end-2]
4786 set coords [list [xc $le $x] [yc $le]]
4789 set itl [lindex $lines [expr {$i-1}] 2]
4790 set al [$canv itemcget $itl -arrow]
4791 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4792 } elseif {$arrowlow} {
4793 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4794 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4798 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4799 for {set y $le} {[incr y -1] > $row} {} {
4801 set xp [lindex $cols [expr {$y - 1 - $row}]]
4802 set ndir [expr {$xp - $x}]
4803 if {$dir != $ndir || $xp < 0} {
4804 lappend coords [xc $y $x] [yc $y]
4810 # join parent line to first child
4811 set ch [lindex $displayorder $row]
4812 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4814 puts "oops: drawlineseg: child $ch not on row $row"
4815 } elseif {$xc != $x} {
4816 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4817 set d [expr {int(0.5 * $linespc)}]
4820 set x2 [expr {$x1 - $d}]
4822 set x2 [expr {$x1 + $d}]
4825 set y1 [expr {$y2 + $d}]
4826 lappend coords $x1 $y1 $x2 $y2
4827 } elseif {$xc < $x - 1} {
4828 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4829 } elseif {$xc > $x + 1} {
4830 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4834 lappend coords [xc $row $x] [yc $row]
4836 set xn [xc $row $xp]
4838 lappend coords $xn $yn
4842 set t [$canv create line $coords -width [linewidth $id] \
4843 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4846 set lines [linsert $lines $i [list $row $le $t]]
4848 $canv coords $ith $coords
4849 if {$arrow ne $ah} {
4850 $canv itemconf $ith -arrow $arrow
4852 lset lines $i 0 $row
4855 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4856 set ndir [expr {$xo - $xp}]
4857 set clow [$canv coords $itl]
4858 if {$dir == $ndir} {
4859 set clow [lrange $clow 2 end]
4861 set coords [concat $coords $clow]
4863 lset lines [expr {$i-1}] 1 $le
4865 # coalesce two pieces
4867 set b [lindex $lines [expr {$i-1}] 0]
4868 set e [lindex $lines $i 1]
4869 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4871 $canv coords $itl $coords
4872 if {$arrow ne $al} {
4873 $canv itemconf $itl -arrow $arrow
4877 set linesegs($id) $lines
4881 proc drawparentlinks {id row} {
4882 global rowidlist canv colormap curview parentlist
4883 global idpos linespc
4885 set rowids [lindex $rowidlist $row]
4886 set col [lsearch -exact $rowids $id]
4887 if {$col < 0} return
4888 set olds [lindex $parentlist $row]
4889 set row2 [expr {$row + 1}]
4890 set x [xc $row $col]
4893 set d [expr {int(0.5 * $linespc)}]
4894 set ymid [expr {$y + $d}]
4895 set ids [lindex $rowidlist $row2]
4896 # rmx = right-most X coord used
4899 set i [lsearch -exact $ids $p]
4901 puts "oops, parent $p of $id not in list"
4904 set x2 [xc $row2 $i]
4908 set j [lsearch -exact $rowids $p]
4910 # drawlineseg will do this one for us
4914 # should handle duplicated parents here...
4915 set coords [list $x $y]
4917 # if attaching to a vertical segment, draw a smaller
4918 # slant for visual distinctness
4921 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4923 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4925 } elseif {$i < $col && $i < $j} {
4926 # segment slants towards us already
4927 lappend coords [xc $row $j] $y
4929 if {$i < $col - 1} {
4930 lappend coords [expr {$x2 + $linespc}] $y
4931 } elseif {$i > $col + 1} {
4932 lappend coords [expr {$x2 - $linespc}] $y
4934 lappend coords $x2 $y2
4937 lappend coords $x2 $y2
4939 set t [$canv create line $coords -width [linewidth $p] \
4940 -fill $colormap($p) -tags lines.$p]
4944 if {$rmx > [lindex $idpos($id) 1]} {
4945 lset idpos($id) 1 $rmx
4950 proc drawlines {id} {
4953 $canv itemconf lines.$id -width [linewidth $id]
4956 proc drawcmittext {id row col} {
4957 global linespc canv canv2 canv3 fgcolor curview
4958 global cmitlisted commitinfo rowidlist parentlist
4959 global rowtextx idpos idtags idheads idotherrefs
4960 global linehtag linentag linedtag selectedline
4961 global canvxmax boldrows boldnamerows fgcolor
4962 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
4964 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
4965 set listed $cmitlisted($curview,$id)
4966 if {$id eq $nullid} {
4968 } elseif {$id eq $nullid2} {
4970 } elseif {$id eq $mainheadid} {
4973 set ofill [lindex $circlecolors $listed]
4975 set x [xc $row $col]
4977 set orad [expr {$linespc / 3}]
4979 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4980 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4981 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4982 } elseif {$listed == 3} {
4983 # triangle pointing left for left-side commits
4984 set t [$canv create polygon \
4985 [expr {$x - $orad}] $y \
4986 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4987 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4988 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4990 # triangle pointing right for right-side commits
4991 set t [$canv create polygon \
4992 [expr {$x + $orad - 1}] $y \
4993 [expr {$x - $orad}] [expr {$y - $orad}] \
4994 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4995 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4997 set circleitem($row) $t
4999 $canv bind $t <1> {selcanvline {} %x %y}
5000 set rmx [llength [lindex $rowidlist $row]]
5001 set olds [lindex $parentlist $row]
5003 set nextids [lindex $rowidlist [expr {$row + 1}]]
5005 set i [lsearch -exact $nextids $p]
5011 set xt [xc $row $rmx]
5012 set rowtextx($row) $xt
5013 set idpos($id) [list $x $xt $y]
5014 if {[info exists idtags($id)] || [info exists idheads($id)]
5015 || [info exists idotherrefs($id)]} {
5016 set xt [drawtags $id $x $xt $y]
5018 set headline [lindex $commitinfo($id) 0]
5019 set name [lindex $commitinfo($id) 1]
5020 set date [lindex $commitinfo($id) 2]
5021 set date [formatdate $date]
5024 set isbold [ishighlighted $id]
5026 lappend boldrows $row
5027 set font mainfontbold
5029 lappend boldnamerows $row
5030 set nfont mainfontbold
5033 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
5034 -text $headline -font $font -tags text]
5035 $canv bind $linehtag($row) $ctxbut "rowmenu %X %Y $id"
5036 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5037 -text $name -font $nfont -tags text]
5038 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5039 -text $date -font mainfont -tags text]
5040 if {$selectedline == $row} {
5043 set xr [expr {$xt + [font measure $font $headline]}]
5044 if {$xr > $canvxmax} {
5050 proc drawcmitrow {row} {
5051 global displayorder rowidlist nrows_drawn
5052 global iddrawn markingmatches
5053 global commitinfo numcommits
5054 global filehighlight fhighlights findpattern nhighlights
5055 global hlview vhighlights
5056 global highlight_related rhighlights
5058 if {$row >= $numcommits} return
5060 set id [lindex $displayorder $row]
5061 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5062 askvhighlight $row $id
5064 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5065 askfilehighlight $row $id
5067 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5068 askfindhighlight $row $id
5070 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5071 askrelhighlight $row $id
5073 if {![info exists iddrawn($id)]} {
5074 set col [lsearch -exact [lindex $rowidlist $row] $id]
5076 puts "oops, row $row id $id not in list"
5079 if {![info exists commitinfo($id)]} {
5083 drawcmittext $id $row $col
5087 if {$markingmatches} {
5088 markrowmatches $row $id
5092 proc drawcommits {row {endrow {}}} {
5093 global numcommits iddrawn displayorder curview need_redisplay
5094 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5099 if {$endrow eq {}} {
5102 if {$endrow >= $numcommits} {
5103 set endrow [expr {$numcommits - 1}]
5106 set rl1 [expr {$row - $downarrowlen - 3}]
5110 set ro1 [expr {$row - 3}]
5114 set r2 [expr {$endrow + $uparrowlen + 3}]
5115 if {$r2 > $numcommits} {
5118 for {set r $rl1} {$r < $r2} {incr r} {
5119 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5123 set rl1 [expr {$r + 1}]
5129 optimize_rows $ro1 0 $r2
5130 if {$need_redisplay || $nrows_drawn > 2000} {
5135 # make the lines join to already-drawn rows either side
5136 set r [expr {$row - 1}]
5137 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5140 set er [expr {$endrow + 1}]
5141 if {$er >= $numcommits ||
5142 ![info exists iddrawn([lindex $displayorder $er])]} {
5145 for {} {$r <= $er} {incr r} {
5146 set id [lindex $displayorder $r]
5147 set wasdrawn [info exists iddrawn($id)]
5149 if {$r == $er} break
5150 set nextid [lindex $displayorder [expr {$r + 1}]]
5151 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5152 drawparentlinks $id $r
5154 set rowids [lindex $rowidlist $r]
5155 foreach lid $rowids {
5156 if {$lid eq {}} continue
5157 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5159 # see if this is the first child of any of its parents
5160 foreach p [lindex $parentlist $r] {
5161 if {[lsearch -exact $rowids $p] < 0} {
5162 # make this line extend up to the child
5163 set lineend($p) [drawlineseg $p $r $er 0]
5167 set lineend($lid) [drawlineseg $lid $r $er 1]
5173 proc undolayout {row} {
5174 global uparrowlen mingaplen downarrowlen
5175 global rowidlist rowisopt rowfinal need_redisplay
5177 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5181 if {[llength $rowidlist] > $r} {
5183 set rowidlist [lrange $rowidlist 0 $r]
5184 set rowfinal [lrange $rowfinal 0 $r]
5185 set rowisopt [lrange $rowisopt 0 $r]
5186 set need_redisplay 1
5191 proc drawvisible {} {
5192 global canv linespc curview vrowmod selectedline targetrow targetid
5193 global need_redisplay cscroll numcommits
5195 set fs [$canv yview]
5196 set ymax [lindex [$canv cget -scrollregion] 3]
5197 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5198 set f0 [lindex $fs 0]
5199 set f1 [lindex $fs 1]
5200 set y0 [expr {int($f0 * $ymax)}]
5201 set y1 [expr {int($f1 * $ymax)}]
5203 if {[info exists targetid]} {
5204 if {[commitinview $targetid $curview]} {
5205 set r [rowofcommit $targetid]
5206 if {$r != $targetrow} {
5207 # Fix up the scrollregion and change the scrolling position
5208 # now that our target row has moved.
5209 set diff [expr {($r - $targetrow) * $linespc}]
5212 set ymax [lindex [$canv cget -scrollregion] 3]
5215 set f0 [expr {$y0 / $ymax}]
5216 set f1 [expr {$y1 / $ymax}]
5217 allcanvs yview moveto $f0
5218 $cscroll set $f0 $f1
5219 set need_redisplay 1
5226 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5227 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5228 if {$endrow >= $vrowmod($curview)} {
5229 update_arcrows $curview
5231 if {$selectedline ne {} &&
5232 $row <= $selectedline && $selectedline <= $endrow} {
5233 set targetrow $selectedline
5234 } elseif {[info exists targetid]} {
5235 set targetrow [expr {int(($row + $endrow) / 2)}]
5237 if {[info exists targetrow]} {
5238 if {$targetrow >= $numcommits} {
5239 set targetrow [expr {$numcommits - 1}]
5241 set targetid [commitonrow $targetrow]
5243 drawcommits $row $endrow
5246 proc clear_display {} {
5247 global iddrawn linesegs need_redisplay nrows_drawn
5248 global vhighlights fhighlights nhighlights rhighlights
5249 global linehtag linentag linedtag boldrows boldnamerows
5252 catch {unset iddrawn}
5253 catch {unset linesegs}
5254 catch {unset linehtag}
5255 catch {unset linentag}
5256 catch {unset linedtag}
5259 catch {unset vhighlights}
5260 catch {unset fhighlights}
5261 catch {unset nhighlights}
5262 catch {unset rhighlights}
5263 set need_redisplay 0
5267 proc findcrossings {id} {
5268 global rowidlist parentlist numcommits displayorder
5272 foreach {s e} [rowranges $id] {
5273 if {$e >= $numcommits} {
5274 set e [expr {$numcommits - 1}]
5276 if {$e <= $s} continue
5277 for {set row $e} {[incr row -1] >= $s} {} {
5278 set x [lsearch -exact [lindex $rowidlist $row] $id]
5280 set olds [lindex $parentlist $row]
5281 set kid [lindex $displayorder $row]
5282 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5283 if {$kidx < 0} continue
5284 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5286 set px [lsearch -exact $nextrow $p]
5287 if {$px < 0} continue
5288 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5289 if {[lsearch -exact $ccross $p] >= 0} continue
5290 if {$x == $px + ($kidx < $px? -1: 1)} {
5292 } elseif {[lsearch -exact $cross $p] < 0} {
5299 return [concat $ccross {{}} $cross]
5302 proc assigncolor {id} {
5303 global colormap colors nextcolor
5304 global parents children children curview
5306 if {[info exists colormap($id)]} return
5307 set ncolors [llength $colors]
5308 if {[info exists children($curview,$id)]} {
5309 set kids $children($curview,$id)
5313 if {[llength $kids] == 1} {
5314 set child [lindex $kids 0]
5315 if {[info exists colormap($child)]
5316 && [llength $parents($curview,$child)] == 1} {
5317 set colormap($id) $colormap($child)
5323 foreach x [findcrossings $id] {
5325 # delimiter between corner crossings and other crossings
5326 if {[llength $badcolors] >= $ncolors - 1} break
5327 set origbad $badcolors
5329 if {[info exists colormap($x)]
5330 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5331 lappend badcolors $colormap($x)
5334 if {[llength $badcolors] >= $ncolors} {
5335 set badcolors $origbad
5337 set origbad $badcolors
5338 if {[llength $badcolors] < $ncolors - 1} {
5339 foreach child $kids {
5340 if {[info exists colormap($child)]
5341 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5342 lappend badcolors $colormap($child)
5344 foreach p $parents($curview,$child) {
5345 if {[info exists colormap($p)]
5346 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5347 lappend badcolors $colormap($p)
5351 if {[llength $badcolors] >= $ncolors} {
5352 set badcolors $origbad
5355 for {set i 0} {$i <= $ncolors} {incr i} {
5356 set c [lindex $colors $nextcolor]
5357 if {[incr nextcolor] >= $ncolors} {
5360 if {[lsearch -exact $badcolors $c]} break
5362 set colormap($id) $c
5365 proc bindline {t id} {
5368 $canv bind $t <Enter> "lineenter %x %y $id"
5369 $canv bind $t <Motion> "linemotion %x %y $id"
5370 $canv bind $t <Leave> "lineleave $id"
5371 $canv bind $t <Button-1> "lineclick %x %y $id 1"
5374 proc drawtags {id x xt y1} {
5375 global idtags idheads idotherrefs mainhead
5376 global linespc lthickness
5377 global canv rowtextx curview fgcolor bgcolor ctxbut
5382 if {[info exists idtags($id)]} {
5383 set marks $idtags($id)
5384 set ntags [llength $marks]
5386 if {[info exists idheads($id)]} {
5387 set marks [concat $marks $idheads($id)]
5388 set nheads [llength $idheads($id)]
5390 if {[info exists idotherrefs($id)]} {
5391 set marks [concat $marks $idotherrefs($id)]
5397 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5398 set yt [expr {$y1 - 0.5 * $linespc}]
5399 set yb [expr {$yt + $linespc - 1}]
5403 foreach tag $marks {
5405 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5406 set wid [font measure mainfontbold $tag]
5408 set wid [font measure mainfont $tag]
5412 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5414 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5415 -width $lthickness -fill black -tags tag.$id]
5417 foreach tag $marks x $xvals wid $wvals {
5418 set xl [expr {$x + $delta}]
5419 set xr [expr {$x + $delta + $wid + $lthickness}]
5421 if {[incr ntags -1] >= 0} {
5423 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5424 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5425 -width 1 -outline black -fill yellow -tags tag.$id]
5426 $canv bind $t <1> [list showtag $tag 1]
5427 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5429 # draw a head or other ref
5430 if {[incr nheads -1] >= 0} {
5432 if {$tag eq $mainhead} {
5433 set font mainfontbold
5438 set xl [expr {$xl - $delta/2}]
5439 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5440 -width 1 -outline black -fill $col -tags tag.$id
5441 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5442 set rwid [font measure mainfont $remoteprefix]
5443 set xi [expr {$x + 1}]
5444 set yti [expr {$yt + 1}]
5445 set xri [expr {$x + $rwid}]
5446 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5447 -width 0 -fill "#ffddaa" -tags tag.$id
5450 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5451 -font $font -tags [list tag.$id text]]
5453 $canv bind $t <1> [list showtag $tag 1]
5454 } elseif {$nheads >= 0} {
5455 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
5461 proc xcoord {i level ln} {
5462 global canvx0 xspc1 xspc2
5464 set x [expr {$canvx0 + $i * $xspc1($ln)}]
5465 if {$i > 0 && $i == $level} {
5466 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5467 } elseif {$i > $level} {
5468 set x [expr {$x + $xspc2 - $xspc1($ln)}]
5473 proc show_status {msg} {
5477 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5478 -tags text -fill $fgcolor
5481 # Don't change the text pane cursor if it is currently the hand cursor,
5482 # showing that we are over a sha1 ID link.
5483 proc settextcursor {c} {
5484 global ctext curtextcursor
5486 if {[$ctext cget -cursor] == $curtextcursor} {
5487 $ctext config -cursor $c
5489 set curtextcursor $c
5492 proc nowbusy {what {name {}}} {
5493 global isbusy busyname statusw
5495 if {[array names isbusy] eq {}} {
5496 . config -cursor watch
5500 set busyname($what) $name
5502 $statusw conf -text $name
5506 proc notbusy {what} {
5507 global isbusy maincursor textcursor busyname statusw
5511 if {$busyname($what) ne {} &&
5512 [$statusw cget -text] eq $busyname($what)} {
5513 $statusw conf -text {}
5516 if {[array names isbusy] eq {}} {
5517 . config -cursor $maincursor
5518 settextcursor $textcursor
5522 proc findmatches {f} {
5523 global findtype findstring
5524 if {$findtype == [mc "Regexp"]} {
5525 set matches [regexp -indices -all -inline $findstring $f]
5528 if {$findtype == [mc "IgnCase"]} {
5529 set f [string tolower $f]
5530 set fs [string tolower $fs]
5534 set l [string length $fs]
5535 while {[set j [string first $fs $f $i]] >= 0} {
5536 lappend matches [list $j [expr {$j+$l-1}]]
5537 set i [expr {$j + $l}]
5543 proc dofind {{dirn 1} {wrap 1}} {
5544 global findstring findstartline findcurline selectedline numcommits
5545 global gdttype filehighlight fh_serial find_dirn findallowwrap
5547 if {[info exists find_dirn]} {
5548 if {$find_dirn == $dirn} return
5552 if {$findstring eq {} || $numcommits == 0} return
5553 if {$selectedline eq {}} {
5554 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5556 set findstartline $selectedline
5558 set findcurline $findstartline
5559 nowbusy finding [mc "Searching"]
5560 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5561 after cancel do_file_hl $fh_serial
5562 do_file_hl $fh_serial
5565 set findallowwrap $wrap
5569 proc stopfinding {} {
5570 global find_dirn findcurline fprogcoord
5572 if {[info exists find_dirn]} {
5582 global commitdata commitinfo numcommits findpattern findloc
5583 global findstartline findcurline findallowwrap
5584 global find_dirn gdttype fhighlights fprogcoord
5585 global curview varcorder vrownum varccommits vrowmod
5587 if {![info exists find_dirn]} {
5590 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5593 if {$find_dirn > 0} {
5595 if {$l >= $numcommits} {
5598 if {$l <= $findstartline} {
5599 set lim [expr {$findstartline + 1}]
5602 set moretodo $findallowwrap
5609 if {$l >= $findstartline} {
5610 set lim [expr {$findstartline - 1}]
5613 set moretodo $findallowwrap
5616 set n [expr {($lim - $l) * $find_dirn}]
5621 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5622 update_arcrows $curview
5626 set ai [bsearch $vrownum($curview) $l]
5627 set a [lindex $varcorder($curview) $ai]
5628 set arow [lindex $vrownum($curview) $ai]
5629 set ids [lindex $varccommits($curview,$a)]
5630 set arowend [expr {$arow + [llength $ids]}]
5631 if {$gdttype eq [mc "containing:"]} {
5632 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5633 if {$l < $arow || $l >= $arowend} {
5635 set a [lindex $varcorder($curview) $ai]
5636 set arow [lindex $vrownum($curview) $ai]
5637 set ids [lindex $varccommits($curview,$a)]
5638 set arowend [expr {$arow + [llength $ids]}]
5640 set id [lindex $ids [expr {$l - $arow}]]
5641 # shouldn't happen unless git log doesn't give all the commits...
5642 if {![info exists commitdata($id)] ||
5643 ![doesmatch $commitdata($id)]} {
5646 if {![info exists commitinfo($id)]} {
5649 set info $commitinfo($id)
5650 foreach f $info ty $fldtypes {
5651 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5660 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5661 if {$l < $arow || $l >= $arowend} {
5663 set a [lindex $varcorder($curview) $ai]
5664 set arow [lindex $vrownum($curview) $ai]
5665 set ids [lindex $varccommits($curview,$a)]
5666 set arowend [expr {$arow + [llength $ids]}]
5668 set id [lindex $ids [expr {$l - $arow}]]
5669 if {![info exists fhighlights($id)]} {
5670 # this sets fhighlights($id) to -1
5671 askfilehighlight $l $id
5673 if {$fhighlights($id) > 0} {
5677 if {$fhighlights($id) < 0} {
5680 set findcurline [expr {$l - $find_dirn}]
5685 if {$found || ($domore && !$moretodo)} {
5701 set findcurline [expr {$l - $find_dirn}]
5703 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5707 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5712 proc findselectline {l} {
5713 global findloc commentend ctext findcurline markingmatches gdttype
5715 set markingmatches 1
5718 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5719 # highlight the matches in the comments
5720 set f [$ctext get 1.0 $commentend]
5721 set matches [findmatches $f]
5722 foreach match $matches {
5723 set start [lindex $match 0]
5724 set end [expr {[lindex $match 1] + 1}]
5725 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5731 # mark the bits of a headline or author that match a find string
5732 proc markmatches {canv l str tag matches font row} {
5735 set bbox [$canv bbox $tag]
5736 set x0 [lindex $bbox 0]
5737 set y0 [lindex $bbox 1]
5738 set y1 [lindex $bbox 3]
5739 foreach match $matches {
5740 set start [lindex $match 0]
5741 set end [lindex $match 1]
5742 if {$start > $end} continue
5743 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5744 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5745 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5746 [expr {$x0+$xlen+2}] $y1 \
5747 -outline {} -tags [list match$l matches] -fill yellow]
5749 if {$row == $selectedline} {
5750 $canv raise $t secsel
5755 proc unmarkmatches {} {
5756 global markingmatches
5758 allcanvs delete matches
5759 set markingmatches 0
5763 proc selcanvline {w x y} {
5764 global canv canvy0 ctext linespc
5766 set ymax [lindex [$canv cget -scrollregion] 3]
5767 if {$ymax == {}} return
5768 set yfrac [lindex [$canv yview] 0]
5769 set y [expr {$y + $yfrac * $ymax}]
5770 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5775 set xmax [lindex [$canv cget -scrollregion] 2]
5776 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5777 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5783 proc commit_descriptor {p} {
5785 if {![info exists commitinfo($p)]} {
5789 if {[llength $commitinfo($p)] > 1} {
5790 set l [lindex $commitinfo($p) 0]
5795 # append some text to the ctext widget, and make any SHA1 ID
5796 # that we know about be a clickable link.
5797 proc appendwithlinks {text tags} {
5798 global ctext linknum curview pendinglinks
5800 set start [$ctext index "end - 1c"]
5801 $ctext insert end $text $tags
5802 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5806 set linkid [string range $text $s $e]
5808 $ctext tag delete link$linknum
5809 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5810 setlink $linkid link$linknum
5815 proc setlink {id lk} {
5816 global curview ctext pendinglinks commitinterest
5818 if {[commitinview $id $curview]} {
5819 $ctext tag conf $lk -foreground blue -underline 1
5820 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5821 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5822 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5824 lappend pendinglinks($id) $lk
5825 lappend commitinterest($id) {makelink %I}
5829 proc makelink {id} {
5832 if {![info exists pendinglinks($id)]} return
5833 foreach lk $pendinglinks($id) {
5836 unset pendinglinks($id)
5839 proc linkcursor {w inc} {
5840 global linkentercount curtextcursor
5842 if {[incr linkentercount $inc] > 0} {
5843 $w configure -cursor hand2
5845 $w configure -cursor $curtextcursor
5846 if {$linkentercount < 0} {
5847 set linkentercount 0
5852 proc viewnextline {dir} {
5856 set ymax [lindex [$canv cget -scrollregion] 3]
5857 set wnow [$canv yview]
5858 set wtop [expr {[lindex $wnow 0] * $ymax}]
5859 set newtop [expr {$wtop + $dir * $linespc}]
5862 } elseif {$newtop > $ymax} {
5865 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5868 # add a list of tag or branch names at position pos
5869 # returns the number of names inserted
5870 proc appendrefs {pos ids var} {
5871 global ctext linknum curview $var maxrefs
5873 if {[catch {$ctext index $pos}]} {
5876 $ctext conf -state normal
5877 $ctext delete $pos "$pos lineend"
5880 foreach tag [set $var\($id\)] {
5881 lappend tags [list $tag $id]
5884 if {[llength $tags] > $maxrefs} {
5885 $ctext insert $pos "many ([llength $tags])"
5887 set tags [lsort -index 0 -decreasing $tags]
5890 set id [lindex $ti 1]
5893 $ctext tag delete $lk
5894 $ctext insert $pos $sep
5895 $ctext insert $pos [lindex $ti 0] $lk
5900 $ctext conf -state disabled
5901 return [llength $tags]
5904 # called when we have finished computing the nearby tags
5905 proc dispneartags {delay} {
5906 global selectedline currentid showneartags tagphase
5908 if {$selectedline eq {} || !$showneartags} return
5909 after cancel dispnexttag
5911 after 200 dispnexttag
5914 after idle dispnexttag
5919 proc dispnexttag {} {
5920 global selectedline currentid showneartags tagphase ctext
5922 if {$selectedline eq {} || !$showneartags} return
5923 switch -- $tagphase {
5925 set dtags [desctags $currentid]
5927 appendrefs precedes $dtags idtags
5931 set atags [anctags $currentid]
5933 appendrefs follows $atags idtags
5937 set dheads [descheads $currentid]
5938 if {$dheads ne {}} {
5939 if {[appendrefs branch $dheads idheads] > 1
5940 && [$ctext get "branch -3c"] eq "h"} {
5941 # turn "Branch" into "Branches"
5942 $ctext conf -state normal
5943 $ctext insert "branch -2c" "es"
5944 $ctext conf -state disabled
5949 if {[incr tagphase] <= 2} {
5950 after idle dispnexttag
5954 proc make_secsel {l} {
5955 global linehtag linentag linedtag canv canv2 canv3
5957 if {![info exists linehtag($l)]} return
5959 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5960 -tags secsel -fill [$canv cget -selectbackground]]
5962 $canv2 delete secsel
5963 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5964 -tags secsel -fill [$canv2 cget -selectbackground]]
5966 $canv3 delete secsel
5967 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5968 -tags secsel -fill [$canv3 cget -selectbackground]]
5972 proc selectline {l isnew} {
5973 global canv ctext commitinfo selectedline
5974 global canvy0 linespc parents children curview
5975 global currentid sha1entry
5976 global commentend idtags linknum
5977 global mergemax numcommits pending_select
5978 global cmitmode showneartags allcommits
5979 global targetrow targetid lastscrollrows
5982 catch {unset pending_select}
5987 if {$l < 0 || $l >= $numcommits} return
5988 set id [commitonrow $l]
5993 if {$lastscrollrows < $numcommits} {
5997 set y [expr {$canvy0 + $l * $linespc}]
5998 set ymax [lindex [$canv cget -scrollregion] 3]
5999 set ytop [expr {$y - $linespc - 1}]
6000 set ybot [expr {$y + $linespc + 1}]
6001 set wnow [$canv yview]
6002 set wtop [expr {[lindex $wnow 0] * $ymax}]
6003 set wbot [expr {[lindex $wnow 1] * $ymax}]
6004 set wh [expr {$wbot - $wtop}]
6006 if {$ytop < $wtop} {
6007 if {$ybot < $wtop} {
6008 set newtop [expr {$y - $wh / 2.0}]
6011 if {$newtop > $wtop - $linespc} {
6012 set newtop [expr {$wtop - $linespc}]
6015 } elseif {$ybot > $wbot} {
6016 if {$ytop > $wbot} {
6017 set newtop [expr {$y - $wh / 2.0}]
6019 set newtop [expr {$ybot - $wh}]
6020 if {$newtop < $wtop + $linespc} {
6021 set newtop [expr {$wtop + $linespc}]
6025 if {$newtop != $wtop} {
6029 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6036 addtohistory [list selbyid $id]
6039 $sha1entry delete 0 end
6040 $sha1entry insert 0 $id
6042 $sha1entry selection from 0
6043 $sha1entry selection to end
6047 $ctext conf -state normal
6050 if {![info exists commitinfo($id)]} {
6053 set info $commitinfo($id)
6054 set date [formatdate [lindex $info 2]]
6055 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6056 set date [formatdate [lindex $info 4]]
6057 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6058 if {[info exists idtags($id)]} {
6059 $ctext insert end [mc "Tags:"]
6060 foreach tag $idtags($id) {
6061 $ctext insert end " $tag"
6063 $ctext insert end "\n"
6067 set olds $parents($curview,$id)
6068 if {[llength $olds] > 1} {
6071 if {$np >= $mergemax} {
6076 $ctext insert end "[mc "Parent"]: " $tag
6077 appendwithlinks [commit_descriptor $p] {}
6082 append headers "[mc "Parent"]: [commit_descriptor $p]"
6086 foreach c $children($curview,$id) {
6087 append headers "[mc "Child"]: [commit_descriptor $c]"
6090 # make anything that looks like a SHA1 ID be a clickable link
6091 appendwithlinks $headers {}
6092 if {$showneartags} {
6093 if {![info exists allcommits]} {
6096 $ctext insert end "[mc "Branch"]: "
6097 $ctext mark set branch "end -1c"
6098 $ctext mark gravity branch left
6099 $ctext insert end "\n[mc "Follows"]: "
6100 $ctext mark set follows "end -1c"
6101 $ctext mark gravity follows left
6102 $ctext insert end "\n[mc "Precedes"]: "
6103 $ctext mark set precedes "end -1c"
6104 $ctext mark gravity precedes left
6105 $ctext insert end "\n"
6108 $ctext insert end "\n"
6109 set comment [lindex $info 5]
6110 if {[string first "\r" $comment] >= 0} {
6111 set comment [string map {"\r" "\n "} $comment]
6113 appendwithlinks $comment {comment}
6115 $ctext tag remove found 1.0 end
6116 $ctext conf -state disabled
6117 set commentend [$ctext index "end - 1c"]
6119 init_flist [mc "Comments"]
6120 if {$cmitmode eq "tree"} {
6122 } elseif {[llength $olds] <= 1} {
6129 proc selfirstline {} {
6134 proc sellastline {} {
6137 set l [expr {$numcommits - 1}]
6141 proc selnextline {dir} {
6144 if {$selectedline eq {}} return
6145 set l [expr {$selectedline + $dir}]
6150 proc selnextpage {dir} {
6151 global canv linespc selectedline numcommits
6153 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6157 allcanvs yview scroll [expr {$dir * $lpp}] units
6159 if {$selectedline eq {}} return
6160 set l [expr {$selectedline + $dir * $lpp}]
6163 } elseif {$l >= $numcommits} {
6164 set l [expr $numcommits - 1]
6170 proc unselectline {} {
6171 global selectedline currentid
6174 catch {unset currentid}
6175 allcanvs delete secsel
6179 proc reselectline {} {
6182 if {$selectedline ne {}} {
6183 selectline $selectedline 0
6187 proc addtohistory {cmd} {
6188 global history historyindex curview
6190 set elt [list $curview $cmd]
6191 if {$historyindex > 0
6192 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6196 if {$historyindex < [llength $history]} {
6197 set history [lreplace $history $historyindex end $elt]
6199 lappend history $elt
6202 if {$historyindex > 1} {
6203 .tf.bar.leftbut conf -state normal
6205 .tf.bar.leftbut conf -state disabled
6207 .tf.bar.rightbut conf -state disabled
6213 set view [lindex $elt 0]
6214 set cmd [lindex $elt 1]
6215 if {$curview != $view} {
6222 global history historyindex
6225 if {$historyindex > 1} {
6226 incr historyindex -1
6227 godo [lindex $history [expr {$historyindex - 1}]]
6228 .tf.bar.rightbut conf -state normal
6230 if {$historyindex <= 1} {
6231 .tf.bar.leftbut conf -state disabled
6236 global history historyindex
6239 if {$historyindex < [llength $history]} {
6240 set cmd [lindex $history $historyindex]
6243 .tf.bar.leftbut conf -state normal
6245 if {$historyindex >= [llength $history]} {
6246 .tf.bar.rightbut conf -state disabled
6251 global treefilelist treeidlist diffids diffmergeid treepending
6252 global nullid nullid2
6255 catch {unset diffmergeid}
6256 if {![info exists treefilelist($id)]} {
6257 if {![info exists treepending]} {
6258 if {$id eq $nullid} {
6259 set cmd [list | git ls-files]
6260 } elseif {$id eq $nullid2} {
6261 set cmd [list | git ls-files --stage -t]
6263 set cmd [list | git ls-tree -r $id]
6265 if {[catch {set gtf [open $cmd r]}]} {
6269 set treefilelist($id) {}
6270 set treeidlist($id) {}
6271 fconfigure $gtf -blocking 0 -encoding binary
6272 filerun $gtf [list gettreeline $gtf $id]
6279 proc gettreeline {gtf id} {
6280 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6283 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6284 if {$diffids eq $nullid} {
6287 set i [string first "\t" $line]
6288 if {$i < 0} continue
6289 set fname [string range $line [expr {$i+1}] end]
6290 set line [string range $line 0 [expr {$i-1}]]
6291 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6292 set sha1 [lindex $line 2]
6293 lappend treeidlist($id) $sha1
6295 if {[string index $fname 0] eq "\""} {
6296 set fname [lindex $fname 0]
6298 set fname [encoding convertfrom $fname]
6299 lappend treefilelist($id) $fname
6302 return [expr {$nl >= 1000? 2: 1}]
6306 if {$cmitmode ne "tree"} {
6307 if {![info exists diffmergeid]} {
6308 gettreediffs $diffids
6310 } elseif {$id ne $diffids} {
6319 global treefilelist treeidlist diffids nullid nullid2
6320 global ctext commentend
6322 set i [lsearch -exact $treefilelist($diffids) $f]
6324 puts "oops, $f not in list for id $diffids"
6327 if {$diffids eq $nullid} {
6328 if {[catch {set bf [open $f r]} err]} {
6329 puts "oops, can't read $f: $err"
6333 set blob [lindex $treeidlist($diffids) $i]
6334 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6335 puts "oops, error reading blob $blob: $err"
6339 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6340 filerun $bf [list getblobline $bf $diffids]
6341 $ctext config -state normal
6342 clear_ctext $commentend
6343 $ctext insert end "\n"
6344 $ctext insert end "$f\n" filesep
6345 $ctext config -state disabled
6346 $ctext yview $commentend
6350 proc getblobline {bf id} {
6351 global diffids cmitmode ctext
6353 if {$id ne $diffids || $cmitmode ne "tree"} {
6357 $ctext config -state normal
6359 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6360 $ctext insert end "$line\n"
6363 # delete last newline
6364 $ctext delete "end - 2c" "end - 1c"
6368 $ctext config -state disabled
6369 return [expr {$nl >= 1000? 2: 1}]
6372 proc mergediff {id} {
6373 global diffmergeid mdifffd
6378 global limitdiffs vfilelimit curview
6382 # this doesn't seem to actually affect anything...
6383 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
6384 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6385 set cmd [concat $cmd -- $vfilelimit($curview)]
6387 if {[catch {set mdf [open $cmd r]} err]} {
6388 error_popup "[mc "Error getting merge diffs:"] $err"
6391 fconfigure $mdf -blocking 0 -encoding binary
6392 set mdifffd($id) $mdf
6393 set np [llength $parents($curview,$id)]
6394 set diffencoding [get_path_encoding {}]
6396 filerun $mdf [list getmergediffline $mdf $id $np]
6399 proc getmergediffline {mdf id np} {
6400 global diffmergeid ctext cflist mergemax
6401 global difffilestart mdifffd
6404 $ctext conf -state normal
6406 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
6407 if {![info exists diffmergeid] || $id != $diffmergeid
6408 || $mdf != $mdifffd($id)} {
6412 if {[regexp {^diff --cc (.*)} $line match fname]} {
6413 # start of a new file
6414 set fname [encoding convertfrom $fname]
6415 $ctext insert end "\n"
6416 set here [$ctext index "end - 1c"]
6417 lappend difffilestart $here
6418 add_flist [list $fname]
6419 set diffencoding [get_path_encoding $fname]
6420 set l [expr {(78 - [string length $fname]) / 2}]
6421 set pad [string range "----------------------------------------" 1 $l]
6422 $ctext insert end "$pad $fname $pad\n" filesep
6423 } elseif {[regexp {^@@} $line]} {
6424 set line [encoding convertfrom $diffencoding $line]
6425 $ctext insert end "$line\n" hunksep
6426 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
6429 set line [encoding convertfrom $diffencoding $line]
6430 # parse the prefix - one ' ', '-' or '+' for each parent
6435 for {set j 0} {$j < $np} {incr j} {
6436 set c [string range $line $j $j]
6439 } elseif {$c == "-"} {
6441 } elseif {$c == "+"} {
6450 if {!$isbad && $minuses ne {} && $pluses eq {}} {
6451 # line doesn't appear in result, parents in $minuses have the line
6452 set num [lindex $minuses 0]
6453 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
6454 # line appears in result, parents in $pluses don't have the line
6455 lappend tags mresult
6456 set num [lindex $spaces 0]
6459 if {$num >= $mergemax} {
6464 $ctext insert end "$line\n" $tags
6467 $ctext conf -state disabled
6472 return [expr {$nr >= 1000? 2: 1}]
6475 proc startdiff {ids} {
6476 global treediffs diffids treepending diffmergeid nullid nullid2
6480 catch {unset diffmergeid}
6481 if {![info exists treediffs($ids)] ||
6482 [lsearch -exact $ids $nullid] >= 0 ||
6483 [lsearch -exact $ids $nullid2] >= 0} {
6484 if {![info exists treepending]} {
6492 proc path_filter {filter name} {
6494 set l [string length $p]
6495 if {[string index $p end] eq "/"} {
6496 if {[string compare -length $l $p $name] == 0} {
6500 if {[string compare -length $l $p $name] == 0 &&
6501 ([string length $name] == $l ||
6502 [string index $name $l] eq "/")} {
6510 proc addtocflist {ids} {
6513 add_flist $treediffs($ids)
6517 proc diffcmd {ids flags} {
6518 global nullid nullid2
6520 set i [lsearch -exact $ids $nullid]
6521 set j [lsearch -exact $ids $nullid2]
6523 if {[llength $ids] > 1 && $j < 0} {
6524 # comparing working directory with some specific revision
6525 set cmd [concat | git diff-index $flags]
6527 lappend cmd -R [lindex $ids 1]
6529 lappend cmd [lindex $ids 0]
6532 # comparing working directory with index
6533 set cmd [concat | git diff-files $flags]
6538 } elseif {$j >= 0} {
6539 set cmd [concat | git diff-index --cached $flags]
6540 if {[llength $ids] > 1} {
6541 # comparing index with specific revision
6543 lappend cmd -R [lindex $ids 1]
6545 lappend cmd [lindex $ids 0]
6548 # comparing index with HEAD
6552 set cmd [concat | git diff-tree -r $flags $ids]
6557 proc gettreediffs {ids} {
6558 global treediff treepending
6560 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6562 set treepending $ids
6564 fconfigure $gdtf -blocking 0 -encoding binary
6565 filerun $gdtf [list gettreediffline $gdtf $ids]
6568 proc gettreediffline {gdtf ids} {
6569 global treediff treediffs treepending diffids diffmergeid
6570 global cmitmode vfilelimit curview limitdiffs perfile_attrs
6575 if {$perfile_attrs} {
6576 # cache_gitattr is slow, and even slower on win32 where we
6577 # have to invoke it for only about 30 paths at a time
6579 if {[tk windowingsystem] == "win32"} {
6583 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
6584 set i [string first "\t" $line]
6586 set file [string range $line [expr {$i+1}] end]
6587 if {[string index $file 0] eq "\""} {
6588 set file [lindex $file 0]
6590 set file [encoding convertfrom $file]
6591 lappend treediff $file
6592 lappend sublist $file
6595 if {$perfile_attrs} {
6596 cache_gitattr encoding $sublist
6599 return [expr {$nr >= $max? 2: 1}]
6602 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6604 foreach f $treediff {
6605 if {[path_filter $vfilelimit($curview) $f]} {
6609 set treediffs($ids) $flist
6611 set treediffs($ids) $treediff
6614 if {$cmitmode eq "tree"} {
6616 } elseif {$ids != $diffids} {
6617 if {![info exists diffmergeid]} {
6618 gettreediffs $diffids
6626 # empty string or positive integer
6627 proc diffcontextvalidate {v} {
6628 return [regexp {^(|[1-9][0-9]*)$} $v]
6631 proc diffcontextchange {n1 n2 op} {
6632 global diffcontextstring diffcontext
6634 if {[string is integer -strict $diffcontextstring]} {
6635 if {$diffcontextstring > 0} {
6636 set diffcontext $diffcontextstring
6642 proc changeignorespace {} {
6646 proc getblobdiffs {ids} {
6647 global blobdifffd diffids env
6648 global diffinhdr treediffs
6651 global limitdiffs vfilelimit curview
6654 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6658 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6659 set cmd [concat $cmd -- $vfilelimit($curview)]
6661 if {[catch {set bdf [open $cmd r]} err]} {
6662 puts "error getting diffs: $err"
6666 set diffencoding [get_path_encoding {}]
6667 fconfigure $bdf -blocking 0 -encoding binary
6668 set blobdifffd($ids) $bdf
6669 filerun $bdf [list getblobdiffline $bdf $diffids]
6672 proc setinlist {var i val} {
6675 while {[llength [set $var]] < $i} {
6678 if {[llength [set $var]] == $i} {
6685 proc makediffhdr {fname ids} {
6686 global ctext curdiffstart treediffs
6688 set i [lsearch -exact $treediffs($ids) $fname]
6690 setinlist difffilestart $i $curdiffstart
6692 set l [expr {(78 - [string length $fname]) / 2}]
6693 set pad [string range "----------------------------------------" 1 $l]
6694 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6697 proc getblobdiffline {bdf ids} {
6698 global diffids blobdifffd ctext curdiffstart
6699 global diffnexthead diffnextnote difffilestart
6700 global diffinhdr treediffs
6704 $ctext conf -state normal
6705 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6706 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6710 if {![string compare -length 11 "diff --git " $line]} {
6711 # trim off "diff --git "
6712 set line [string range $line 11 end]
6714 # start of a new file
6715 $ctext insert end "\n"
6716 set curdiffstart [$ctext index "end - 1c"]
6717 $ctext insert end "\n" filesep
6718 # If the name hasn't changed the length will be odd,
6719 # the middle char will be a space, and the two bits either
6720 # side will be a/name and b/name, or "a/name" and "b/name".
6721 # If the name has changed we'll get "rename from" and
6722 # "rename to" or "copy from" and "copy to" lines following this,
6723 # and we'll use them to get the filenames.
6724 # This complexity is necessary because spaces in the filename(s)
6725 # don't get escaped.
6726 set l [string length $line]
6727 set i [expr {$l / 2}]
6728 if {!(($l & 1) && [string index $line $i] eq " " &&
6729 [string range $line 2 [expr {$i - 1}]] eq \
6730 [string range $line [expr {$i + 3}] end])} {
6733 # unescape if quoted and chop off the a/ from the front
6734 if {[string index $line 0] eq "\""} {
6735 set fname [string range [lindex $line 0] 2 end]
6737 set fname [string range $line 2 [expr {$i - 1}]]
6739 set fname [encoding convertfrom $fname]
6740 set diffencoding [get_path_encoding $fname]
6741 makediffhdr $fname $ids
6743 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6744 $line match f1l f1c f2l f2c rest]} {
6745 set line [encoding convertfrom $diffencoding $line]
6746 $ctext insert end "$line\n" hunksep
6749 } elseif {$diffinhdr} {
6750 if {![string compare -length 12 "rename from " $line]} {
6751 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6752 if {[string index $fname 0] eq "\""} {
6753 set fname [lindex $fname 0]
6755 set fname [encoding convertfrom $fname]
6756 set i [lsearch -exact $treediffs($ids) $fname]
6758 setinlist difffilestart $i $curdiffstart
6760 } elseif {![string compare -length 10 $line "rename to "] ||
6761 ![string compare -length 8 $line "copy to "]} {
6762 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6763 if {[string index $fname 0] eq "\""} {
6764 set fname [lindex $fname 0]
6766 set fname [encoding convertfrom $fname]
6767 set diffencoding [get_path_encoding $fname]
6768 makediffhdr $fname $ids
6769 } elseif {[string compare -length 3 $line "---"] == 0} {
6772 } elseif {[string compare -length 3 $line "+++"] == 0} {
6776 $ctext insert end "$line\n" filesep
6779 set line [encoding convertfrom $diffencoding $line]
6780 set x [string range $line 0 0]
6781 if {$x == "-" || $x == "+"} {
6782 set tag [expr {$x == "+"}]
6783 $ctext insert end "$line\n" d$tag
6784 } elseif {$x == " "} {
6785 $ctext insert end "$line\n"
6787 # "\ No newline at end of file",
6788 # or something else we don't recognize
6789 $ctext insert end "$line\n" hunksep
6793 $ctext conf -state disabled
6798 return [expr {$nr >= 1000? 2: 1}]
6801 proc changediffdisp {} {
6802 global ctext diffelide
6804 $ctext tag conf d0 -elide [lindex $diffelide 0]
6805 $ctext tag conf d1 -elide [lindex $diffelide 1]
6808 proc highlightfile {loc cline} {
6809 global ctext cflist cflist_top
6812 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
6813 $cflist tag add highlight $cline.0 "$cline.0 lineend"
6814 $cflist see $cline.0
6815 set cflist_top $cline
6819 global difffilestart ctext cmitmode
6821 if {$cmitmode eq "tree"} return
6824 set here [$ctext index @0,0]
6825 foreach loc $difffilestart {
6826 if {[$ctext compare $loc >= $here]} {
6827 highlightfile $prev $prevline
6833 highlightfile $prev $prevline
6837 global difffilestart ctext cmitmode
6839 if {$cmitmode eq "tree"} return
6840 set here [$ctext index @0,0]
6842 foreach loc $difffilestart {
6844 if {[$ctext compare $loc > $here]} {
6845 highlightfile $loc $line
6851 proc clear_ctext {{first 1.0}} {
6852 global ctext smarktop smarkbot
6855 set l [lindex [split $first .] 0]
6856 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6859 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6862 $ctext delete $first end
6863 if {$first eq "1.0"} {
6864 catch {unset pendinglinks}
6868 proc settabs {{firstab {}}} {
6869 global firsttabstop tabstop ctext have_tk85
6871 if {$firstab ne {} && $have_tk85} {
6872 set firsttabstop $firstab
6874 set w [font measure textfont "0"]
6875 if {$firsttabstop != 0} {
6876 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6877 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6878 } elseif {$have_tk85 || $tabstop != 8} {
6879 $ctext conf -tabs [expr {$tabstop * $w}]
6881 $ctext conf -tabs {}
6885 proc incrsearch {name ix op} {
6886 global ctext searchstring searchdirn
6888 $ctext tag remove found 1.0 end
6889 if {[catch {$ctext index anchor}]} {
6890 # no anchor set, use start of selection, or of visible area
6891 set sel [$ctext tag ranges sel]
6893 $ctext mark set anchor [lindex $sel 0]
6894 } elseif {$searchdirn eq "-forwards"} {
6895 $ctext mark set anchor @0,0
6897 $ctext mark set anchor @0,[winfo height $ctext]
6900 if {$searchstring ne {}} {
6901 set here [$ctext search $searchdirn -- $searchstring anchor]
6910 global sstring ctext searchstring searchdirn
6913 $sstring icursor end
6914 set searchdirn -forwards
6915 if {$searchstring ne {}} {
6916 set sel [$ctext tag ranges sel]
6918 set start "[lindex $sel 0] + 1c"
6919 } elseif {[catch {set start [$ctext index anchor]}]} {
6922 set match [$ctext search -count mlen -- $searchstring $start]
6923 $ctext tag remove sel 1.0 end
6929 set mend "$match + $mlen c"
6930 $ctext tag add sel $match $mend
6931 $ctext mark unset anchor
6935 proc dosearchback {} {
6936 global sstring ctext searchstring searchdirn
6939 $sstring icursor end
6940 set searchdirn -backwards
6941 if {$searchstring ne {}} {
6942 set sel [$ctext tag ranges sel]
6944 set start [lindex $sel 0]
6945 } elseif {[catch {set start [$ctext index anchor]}]} {
6946 set start @0,[winfo height $ctext]
6948 set match [$ctext search -backwards -count ml -- $searchstring $start]
6949 $ctext tag remove sel 1.0 end
6955 set mend "$match + $ml c"
6956 $ctext tag add sel $match $mend
6957 $ctext mark unset anchor
6961 proc searchmark {first last} {
6962 global ctext searchstring
6966 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6967 if {$match eq {}} break
6968 set mend "$match + $mlen c"
6969 $ctext tag add found $match $mend
6973 proc searchmarkvisible {doall} {
6974 global ctext smarktop smarkbot
6976 set topline [lindex [split [$ctext index @0,0] .] 0]
6977 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6978 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6979 # no overlap with previous
6980 searchmark $topline $botline
6981 set smarktop $topline
6982 set smarkbot $botline
6984 if {$topline < $smarktop} {
6985 searchmark $topline [expr {$smarktop-1}]
6986 set smarktop $topline
6988 if {$botline > $smarkbot} {
6989 searchmark [expr {$smarkbot+1}] $botline
6990 set smarkbot $botline
6995 proc scrolltext {f0 f1} {
6998 .bleft.bottom.sb set $f0 $f1
6999 if {$searchstring ne {}} {
7005 global linespc charspc canvx0 canvy0
7006 global xspc1 xspc2 lthickness
7008 set linespc [font metrics mainfont -linespace]
7009 set charspc [font measure mainfont "m"]
7010 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7011 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7012 set lthickness [expr {int($linespc / 9) + 1}]
7013 set xspc1(0) $linespc
7021 set ymax [lindex [$canv cget -scrollregion] 3]
7022 if {$ymax eq {} || $ymax == 0} return
7023 set span [$canv yview]
7026 allcanvs yview moveto [lindex $span 0]
7028 if {$selectedline ne {}} {
7029 selectline $selectedline 0
7030 allcanvs yview moveto [lindex $span 0]
7034 proc parsefont {f n} {
7037 set fontattr($f,family) [lindex $n 0]
7039 if {$s eq {} || $s == 0} {
7042 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7044 set fontattr($f,size) $s
7045 set fontattr($f,weight) normal
7046 set fontattr($f,slant) roman
7047 foreach style [lrange $n 2 end] {
7050 "bold" {set fontattr($f,weight) $style}
7052 "italic" {set fontattr($f,slant) $style}
7057 proc fontflags {f {isbold 0}} {
7060 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7061 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7062 -slant $fontattr($f,slant)]
7068 set n [list $fontattr($f,family) $fontattr($f,size)]
7069 if {$fontattr($f,weight) eq "bold"} {
7072 if {$fontattr($f,slant) eq "italic"} {
7078 proc incrfont {inc} {
7079 global mainfont textfont ctext canv cflist showrefstop
7080 global stopped entries fontattr
7083 set s $fontattr(mainfont,size)
7088 set fontattr(mainfont,size) $s
7089 font config mainfont -size $s
7090 font config mainfontbold -size $s
7091 set mainfont [fontname mainfont]
7092 set s $fontattr(textfont,size)
7097 set fontattr(textfont,size) $s
7098 font config textfont -size $s
7099 font config textfontbold -size $s
7100 set textfont [fontname textfont]
7107 global sha1entry sha1string
7108 if {[string length $sha1string] == 40} {
7109 $sha1entry delete 0 end
7113 proc sha1change {n1 n2 op} {
7114 global sha1string currentid sha1but
7115 if {$sha1string == {}
7116 || ([info exists currentid] && $sha1string == $currentid)} {
7121 if {[$sha1but cget -state] == $state} return
7122 if {$state == "normal"} {
7123 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7125 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7129 proc gotocommit {} {
7130 global sha1string tagids headids curview varcid
7132 if {$sha1string == {}
7133 || ([info exists currentid] && $sha1string == $currentid)} return
7134 if {[info exists tagids($sha1string)]} {
7135 set id $tagids($sha1string)
7136 } elseif {[info exists headids($sha1string)]} {
7137 set id $headids($sha1string)
7139 set id [string tolower $sha1string]
7140 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7141 set matches [array names varcid "$curview,$id*"]
7142 if {$matches ne {}} {
7143 if {[llength $matches] > 1} {
7144 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7147 set id [lindex [split [lindex $matches 0] ","] 1]
7151 if {[commitinview $id $curview]} {
7152 selectline [rowofcommit $id] 1
7155 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7156 set msg [mc "SHA1 id %s is not known" $sha1string]
7158 set msg [mc "Tag/Head %s is not known" $sha1string]
7163 proc lineenter {x y id} {
7164 global hoverx hovery hoverid hovertimer
7165 global commitinfo canv
7167 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7171 if {[info exists hovertimer]} {
7172 after cancel $hovertimer
7174 set hovertimer [after 500 linehover]
7178 proc linemotion {x y id} {
7179 global hoverx hovery hoverid hovertimer
7181 if {[info exists hoverid] && $id == $hoverid} {
7184 if {[info exists hovertimer]} {
7185 after cancel $hovertimer
7187 set hovertimer [after 500 linehover]
7191 proc lineleave {id} {
7192 global hoverid hovertimer canv
7194 if {[info exists hoverid] && $id == $hoverid} {
7196 if {[info exists hovertimer]} {
7197 after cancel $hovertimer
7205 global hoverx hovery hoverid hovertimer
7206 global canv linespc lthickness
7209 set text [lindex $commitinfo($hoverid) 0]
7210 set ymax [lindex [$canv cget -scrollregion] 3]
7211 if {$ymax == {}} return
7212 set yfrac [lindex [$canv yview] 0]
7213 set x [expr {$hoverx + 2 * $linespc}]
7214 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7215 set x0 [expr {$x - 2 * $lthickness}]
7216 set y0 [expr {$y - 2 * $lthickness}]
7217 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7218 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7219 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7220 -fill \#ffff80 -outline black -width 1 -tags hover]
7222 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7227 proc clickisonarrow {id y} {
7230 set ranges [rowranges $id]
7231 set thresh [expr {2 * $lthickness + 6}]
7232 set n [expr {[llength $ranges] - 1}]
7233 for {set i 1} {$i < $n} {incr i} {
7234 set row [lindex $ranges $i]
7235 if {abs([yc $row] - $y) < $thresh} {
7242 proc arrowjump {id n y} {
7245 # 1 <-> 2, 3 <-> 4, etc...
7246 set n [expr {(($n - 1) ^ 1) + 1}]
7247 set row [lindex [rowranges $id] $n]
7249 set ymax [lindex [$canv cget -scrollregion] 3]
7250 if {$ymax eq {} || $ymax <= 0} return
7251 set view [$canv yview]
7252 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7253 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7257 allcanvs yview moveto $yfrac
7260 proc lineclick {x y id isnew} {
7261 global ctext commitinfo children canv thickerline curview
7263 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7268 # draw this line thicker than normal
7272 set ymax [lindex [$canv cget -scrollregion] 3]
7273 if {$ymax eq {}} return
7274 set yfrac [lindex [$canv yview] 0]
7275 set y [expr {$y + $yfrac * $ymax}]
7277 set dirn [clickisonarrow $id $y]
7279 arrowjump $id $dirn $y
7284 addtohistory [list lineclick $x $y $id 0]
7286 # fill the details pane with info about this line
7287 $ctext conf -state normal
7290 $ctext insert end "[mc "Parent"]:\t"
7291 $ctext insert end $id link0
7293 set info $commitinfo($id)
7294 $ctext insert end "\n\t[lindex $info 0]\n"
7295 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7296 set date [formatdate [lindex $info 2]]
7297 $ctext insert end "\t[mc "Date"]:\t$date\n"
7298 set kids $children($curview,$id)
7300 $ctext insert end "\n[mc "Children"]:"
7302 foreach child $kids {
7304 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7305 set info $commitinfo($child)
7306 $ctext insert end "\n\t"
7307 $ctext insert end $child link$i
7308 setlink $child link$i
7309 $ctext insert end "\n\t[lindex $info 0]"
7310 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7311 set date [formatdate [lindex $info 2]]
7312 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7315 $ctext conf -state disabled
7319 proc normalline {} {
7321 if {[info exists thickerline]} {
7330 if {[commitinview $id $curview]} {
7331 selectline [rowofcommit $id] 1
7337 if {![info exists startmstime]} {
7338 set startmstime [clock clicks -milliseconds]
7340 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7343 proc rowmenu {x y id} {
7344 global rowctxmenu selectedline rowmenuid curview
7345 global nullid nullid2 fakerowmenu mainhead
7349 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7354 if {$id ne $nullid && $id ne $nullid2} {
7355 set menu $rowctxmenu
7356 if {$mainhead ne {}} {
7357 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7359 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7362 set menu $fakerowmenu
7364 $menu entryconfigure [mca "Diff this -> selected"] -state $state
7365 $menu entryconfigure [mca "Diff selected -> this"] -state $state
7366 $menu entryconfigure [mca "Make patch"] -state $state
7367 tk_popup $menu $x $y
7370 proc diffvssel {dirn} {
7371 global rowmenuid selectedline
7373 if {$selectedline eq {}} return
7375 set oldid [commitonrow $selectedline]
7376 set newid $rowmenuid
7378 set oldid $rowmenuid
7379 set newid [commitonrow $selectedline]
7381 addtohistory [list doseldiff $oldid $newid]
7382 doseldiff $oldid $newid
7385 proc doseldiff {oldid newid} {
7389 $ctext conf -state normal
7391 init_flist [mc "Top"]
7392 $ctext insert end "[mc "From"] "
7393 $ctext insert end $oldid link0
7394 setlink $oldid link0
7395 $ctext insert end "\n "
7396 $ctext insert end [lindex $commitinfo($oldid) 0]
7397 $ctext insert end "\n\n[mc "To"] "
7398 $ctext insert end $newid link1
7399 setlink $newid link1
7400 $ctext insert end "\n "
7401 $ctext insert end [lindex $commitinfo($newid) 0]
7402 $ctext insert end "\n"
7403 $ctext conf -state disabled
7404 $ctext tag remove found 1.0 end
7405 startdiff [list $oldid $newid]
7409 global rowmenuid currentid commitinfo patchtop patchnum
7411 if {![info exists currentid]} return
7412 set oldid $currentid
7413 set oldhead [lindex $commitinfo($oldid) 0]
7414 set newid $rowmenuid
7415 set newhead [lindex $commitinfo($newid) 0]
7418 catch {destroy $top}
7420 label $top.title -text [mc "Generate patch"]
7421 grid $top.title - -pady 10
7422 label $top.from -text [mc "From:"]
7423 entry $top.fromsha1 -width 40 -relief flat
7424 $top.fromsha1 insert 0 $oldid
7425 $top.fromsha1 conf -state readonly
7426 grid $top.from $top.fromsha1 -sticky w
7427 entry $top.fromhead -width 60 -relief flat
7428 $top.fromhead insert 0 $oldhead
7429 $top.fromhead conf -state readonly
7430 grid x $top.fromhead -sticky w
7431 label $top.to -text [mc "To:"]
7432 entry $top.tosha1 -width 40 -relief flat
7433 $top.tosha1 insert 0 $newid
7434 $top.tosha1 conf -state readonly
7435 grid $top.to $top.tosha1 -sticky w
7436 entry $top.tohead -width 60 -relief flat
7437 $top.tohead insert 0 $newhead
7438 $top.tohead conf -state readonly
7439 grid x $top.tohead -sticky w
7440 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7441 grid $top.rev x -pady 10
7442 label $top.flab -text [mc "Output file:"]
7443 entry $top.fname -width 60
7444 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7446 grid $top.flab $top.fname -sticky w
7448 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7449 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7450 grid $top.buts.gen $top.buts.can
7451 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7452 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7453 grid $top.buts - -pady 10 -sticky ew
7457 proc mkpatchrev {} {
7460 set oldid [$patchtop.fromsha1 get]
7461 set oldhead [$patchtop.fromhead get]
7462 set newid [$patchtop.tosha1 get]
7463 set newhead [$patchtop.tohead get]
7464 foreach e [list fromsha1 fromhead tosha1 tohead] \
7465 v [list $newid $newhead $oldid $oldhead] {
7466 $patchtop.$e conf -state normal
7467 $patchtop.$e delete 0 end
7468 $patchtop.$e insert 0 $v
7469 $patchtop.$e conf -state readonly
7474 global patchtop nullid nullid2
7476 set oldid [$patchtop.fromsha1 get]
7477 set newid [$patchtop.tosha1 get]
7478 set fname [$patchtop.fname get]
7479 set cmd [diffcmd [list $oldid $newid] -p]
7480 # trim off the initial "|"
7481 set cmd [lrange $cmd 1 end]
7482 lappend cmd >$fname &
7483 if {[catch {eval exec $cmd} err]} {
7484 error_popup "[mc "Error creating patch:"] $err"
7486 catch {destroy $patchtop}
7490 proc mkpatchcan {} {
7493 catch {destroy $patchtop}
7498 global rowmenuid mktagtop commitinfo
7502 catch {destroy $top}
7504 label $top.title -text [mc "Create tag"]
7505 grid $top.title - -pady 10
7506 label $top.id -text [mc "ID:"]
7507 entry $top.sha1 -width 40 -relief flat
7508 $top.sha1 insert 0 $rowmenuid
7509 $top.sha1 conf -state readonly
7510 grid $top.id $top.sha1 -sticky w
7511 entry $top.head -width 60 -relief flat
7512 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7513 $top.head conf -state readonly
7514 grid x $top.head -sticky w
7515 label $top.tlab -text [mc "Tag name:"]
7516 entry $top.tag -width 60
7517 grid $top.tlab $top.tag -sticky w
7519 button $top.buts.gen -text [mc "Create"] -command mktaggo
7520 button $top.buts.can -text [mc "Cancel"] -command mktagcan
7521 grid $top.buts.gen $top.buts.can
7522 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7523 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7524 grid $top.buts - -pady 10 -sticky ew
7529 global mktagtop env tagids idtags
7531 set id [$mktagtop.sha1 get]
7532 set tag [$mktagtop.tag get]
7534 error_popup [mc "No tag name specified"]
7537 if {[info exists tagids($tag)]} {
7538 error_popup [mc "Tag \"%s\" already exists" $tag]
7542 exec git tag $tag $id
7544 error_popup "[mc "Error creating tag:"] $err"
7548 set tagids($tag) $id
7549 lappend idtags($id) $tag
7556 proc redrawtags {id} {
7557 global canv linehtag idpos currentid curview cmitlisted
7558 global canvxmax iddrawn circleitem mainheadid circlecolors
7560 if {![commitinview $id $curview]} return
7561 if {![info exists iddrawn($id)]} return
7562 set row [rowofcommit $id]
7563 if {$id eq $mainheadid} {
7566 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
7568 $canv itemconf $circleitem($row) -fill $ofill
7569 $canv delete tag.$id
7570 set xt [eval drawtags $id $idpos($id)]
7571 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7572 set text [$canv itemcget $linehtag($row) -text]
7573 set font [$canv itemcget $linehtag($row) -font]
7574 set xr [expr {$xt + [font measure $font $text]}]
7575 if {$xr > $canvxmax} {
7579 if {[info exists currentid] && $currentid == $id} {
7587 catch {destroy $mktagtop}
7596 proc writecommit {} {
7597 global rowmenuid wrcomtop commitinfo wrcomcmd
7599 set top .writecommit
7601 catch {destroy $top}
7603 label $top.title -text [mc "Write commit to file"]
7604 grid $top.title - -pady 10
7605 label $top.id -text [mc "ID:"]
7606 entry $top.sha1 -width 40 -relief flat
7607 $top.sha1 insert 0 $rowmenuid
7608 $top.sha1 conf -state readonly
7609 grid $top.id $top.sha1 -sticky w
7610 entry $top.head -width 60 -relief flat
7611 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7612 $top.head conf -state readonly
7613 grid x $top.head -sticky w
7614 label $top.clab -text [mc "Command:"]
7615 entry $top.cmd -width 60 -textvariable wrcomcmd
7616 grid $top.clab $top.cmd -sticky w -pady 10
7617 label $top.flab -text [mc "Output file:"]
7618 entry $top.fname -width 60
7619 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7620 grid $top.flab $top.fname -sticky w
7622 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7623 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7624 grid $top.buts.gen $top.buts.can
7625 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7626 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7627 grid $top.buts - -pady 10 -sticky ew
7634 set id [$wrcomtop.sha1 get]
7635 set cmd "echo $id | [$wrcomtop.cmd get]"
7636 set fname [$wrcomtop.fname get]
7637 if {[catch {exec sh -c $cmd >$fname &} err]} {
7638 error_popup "[mc "Error writing commit:"] $err"
7640 catch {destroy $wrcomtop}
7647 catch {destroy $wrcomtop}
7652 global rowmenuid mkbrtop
7655 catch {destroy $top}
7657 label $top.title -text [mc "Create new branch"]
7658 grid $top.title - -pady 10
7659 label $top.id -text [mc "ID:"]
7660 entry $top.sha1 -width 40 -relief flat
7661 $top.sha1 insert 0 $rowmenuid
7662 $top.sha1 conf -state readonly
7663 grid $top.id $top.sha1 -sticky w
7664 label $top.nlab -text [mc "Name:"]
7665 entry $top.name -width 40
7666 bind $top.name <Key-Return> "[list mkbrgo $top]"
7667 grid $top.nlab $top.name -sticky w
7669 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7670 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7671 grid $top.buts.go $top.buts.can
7672 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7673 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7674 grid $top.buts - -pady 10 -sticky ew
7679 global headids idheads
7681 set name [$top.name get]
7682 set id [$top.sha1 get]
7684 error_popup [mc "Please specify a name for the new branch"]
7687 catch {destroy $top}
7691 exec git branch $name $id
7696 set headids($name) $id
7697 lappend idheads($id) $name
7706 proc cherrypick {} {
7707 global rowmenuid curview
7708 global mainhead mainheadid
7710 set oldhead [exec git rev-parse HEAD]
7711 set dheads [descheads $rowmenuid]
7712 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7713 set ok [confirm_popup [mc "Commit %s is already\
7714 included in branch %s -- really re-apply it?" \
7715 [string range $rowmenuid 0 7] $mainhead]]
7718 nowbusy cherrypick [mc "Cherry-picking"]
7720 # Unfortunately git-cherry-pick writes stuff to stderr even when
7721 # no error occurs, and exec takes that as an indication of error...
7722 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7727 set newhead [exec git rev-parse HEAD]
7728 if {$newhead eq $oldhead} {
7730 error_popup [mc "No changes committed"]
7733 addnewchild $newhead $oldhead
7734 if {[commitinview $oldhead $curview]} {
7735 insertrow $newhead $oldhead $curview
7736 if {$mainhead ne {}} {
7737 movehead $newhead $mainhead
7738 movedhead $newhead $mainhead
7740 set mainheadid $newhead
7749 global mainhead rowmenuid confirm_ok resettype
7752 set w ".confirmreset"
7755 wm title $w [mc "Confirm reset"]
7756 message $w.m -text \
7757 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7758 -justify center -aspect 1000
7759 pack $w.m -side top -fill x -padx 20 -pady 20
7760 frame $w.f -relief sunken -border 2
7761 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7762 grid $w.f.rt -sticky w
7764 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7765 -text [mc "Soft: Leave working tree and index untouched"]
7766 grid $w.f.soft -sticky w
7767 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7768 -text [mc "Mixed: Leave working tree untouched, reset index"]
7769 grid $w.f.mixed -sticky w
7770 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7771 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7772 grid $w.f.hard -sticky w
7773 pack $w.f -side top -fill x
7774 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7775 pack $w.ok -side left -fill x -padx 20 -pady 20
7776 button $w.cancel -text [mc Cancel] -command "destroy $w"
7777 pack $w.cancel -side right -fill x -padx 20 -pady 20
7778 bind $w <Visibility> "grab $w; focus $w"
7780 if {!$confirm_ok} return
7781 if {[catch {set fd [open \
7782 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
7786 filerun $fd [list readresetstat $fd]
7787 nowbusy reset [mc "Resetting"]
7792 proc readresetstat {fd} {
7793 global mainhead mainheadid showlocalchanges rprogcoord
7795 if {[gets $fd line] >= 0} {
7796 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7797 set rprogcoord [expr {1.0 * $m / $n}]
7805 if {[catch {close $fd} err]} {
7808 set oldhead $mainheadid
7809 set newhead [exec git rev-parse HEAD]
7810 if {$newhead ne $oldhead} {
7811 movehead $newhead $mainhead
7812 movedhead $newhead $mainhead
7813 set mainheadid $newhead
7817 if {$showlocalchanges} {
7823 # context menu for a head
7824 proc headmenu {x y id head} {
7825 global headmenuid headmenuhead headctxmenu mainhead
7829 set headmenuhead $head
7831 if {$head eq $mainhead} {
7834 $headctxmenu entryconfigure 0 -state $state
7835 $headctxmenu entryconfigure 1 -state $state
7836 tk_popup $headctxmenu $x $y
7840 global headmenuid headmenuhead headids
7841 global showlocalchanges mainheadid
7843 # check the tree is clean first??
7844 nowbusy checkout [mc "Checking out"]
7848 set fd [open [list | git checkout $headmenuhead 2>@1] r]
7852 if {$showlocalchanges} {
7856 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
7860 proc readcheckoutstat {fd newhead newheadid} {
7861 global mainhead mainheadid headids showlocalchanges progresscoords
7863 if {[gets $fd line] >= 0} {
7864 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7865 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
7870 set progresscoords {0 0}
7873 if {[catch {close $fd} err]} {
7876 set oldmainid $mainheadid
7877 set mainhead $newhead
7878 set mainheadid $newheadid
7879 redrawtags $oldmainid
7880 redrawtags $newheadid
7882 if {$showlocalchanges} {
7888 global headmenuid headmenuhead mainhead
7891 set head $headmenuhead
7893 # this check shouldn't be needed any more...
7894 if {$head eq $mainhead} {
7895 error_popup [mc "Cannot delete the currently checked-out branch"]
7898 set dheads [descheads $id]
7899 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7900 # the stuff on this branch isn't on any other branch
7901 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7902 branch.\nReally delete branch %s?" $head $head]]} return
7906 if {[catch {exec git branch -D $head} err]} {
7911 removehead $id $head
7912 removedhead $id $head
7919 # Display a list of tags and heads
7921 global showrefstop bgcolor fgcolor selectbgcolor
7922 global bglist fglist reflistfilter reflist maincursor
7925 set showrefstop $top
7926 if {[winfo exists $top]} {
7932 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7933 text $top.list -background $bgcolor -foreground $fgcolor \
7934 -selectbackground $selectbgcolor -font mainfont \
7935 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7936 -width 30 -height 20 -cursor $maincursor \
7937 -spacing1 1 -spacing3 1 -state disabled
7938 $top.list tag configure highlight -background $selectbgcolor
7939 lappend bglist $top.list
7940 lappend fglist $top.list
7941 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7942 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7943 grid $top.list $top.ysb -sticky nsew
7944 grid $top.xsb x -sticky ew
7946 label $top.f.l -text "[mc "Filter"]: "
7947 entry $top.f.e -width 20 -textvariable reflistfilter
7948 set reflistfilter "*"
7949 trace add variable reflistfilter write reflistfilter_change
7950 pack $top.f.e -side right -fill x -expand 1
7951 pack $top.f.l -side left
7952 grid $top.f - -sticky ew -pady 2
7953 button $top.close -command [list destroy $top] -text [mc "Close"]
7955 grid columnconfigure $top 0 -weight 1
7956 grid rowconfigure $top 0 -weight 1
7957 bind $top.list <1> {break}
7958 bind $top.list <B1-Motion> {break}
7959 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7964 proc sel_reflist {w x y} {
7965 global showrefstop reflist headids tagids otherrefids
7967 if {![winfo exists $showrefstop]} return
7968 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7969 set ref [lindex $reflist [expr {$l-1}]]
7970 set n [lindex $ref 0]
7971 switch -- [lindex $ref 1] {
7972 "H" {selbyid $headids($n)}
7973 "T" {selbyid $tagids($n)}
7974 "o" {selbyid $otherrefids($n)}
7976 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7979 proc unsel_reflist {} {
7982 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7983 $showrefstop.list tag remove highlight 0.0 end
7986 proc reflistfilter_change {n1 n2 op} {
7987 global reflistfilter
7989 after cancel refill_reflist
7990 after 200 refill_reflist
7993 proc refill_reflist {} {
7994 global reflist reflistfilter showrefstop headids tagids otherrefids
7995 global curview commitinterest
7997 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7999 foreach n [array names headids] {
8000 if {[string match $reflistfilter $n]} {
8001 if {[commitinview $headids($n) $curview]} {
8002 lappend refs [list $n H]
8004 set commitinterest($headids($n)) {run refill_reflist}
8008 foreach n [array names tagids] {
8009 if {[string match $reflistfilter $n]} {
8010 if {[commitinview $tagids($n) $curview]} {
8011 lappend refs [list $n T]
8013 set commitinterest($tagids($n)) {run refill_reflist}
8017 foreach n [array names otherrefids] {
8018 if {[string match $reflistfilter $n]} {
8019 if {[commitinview $otherrefids($n) $curview]} {
8020 lappend refs [list $n o]
8022 set commitinterest($otherrefids($n)) {run refill_reflist}
8026 set refs [lsort -index 0 $refs]
8027 if {$refs eq $reflist} return
8029 # Update the contents of $showrefstop.list according to the
8030 # differences between $reflist (old) and $refs (new)
8031 $showrefstop.list conf -state normal
8032 $showrefstop.list insert end "\n"
8035 while {$i < [llength $reflist] || $j < [llength $refs]} {
8036 if {$i < [llength $reflist]} {
8037 if {$j < [llength $refs]} {
8038 set cmp [string compare [lindex $reflist $i 0] \
8039 [lindex $refs $j 0]]
8041 set cmp [string compare [lindex $reflist $i 1] \
8042 [lindex $refs $j 1]]
8052 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8060 set l [expr {$j + 1}]
8061 $showrefstop.list image create $l.0 -align baseline \
8062 -image reficon-[lindex $refs $j 1] -padx 2
8063 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8069 # delete last newline
8070 $showrefstop.list delete end-2c end-1c
8071 $showrefstop.list conf -state disabled
8074 # Stuff for finding nearby tags
8075 proc getallcommits {} {
8076 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8077 global idheads idtags idotherrefs allparents tagobjid
8079 if {![info exists allcommits]} {
8085 set allccache [file join [gitdir] "gitk.cache"]
8087 set f [open $allccache r]
8096 set cmd [list | git rev-list --parents]
8097 set allcupdate [expr {$seeds ne {}}]
8101 set refs [concat [array names idheads] [array names idtags] \
8102 [array names idotherrefs]]
8105 foreach name [array names tagobjid] {
8106 lappend tagobjs $tagobjid($name)
8108 foreach id [lsort -unique $refs] {
8109 if {![info exists allparents($id)] &&
8110 [lsearch -exact $tagobjs $id] < 0} {
8121 set fd [open [concat $cmd $ids] r]
8122 fconfigure $fd -blocking 0
8125 filerun $fd [list getallclines $fd]
8131 # Since most commits have 1 parent and 1 child, we group strings of
8132 # such commits into "arcs" joining branch/merge points (BMPs), which
8133 # are commits that either don't have 1 parent or don't have 1 child.
8135 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8136 # arcout(id) - outgoing arcs for BMP
8137 # arcids(a) - list of IDs on arc including end but not start
8138 # arcstart(a) - BMP ID at start of arc
8139 # arcend(a) - BMP ID at end of arc
8140 # growing(a) - arc a is still growing
8141 # arctags(a) - IDs out of arcids (excluding end) that have tags
8142 # archeads(a) - IDs out of arcids (excluding end) that have heads
8143 # The start of an arc is at the descendent end, so "incoming" means
8144 # coming from descendents, and "outgoing" means going towards ancestors.
8146 proc getallclines {fd} {
8147 global allparents allchildren idtags idheads nextarc
8148 global arcnos arcids arctags arcout arcend arcstart archeads growing
8149 global seeds allcommits cachedarcs allcupdate
8152 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8153 set id [lindex $line 0]
8154 if {[info exists allparents($id)]} {
8159 set olds [lrange $line 1 end]
8160 set allparents($id) $olds
8161 if {![info exists allchildren($id)]} {
8162 set allchildren($id) {}
8167 if {[llength $olds] == 1 && [llength $a] == 1} {
8168 lappend arcids($a) $id
8169 if {[info exists idtags($id)]} {
8170 lappend arctags($a) $id
8172 if {[info exists idheads($id)]} {
8173 lappend archeads($a) $id
8175 if {[info exists allparents($olds)]} {
8176 # seen parent already
8177 if {![info exists arcout($olds)]} {
8180 lappend arcids($a) $olds
8181 set arcend($a) $olds
8184 lappend allchildren($olds) $id
8185 lappend arcnos($olds) $a
8189 foreach a $arcnos($id) {
8190 lappend arcids($a) $id
8197 lappend allchildren($p) $id
8198 set a [incr nextarc]
8199 set arcstart($a) $id
8206 if {[info exists allparents($p)]} {
8207 # seen it already, may need to make a new branch
8208 if {![info exists arcout($p)]} {
8211 lappend arcids($a) $p
8215 lappend arcnos($p) $a
8220 global cached_dheads cached_dtags cached_atags
8221 catch {unset cached_dheads}
8222 catch {unset cached_dtags}
8223 catch {unset cached_atags}
8226 return [expr {$nid >= 1000? 2: 1}]
8230 fconfigure $fd -blocking 1
8233 # got an error reading the list of commits
8234 # if we were updating, try rereading the whole thing again
8240 error_popup "[mc "Error reading commit topology information;\
8241 branch and preceding/following tag information\
8242 will be incomplete."]\n($err)"
8245 if {[incr allcommits -1] == 0} {
8255 proc recalcarc {a} {
8256 global arctags archeads arcids idtags idheads
8260 foreach id [lrange $arcids($a) 0 end-1] {
8261 if {[info exists idtags($id)]} {
8264 if {[info exists idheads($id)]} {
8269 set archeads($a) $ah
8273 global arcnos arcids nextarc arctags archeads idtags idheads
8274 global arcstart arcend arcout allparents growing
8277 if {[llength $a] != 1} {
8278 puts "oops splitarc called but [llength $a] arcs already"
8282 set i [lsearch -exact $arcids($a) $p]
8284 puts "oops splitarc $p not in arc $a"
8287 set na [incr nextarc]
8288 if {[info exists arcend($a)]} {
8289 set arcend($na) $arcend($a)
8291 set l [lindex $allparents([lindex $arcids($a) end]) 0]
8292 set j [lsearch -exact $arcnos($l) $a]
8293 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8295 set tail [lrange $arcids($a) [expr {$i+1}] end]
8296 set arcids($a) [lrange $arcids($a) 0 $i]
8298 set arcstart($na) $p
8300 set arcids($na) $tail
8301 if {[info exists growing($a)]} {
8307 if {[llength $arcnos($id)] == 1} {
8310 set j [lsearch -exact $arcnos($id) $a]
8311 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8315 # reconstruct tags and heads lists
8316 if {$arctags($a) ne {} || $archeads($a) ne {}} {
8321 set archeads($na) {}
8325 # Update things for a new commit added that is a child of one
8326 # existing commit. Used when cherry-picking.
8327 proc addnewchild {id p} {
8328 global allparents allchildren idtags nextarc
8329 global arcnos arcids arctags arcout arcend arcstart archeads growing
8330 global seeds allcommits
8332 if {![info exists allcommits] || ![info exists arcnos($p)]} return
8333 set allparents($id) [list $p]
8334 set allchildren($id) {}
8337 lappend allchildren($p) $id
8338 set a [incr nextarc]
8339 set arcstart($a) $id
8342 set arcids($a) [list $p]
8344 if {![info exists arcout($p)]} {
8347 lappend arcnos($p) $a
8348 set arcout($id) [list $a]
8351 # This implements a cache for the topology information.
8352 # The cache saves, for each arc, the start and end of the arc,
8353 # the ids on the arc, and the outgoing arcs from the end.
8354 proc readcache {f} {
8355 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8356 global idtags idheads allparents cachedarcs possible_seeds seeds growing
8361 if {$lim - $a > 500} {
8362 set lim [expr {$a + 500}]
8366 # finish reading the cache and setting up arctags, etc.
8368 if {$line ne "1"} {error "bad final version"}
8370 foreach id [array names idtags] {
8371 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8372 [llength $allparents($id)] == 1} {
8373 set a [lindex $arcnos($id) 0]
8374 if {$arctags($a) eq {}} {
8379 foreach id [array names idheads] {
8380 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8381 [llength $allparents($id)] == 1} {
8382 set a [lindex $arcnos($id) 0]
8383 if {$archeads($a) eq {}} {
8388 foreach id [lsort -unique $possible_seeds] {
8389 if {$arcnos($id) eq {}} {
8395 while {[incr a] <= $lim} {
8397 if {[llength $line] != 3} {error "bad line"}
8398 set s [lindex $line 0]
8400 lappend arcout($s) $a
8401 if {![info exists arcnos($s)]} {
8402 lappend possible_seeds $s
8405 set e [lindex $line 1]
8410 if {![info exists arcout($e)]} {
8414 set arcids($a) [lindex $line 2]
8415 foreach id $arcids($a) {
8416 lappend allparents($s) $id
8418 lappend arcnos($id) $a
8420 if {![info exists allparents($s)]} {
8421 set allparents($s) {}
8426 set nextarc [expr {$a - 1}]
8439 global nextarc cachedarcs possible_seeds
8443 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8444 # make sure it's an integer
8445 set cachedarcs [expr {int([lindex $line 1])}]
8446 if {$cachedarcs < 0} {error "bad number of arcs"}
8448 set possible_seeds {}
8456 proc dropcache {err} {
8457 global allcwait nextarc cachedarcs seeds
8459 #puts "dropping cache ($err)"
8460 foreach v {arcnos arcout arcids arcstart arcend growing \
8461 arctags archeads allparents allchildren} {
8472 proc writecache {f} {
8473 global cachearc cachedarcs allccache
8474 global arcstart arcend arcnos arcids arcout
8478 if {$lim - $a > 1000} {
8479 set lim [expr {$a + 1000}]
8482 while {[incr a] <= $lim} {
8483 if {[info exists arcend($a)]} {
8484 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8486 puts $f [list $arcstart($a) {} $arcids($a)]
8491 catch {file delete $allccache}
8492 #puts "writing cache failed ($err)"
8495 set cachearc [expr {$a - 1}]
8496 if {$a > $cachedarcs} {
8505 global nextarc cachedarcs cachearc allccache
8507 if {$nextarc == $cachedarcs} return
8509 set cachedarcs $nextarc
8511 set f [open $allccache w]
8512 puts $f [list 1 $cachedarcs]
8517 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8518 # or 0 if neither is true.
8519 proc anc_or_desc {a b} {
8520 global arcout arcstart arcend arcnos cached_isanc
8522 if {$arcnos($a) eq $arcnos($b)} {
8523 # Both are on the same arc(s); either both are the same BMP,
8524 # or if one is not a BMP, the other is also not a BMP or is
8525 # the BMP at end of the arc (and it only has 1 incoming arc).
8526 # Or both can be BMPs with no incoming arcs.
8527 if {$a eq $b || $arcnos($a) eq {}} {
8530 # assert {[llength $arcnos($a)] == 1}
8531 set arc [lindex $arcnos($a) 0]
8532 set i [lsearch -exact $arcids($arc) $a]
8533 set j [lsearch -exact $arcids($arc) $b]
8534 if {$i < 0 || $i > $j} {
8541 if {![info exists arcout($a)]} {
8542 set arc [lindex $arcnos($a) 0]
8543 if {[info exists arcend($arc)]} {
8544 set aend $arcend($arc)
8548 set a $arcstart($arc)
8552 if {![info exists arcout($b)]} {
8553 set arc [lindex $arcnos($b) 0]
8554 if {[info exists arcend($arc)]} {
8555 set bend $arcend($arc)
8559 set b $arcstart($arc)
8569 if {[info exists cached_isanc($a,$bend)]} {
8570 if {$cached_isanc($a,$bend)} {
8574 if {[info exists cached_isanc($b,$aend)]} {
8575 if {$cached_isanc($b,$aend)} {
8578 if {[info exists cached_isanc($a,$bend)]} {
8583 set todo [list $a $b]
8586 for {set i 0} {$i < [llength $todo]} {incr i} {
8587 set x [lindex $todo $i]
8588 if {$anc($x) eq {}} {
8591 foreach arc $arcnos($x) {
8592 set xd $arcstart($arc)
8594 set cached_isanc($a,$bend) 1
8595 set cached_isanc($b,$aend) 0
8597 } elseif {$xd eq $aend} {
8598 set cached_isanc($b,$aend) 1
8599 set cached_isanc($a,$bend) 0
8602 if {![info exists anc($xd)]} {
8603 set anc($xd) $anc($x)
8605 } elseif {$anc($xd) ne $anc($x)} {
8610 set cached_isanc($a,$bend) 0
8611 set cached_isanc($b,$aend) 0
8615 # This identifies whether $desc has an ancestor that is
8616 # a growing tip of the graph and which is not an ancestor of $anc
8617 # and returns 0 if so and 1 if not.
8618 # If we subsequently discover a tag on such a growing tip, and that
8619 # turns out to be a descendent of $anc (which it could, since we
8620 # don't necessarily see children before parents), then $desc
8621 # isn't a good choice to display as a descendent tag of
8622 # $anc (since it is the descendent of another tag which is
8623 # a descendent of $anc). Similarly, $anc isn't a good choice to
8624 # display as a ancestor tag of $desc.
8626 proc is_certain {desc anc} {
8627 global arcnos arcout arcstart arcend growing problems
8630 if {[llength $arcnos($anc)] == 1} {
8631 # tags on the same arc are certain
8632 if {$arcnos($desc) eq $arcnos($anc)} {
8635 if {![info exists arcout($anc)]} {
8636 # if $anc is partway along an arc, use the start of the arc instead
8637 set a [lindex $arcnos($anc) 0]
8638 set anc $arcstart($a)
8641 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8644 set a [lindex $arcnos($desc) 0]
8650 set anclist [list $x]
8654 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8655 set x [lindex $anclist $i]
8660 foreach a $arcout($x) {
8661 if {[info exists growing($a)]} {
8662 if {![info exists growanc($x)] && $dl($x)} {
8668 if {[info exists dl($y)]} {
8672 if {![info exists done($y)]} {
8675 if {[info exists growanc($x)]} {
8679 for {set k 0} {$k < [llength $xl]} {incr k} {
8680 set z [lindex $xl $k]
8681 foreach c $arcout($z) {
8682 if {[info exists arcend($c)]} {
8684 if {[info exists dl($v)] && $dl($v)} {
8686 if {![info exists done($v)]} {
8689 if {[info exists growanc($v)]} {
8699 } elseif {$y eq $anc || !$dl($x)} {
8710 foreach x [array names growanc] {
8719 proc validate_arctags {a} {
8720 global arctags idtags
8724 foreach id $arctags($a) {
8726 if {![info exists idtags($id)]} {
8727 set na [lreplace $na $i $i]
8734 proc validate_archeads {a} {
8735 global archeads idheads
8738 set na $archeads($a)
8739 foreach id $archeads($a) {
8741 if {![info exists idheads($id)]} {
8742 set na [lreplace $na $i $i]
8746 set archeads($a) $na
8749 # Return the list of IDs that have tags that are descendents of id,
8750 # ignoring IDs that are descendents of IDs already reported.
8751 proc desctags {id} {
8752 global arcnos arcstart arcids arctags idtags allparents
8753 global growing cached_dtags
8755 if {![info exists allparents($id)]} {
8758 set t1 [clock clicks -milliseconds]
8760 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8761 # part-way along an arc; check that arc first
8762 set a [lindex $arcnos($id) 0]
8763 if {$arctags($a) ne {}} {
8765 set i [lsearch -exact $arcids($a) $id]
8767 foreach t $arctags($a) {
8768 set j [lsearch -exact $arcids($a) $t]
8776 set id $arcstart($a)
8777 if {[info exists idtags($id)]} {
8781 if {[info exists cached_dtags($id)]} {
8782 return $cached_dtags($id)
8789 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8790 set id [lindex $todo $i]
8792 set ta [info exists hastaggedancestor($id)]
8796 # ignore tags on starting node
8797 if {!$ta && $i > 0} {
8798 if {[info exists idtags($id)]} {
8801 } elseif {[info exists cached_dtags($id)]} {
8802 set tagloc($id) $cached_dtags($id)
8806 foreach a $arcnos($id) {
8808 if {!$ta && $arctags($a) ne {}} {
8810 if {$arctags($a) ne {}} {
8811 lappend tagloc($id) [lindex $arctags($a) end]
8814 if {$ta || $arctags($a) ne {}} {
8815 set tomark [list $d]
8816 for {set j 0} {$j < [llength $tomark]} {incr j} {
8817 set dd [lindex $tomark $j]
8818 if {![info exists hastaggedancestor($dd)]} {
8819 if {[info exists done($dd)]} {
8820 foreach b $arcnos($dd) {
8821 lappend tomark $arcstart($b)
8823 if {[info exists tagloc($dd)]} {
8826 } elseif {[info exists queued($dd)]} {
8829 set hastaggedancestor($dd) 1
8833 if {![info exists queued($d)]} {
8836 if {![info exists hastaggedancestor($d)]} {
8843 foreach id [array names tagloc] {
8844 if {![info exists hastaggedancestor($id)]} {
8845 foreach t $tagloc($id) {
8846 if {[lsearch -exact $tags $t] < 0} {
8852 set t2 [clock clicks -milliseconds]
8855 # remove tags that are descendents of other tags
8856 for {set i 0} {$i < [llength $tags]} {incr i} {
8857 set a [lindex $tags $i]
8858 for {set j 0} {$j < $i} {incr j} {
8859 set b [lindex $tags $j]
8860 set r [anc_or_desc $a $b]
8862 set tags [lreplace $tags $j $j]
8865 } elseif {$r == -1} {
8866 set tags [lreplace $tags $i $i]
8873 if {[array names growing] ne {}} {
8874 # graph isn't finished, need to check if any tag could get
8875 # eclipsed by another tag coming later. Simply ignore any
8876 # tags that could later get eclipsed.
8879 if {[is_certain $t $origid]} {
8883 if {$tags eq $ctags} {
8884 set cached_dtags($origid) $tags
8889 set cached_dtags($origid) $tags
8891 set t3 [clock clicks -milliseconds]
8892 if {0 && $t3 - $t1 >= 100} {
8893 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8894 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8900 global arcnos arcids arcout arcend arctags idtags allparents
8901 global growing cached_atags
8903 if {![info exists allparents($id)]} {
8906 set t1 [clock clicks -milliseconds]
8908 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8909 # part-way along an arc; check that arc first
8910 set a [lindex $arcnos($id) 0]
8911 if {$arctags($a) ne {}} {
8913 set i [lsearch -exact $arcids($a) $id]
8914 foreach t $arctags($a) {
8915 set j [lsearch -exact $arcids($a) $t]
8921 if {![info exists arcend($a)]} {
8925 if {[info exists idtags($id)]} {
8929 if {[info exists cached_atags($id)]} {
8930 return $cached_atags($id)
8938 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8939 set id [lindex $todo $i]
8941 set td [info exists hastaggeddescendent($id)]
8945 # ignore tags on starting node
8946 if {!$td && $i > 0} {
8947 if {[info exists idtags($id)]} {
8950 } elseif {[info exists cached_atags($id)]} {
8951 set tagloc($id) $cached_atags($id)
8955 foreach a $arcout($id) {
8956 if {!$td && $arctags($a) ne {}} {
8958 if {$arctags($a) ne {}} {
8959 lappend tagloc($id) [lindex $arctags($a) 0]
8962 if {![info exists arcend($a)]} continue
8964 if {$td || $arctags($a) ne {}} {
8965 set tomark [list $d]
8966 for {set j 0} {$j < [llength $tomark]} {incr j} {
8967 set dd [lindex $tomark $j]
8968 if {![info exists hastaggeddescendent($dd)]} {
8969 if {[info exists done($dd)]} {
8970 foreach b $arcout($dd) {
8971 if {[info exists arcend($b)]} {
8972 lappend tomark $arcend($b)
8975 if {[info exists tagloc($dd)]} {
8978 } elseif {[info exists queued($dd)]} {
8981 set hastaggeddescendent($dd) 1
8985 if {![info exists queued($d)]} {
8988 if {![info exists hastaggeddescendent($d)]} {
8994 set t2 [clock clicks -milliseconds]
8997 foreach id [array names tagloc] {
8998 if {![info exists hastaggeddescendent($id)]} {
8999 foreach t $tagloc($id) {
9000 if {[lsearch -exact $tags $t] < 0} {
9007 # remove tags that are ancestors of other tags
9008 for {set i 0} {$i < [llength $tags]} {incr i} {
9009 set a [lindex $tags $i]
9010 for {set j 0} {$j < $i} {incr j} {
9011 set b [lindex $tags $j]
9012 set r [anc_or_desc $a $b]
9014 set tags [lreplace $tags $j $j]
9017 } elseif {$r == 1} {
9018 set tags [lreplace $tags $i $i]
9025 if {[array names growing] ne {}} {
9026 # graph isn't finished, need to check if any tag could get
9027 # eclipsed by another tag coming later. Simply ignore any
9028 # tags that could later get eclipsed.
9031 if {[is_certain $origid $t]} {
9035 if {$tags eq $ctags} {
9036 set cached_atags($origid) $tags
9041 set cached_atags($origid) $tags
9043 set t3 [clock clicks -milliseconds]
9044 if {0 && $t3 - $t1 >= 100} {
9045 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9046 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9051 # Return the list of IDs that have heads that are descendents of id,
9052 # including id itself if it has a head.
9053 proc descheads {id} {
9054 global arcnos arcstart arcids archeads idheads cached_dheads
9057 if {![info exists allparents($id)]} {
9061 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9062 # part-way along an arc; check it first
9063 set a [lindex $arcnos($id) 0]
9064 if {$archeads($a) ne {}} {
9065 validate_archeads $a
9066 set i [lsearch -exact $arcids($a) $id]
9067 foreach t $archeads($a) {
9068 set j [lsearch -exact $arcids($a) $t]
9073 set id $arcstart($a)
9079 for {set i 0} {$i < [llength $todo]} {incr i} {
9080 set id [lindex $todo $i]
9081 if {[info exists cached_dheads($id)]} {
9082 set ret [concat $ret $cached_dheads($id)]
9084 if {[info exists idheads($id)]} {
9087 foreach a $arcnos($id) {
9088 if {$archeads($a) ne {}} {
9089 validate_archeads $a
9090 if {$archeads($a) ne {}} {
9091 set ret [concat $ret $archeads($a)]
9095 if {![info exists seen($d)]} {
9102 set ret [lsort -unique $ret]
9103 set cached_dheads($origid) $ret
9104 return [concat $ret $aret]
9107 proc addedtag {id} {
9108 global arcnos arcout cached_dtags cached_atags
9110 if {![info exists arcnos($id)]} return
9111 if {![info exists arcout($id)]} {
9112 recalcarc [lindex $arcnos($id) 0]
9114 catch {unset cached_dtags}
9115 catch {unset cached_atags}
9118 proc addedhead {hid head} {
9119 global arcnos arcout cached_dheads
9121 if {![info exists arcnos($hid)]} return
9122 if {![info exists arcout($hid)]} {
9123 recalcarc [lindex $arcnos($hid) 0]
9125 catch {unset cached_dheads}
9128 proc removedhead {hid head} {
9129 global cached_dheads
9131 catch {unset cached_dheads}
9134 proc movedhead {hid head} {
9135 global arcnos arcout cached_dheads
9137 if {![info exists arcnos($hid)]} return
9138 if {![info exists arcout($hid)]} {
9139 recalcarc [lindex $arcnos($hid) 0]
9141 catch {unset cached_dheads}
9144 proc changedrefs {} {
9145 global cached_dheads cached_dtags cached_atags
9146 global arctags archeads arcnos arcout idheads idtags
9148 foreach id [concat [array names idheads] [array names idtags]] {
9149 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9150 set a [lindex $arcnos($id) 0]
9151 if {![info exists donearc($a)]} {
9157 catch {unset cached_dtags}
9158 catch {unset cached_atags}
9159 catch {unset cached_dheads}
9162 proc rereadrefs {} {
9163 global idtags idheads idotherrefs mainheadid
9165 set refids [concat [array names idtags] \
9166 [array names idheads] [array names idotherrefs]]
9167 foreach id $refids {
9168 if {![info exists ref($id)]} {
9169 set ref($id) [listrefs $id]
9172 set oldmainhead $mainheadid
9175 set refids [lsort -unique [concat $refids [array names idtags] \
9176 [array names idheads] [array names idotherrefs]]]
9177 foreach id $refids {
9178 set v [listrefs $id]
9179 if {![info exists ref($id)] || $ref($id) != $v} {
9183 if {$oldmainhead ne $mainheadid} {
9184 redrawtags $oldmainhead
9185 redrawtags $mainheadid
9190 proc listrefs {id} {
9191 global idtags idheads idotherrefs
9194 if {[info exists idtags($id)]} {
9198 if {[info exists idheads($id)]} {
9202 if {[info exists idotherrefs($id)]} {
9203 set z $idotherrefs($id)
9205 return [list $x $y $z]
9208 proc showtag {tag isnew} {
9209 global ctext tagcontents tagids linknum tagobjid
9212 addtohistory [list showtag $tag 0]
9214 $ctext conf -state normal
9218 if {![info exists tagcontents($tag)]} {
9220 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9223 if {[info exists tagcontents($tag)]} {
9224 set text $tagcontents($tag)
9226 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
9228 appendwithlinks $text {}
9229 $ctext conf -state disabled
9241 if {[info exists gitktmpdir]} {
9242 catch {file delete -force $gitktmpdir}
9246 proc mkfontdisp {font top which} {
9247 global fontattr fontpref $font
9249 set fontpref($font) [set $font]
9250 button $top.${font}but -text $which -font optionfont \
9251 -command [list choosefont $font $which]
9252 label $top.$font -relief flat -font $font \
9253 -text $fontattr($font,family) -justify left
9254 grid x $top.${font}but $top.$font -sticky w
9257 proc choosefont {font which} {
9258 global fontparam fontlist fonttop fontattr
9260 set fontparam(which) $which
9261 set fontparam(font) $font
9262 set fontparam(family) [font actual $font -family]
9263 set fontparam(size) $fontattr($font,size)
9264 set fontparam(weight) $fontattr($font,weight)
9265 set fontparam(slant) $fontattr($font,slant)
9268 if {![winfo exists $top]} {
9270 eval font config sample [font actual $font]
9272 wm title $top [mc "Gitk font chooser"]
9273 label $top.l -textvariable fontparam(which)
9274 pack $top.l -side top
9275 set fontlist [lsort [font families]]
9277 listbox $top.f.fam -listvariable fontlist \
9278 -yscrollcommand [list $top.f.sb set]
9279 bind $top.f.fam <<ListboxSelect>> selfontfam
9280 scrollbar $top.f.sb -command [list $top.f.fam yview]
9281 pack $top.f.sb -side right -fill y
9282 pack $top.f.fam -side left -fill both -expand 1
9283 pack $top.f -side top -fill both -expand 1
9285 spinbox $top.g.size -from 4 -to 40 -width 4 \
9286 -textvariable fontparam(size) \
9287 -validatecommand {string is integer -strict %s}
9288 checkbutton $top.g.bold -padx 5 \
9289 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9290 -variable fontparam(weight) -onvalue bold -offvalue normal
9291 checkbutton $top.g.ital -padx 5 \
9292 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9293 -variable fontparam(slant) -onvalue italic -offvalue roman
9294 pack $top.g.size $top.g.bold $top.g.ital -side left
9295 pack $top.g -side top
9296 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9298 $top.c create text 100 25 -anchor center -text $which -font sample \
9299 -fill black -tags text
9300 bind $top.c <Configure> [list centertext $top.c]
9301 pack $top.c -side top -fill x
9303 button $top.buts.ok -text [mc "OK"] -command fontok -default active
9304 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9305 grid $top.buts.ok $top.buts.can
9306 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9307 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9308 pack $top.buts -side bottom -fill x
9309 trace add variable fontparam write chg_fontparam
9312 $top.c itemconf text -text $which
9314 set i [lsearch -exact $fontlist $fontparam(family)]
9316 $top.f.fam selection set $i
9321 proc centertext {w} {
9322 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9326 global fontparam fontpref prefstop
9328 set f $fontparam(font)
9329 set fontpref($f) [list $fontparam(family) $fontparam(size)]
9330 if {$fontparam(weight) eq "bold"} {
9331 lappend fontpref($f) "bold"
9333 if {$fontparam(slant) eq "italic"} {
9334 lappend fontpref($f) "italic"
9337 $w conf -text $fontparam(family) -font $fontpref($f)
9343 global fonttop fontparam
9345 if {[info exists fonttop]} {
9346 catch {destroy $fonttop}
9347 catch {font delete sample}
9353 proc selfontfam {} {
9354 global fonttop fontparam
9356 set i [$fonttop.f.fam curselection]
9358 set fontparam(family) [$fonttop.f.fam get $i]
9362 proc chg_fontparam {v sub op} {
9365 font config sample -$sub $fontparam($sub)
9369 global maxwidth maxgraphpct
9370 global oldprefs prefstop showneartags showlocalchanges
9371 global bgcolor fgcolor ctext diffcolors selectbgcolor
9372 global tabstop limitdiffs autoselect extdifftool perfile_attrs
9376 if {[winfo exists $top]} {
9380 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9381 limitdiffs tabstop perfile_attrs} {
9382 set oldprefs($v) [set $v]
9385 wm title $top [mc "Gitk preferences"]
9386 label $top.ldisp -text [mc "Commit list display options"]
9387 grid $top.ldisp - -sticky w -pady 10
9388 label $top.spacer -text " "
9389 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9391 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9392 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9393 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9395 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9396 grid x $top.maxpctl $top.maxpct -sticky w
9397 frame $top.showlocal
9398 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9399 checkbutton $top.showlocal.b -variable showlocalchanges
9400 pack $top.showlocal.b $top.showlocal.l -side left
9401 grid x $top.showlocal -sticky w
9402 frame $top.autoselect
9403 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9404 checkbutton $top.autoselect.b -variable autoselect
9405 pack $top.autoselect.b $top.autoselect.l -side left
9406 grid x $top.autoselect -sticky w
9408 label $top.ddisp -text [mc "Diff display options"]
9409 grid $top.ddisp - -sticky w -pady 10
9410 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9411 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9412 grid x $top.tabstopl $top.tabstop -sticky w
9414 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9415 checkbutton $top.ntag.b -variable showneartags
9416 pack $top.ntag.b $top.ntag.l -side left
9417 grid x $top.ntag -sticky w
9419 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9420 checkbutton $top.ldiff.b -variable limitdiffs
9421 pack $top.ldiff.b $top.ldiff.l -side left
9422 grid x $top.ldiff -sticky w
9424 label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
9425 checkbutton $top.lattr.b -variable perfile_attrs
9426 pack $top.lattr.b $top.lattr.l -side left
9427 grid x $top.lattr -sticky w
9429 entry $top.extdifft -textvariable extdifftool
9431 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9433 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9434 -command choose_extdiff
9435 pack $top.extdifff.l $top.extdifff.b -side left
9436 grid x $top.extdifff $top.extdifft -sticky w
9438 label $top.cdisp -text [mc "Colors: press to choose"]
9439 grid $top.cdisp - -sticky w -pady 10
9440 label $top.bg -padx 40 -relief sunk -background $bgcolor
9441 button $top.bgbut -text [mc "Background"] -font optionfont \
9442 -command [list choosecolor bgcolor {} $top.bg background setbg]
9443 grid x $top.bgbut $top.bg -sticky w
9444 label $top.fg -padx 40 -relief sunk -background $fgcolor
9445 button $top.fgbut -text [mc "Foreground"] -font optionfont \
9446 -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9447 grid x $top.fgbut $top.fg -sticky w
9448 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9449 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9450 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9451 [list $ctext tag conf d0 -foreground]]
9452 grid x $top.diffoldbut $top.diffold -sticky w
9453 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9454 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9455 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9456 [list $ctext tag conf d1 -foreground]]
9457 grid x $top.diffnewbut $top.diffnew -sticky w
9458 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9459 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9460 -command [list choosecolor diffcolors 2 $top.hunksep \
9461 "diff hunk header" \
9462 [list $ctext tag conf hunksep -foreground]]
9463 grid x $top.hunksepbut $top.hunksep -sticky w
9464 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9465 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9466 -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9467 grid x $top.selbgbut $top.selbgsep -sticky w
9469 label $top.cfont -text [mc "Fonts: press to choose"]
9470 grid $top.cfont - -sticky w -pady 10
9471 mkfontdisp mainfont $top [mc "Main font"]
9472 mkfontdisp textfont $top [mc "Diff display font"]
9473 mkfontdisp uifont $top [mc "User interface font"]
9476 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9477 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9478 grid $top.buts.ok $top.buts.can
9479 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9480 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9481 grid $top.buts - - -pady 10 -sticky ew
9482 bind $top <Visibility> "focus $top.buts.ok"
9485 proc choose_extdiff {} {
9488 set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9490 set extdifftool $prog
9494 proc choosecolor {v vi w x cmd} {
9497 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9498 -title [mc "Gitk: choose color for %s" $x]]
9499 if {$c eq {}} return
9500 $w conf -background $c
9506 global bglist cflist
9508 $w configure -selectbackground $c
9510 $cflist tag configure highlight \
9511 -background [$cflist cget -selectbackground]
9512 allcanvs itemconf secsel -fill $c
9519 $w conf -background $c
9527 $w conf -foreground $c
9529 allcanvs itemconf text -fill $c
9530 $canv itemconf circle -outline $c
9534 global oldprefs prefstop
9536 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9537 limitdiffs tabstop perfile_attrs} {
9539 set $v $oldprefs($v)
9541 catch {destroy $prefstop}
9547 global maxwidth maxgraphpct
9548 global oldprefs prefstop showneartags showlocalchanges
9549 global fontpref mainfont textfont uifont
9550 global limitdiffs treediffs perfile_attrs
9552 catch {destroy $prefstop}
9556 if {$mainfont ne $fontpref(mainfont)} {
9557 set mainfont $fontpref(mainfont)
9558 parsefont mainfont $mainfont
9559 eval font configure mainfont [fontflags mainfont]
9560 eval font configure mainfontbold [fontflags mainfont 1]
9564 if {$textfont ne $fontpref(textfont)} {
9565 set textfont $fontpref(textfont)
9566 parsefont textfont $textfont
9567 eval font configure textfont [fontflags textfont]
9568 eval font configure textfontbold [fontflags textfont 1]
9570 if {$uifont ne $fontpref(uifont)} {
9571 set uifont $fontpref(uifont)
9572 parsefont uifont $uifont
9573 eval font configure uifont [fontflags uifont]
9576 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9577 if {$showlocalchanges} {
9583 if {$limitdiffs != $oldprefs(limitdiffs) ||
9584 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
9585 # treediffs elements are limited by path;
9586 # won't have encodings cached if perfile_attrs was just turned on
9587 catch {unset treediffs}
9589 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9590 || $maxgraphpct != $oldprefs(maxgraphpct)} {
9592 } elseif {$showneartags != $oldprefs(showneartags) ||
9593 $limitdiffs != $oldprefs(limitdiffs)} {
9598 proc formatdate {d} {
9599 global datetimeformat
9601 set d [clock format $d -format $datetimeformat]
9606 # This list of encoding names and aliases is distilled from
9607 # http://www.iana.org/assignments/character-sets.
9608 # Not all of them are supported by Tcl.
9609 set encoding_aliases {
9610 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9611 ISO646-US US-ASCII us IBM367 cp367 csASCII }
9612 { ISO-10646-UTF-1 csISO10646UTF1 }
9613 { ISO_646.basic:1983 ref csISO646basic1983 }
9614 { INVARIANT csINVARIANT }
9615 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9616 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9617 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9618 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9619 { NATS-DANO iso-ir-9-1 csNATSDANO }
9620 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9621 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9622 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9623 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9624 { ISO-2022-KR csISO2022KR }
9626 { ISO-2022-JP csISO2022JP }
9627 { ISO-2022-JP-2 csISO2022JP2 }
9628 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9630 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9631 { IT iso-ir-15 ISO646-IT csISO15Italian }
9632 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9633 { ES iso-ir-17 ISO646-ES csISO17Spanish }
9634 { greek7-old iso-ir-18 csISO18Greek7Old }
9635 { latin-greek iso-ir-19 csISO19LatinGreek }
9636 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9637 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9638 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9639 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9640 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9641 { BS_viewdata iso-ir-47 csISO47BSViewdata }
9642 { INIS iso-ir-49 csISO49INIS }
9643 { INIS-8 iso-ir-50 csISO50INIS8 }
9644 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9645 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9646 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9647 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9648 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9649 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9651 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9652 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9653 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9654 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9655 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9656 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9657 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9658 { greek7 iso-ir-88 csISO88Greek7 }
9659 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9660 { iso-ir-90 csISO90 }
9661 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9662 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9663 csISO92JISC62991984b }
9664 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9665 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9666 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9667 csISO95JIS62291984handadd }
9668 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9669 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9670 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9671 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9673 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9674 { T.61-7bit iso-ir-102 csISO102T617bit }
9675 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9676 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9677 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9678 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9679 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9680 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9681 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9682 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9683 arabic csISOLatinArabic }
9684 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9685 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9686 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9687 greek greek8 csISOLatinGreek }
9688 { T.101-G2 iso-ir-128 csISO128T101G2 }
9689 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9691 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9692 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9693 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9694 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9695 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9696 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9697 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9698 csISOLatinCyrillic }
9699 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9700 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9701 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9702 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9703 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9704 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9705 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9706 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9707 { ISO_10367-box iso-ir-155 csISO10367Box }
9708 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9709 { latin-lap lap iso-ir-158 csISO158Lap }
9710 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9711 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9714 { JIS_X0201 X0201 csHalfWidthKatakana }
9715 { KSC5636 ISO646-KR csKSC5636 }
9716 { ISO-10646-UCS-2 csUnicode }
9717 { ISO-10646-UCS-4 csUCS4 }
9718 { DEC-MCS dec csDECMCS }
9719 { hp-roman8 roman8 r8 csHPRoman8 }
9720 { macintosh mac csMacintosh }
9721 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9723 { IBM038 EBCDIC-INT cp038 csIBM038 }
9724 { IBM273 CP273 csIBM273 }
9725 { IBM274 EBCDIC-BE CP274 csIBM274 }
9726 { IBM275 EBCDIC-BR cp275 csIBM275 }
9727 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9728 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9729 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9730 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9731 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9732 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9733 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9734 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9735 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9736 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9737 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9738 { IBM437 cp437 437 csPC8CodePage437 }
9739 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9740 { IBM775 cp775 csPC775Baltic }
9741 { IBM850 cp850 850 csPC850Multilingual }
9742 { IBM851 cp851 851 csIBM851 }
9743 { IBM852 cp852 852 csPCp852 }
9744 { IBM855 cp855 855 csIBM855 }
9745 { IBM857 cp857 857 csIBM857 }
9746 { IBM860 cp860 860 csIBM860 }
9747 { IBM861 cp861 861 cp-is csIBM861 }
9748 { IBM862 cp862 862 csPC862LatinHebrew }
9749 { IBM863 cp863 863 csIBM863 }
9750 { IBM864 cp864 csIBM864 }
9751 { IBM865 cp865 865 csIBM865 }
9752 { IBM866 cp866 866 csIBM866 }
9753 { IBM868 CP868 cp-ar csIBM868 }
9754 { IBM869 cp869 869 cp-gr csIBM869 }
9755 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9756 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9757 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9758 { IBM891 cp891 csIBM891 }
9759 { IBM903 cp903 csIBM903 }
9760 { IBM904 cp904 904 csIBBM904 }
9761 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9762 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9763 { IBM1026 CP1026 csIBM1026 }
9764 { EBCDIC-AT-DE csIBMEBCDICATDE }
9765 { EBCDIC-AT-DE-A csEBCDICATDEA }
9766 { EBCDIC-CA-FR csEBCDICCAFR }
9767 { EBCDIC-DK-NO csEBCDICDKNO }
9768 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9769 { EBCDIC-FI-SE csEBCDICFISE }
9770 { EBCDIC-FI-SE-A csEBCDICFISEA }
9771 { EBCDIC-FR csEBCDICFR }
9772 { EBCDIC-IT csEBCDICIT }
9773 { EBCDIC-PT csEBCDICPT }
9774 { EBCDIC-ES csEBCDICES }
9775 { EBCDIC-ES-A csEBCDICESA }
9776 { EBCDIC-ES-S csEBCDICESS }
9777 { EBCDIC-UK csEBCDICUK }
9778 { EBCDIC-US csEBCDICUS }
9779 { UNKNOWN-8BIT csUnknown8BiT }
9780 { MNEMONIC csMnemonic }
9785 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9786 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9787 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9788 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9789 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9790 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9791 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9792 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9793 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9794 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9795 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9796 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9797 { IBM1047 IBM-1047 }
9798 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9799 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9800 { UNICODE-1-1 csUnicode11 }
9803 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9804 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9806 { ISO-8859-15 ISO_8859-15 Latin-9 }
9807 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9808 { GBK CP936 MS936 windows-936 }
9809 { JIS_Encoding csJISEncoding }
9810 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
9811 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9813 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9814 { ISO-10646-UCS-Basic csUnicodeASCII }
9815 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9816 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9817 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9818 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9819 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9820 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9821 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9822 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9823 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9824 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9825 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9826 { Ventura-US csVenturaUS }
9827 { Ventura-International csVenturaInternational }
9828 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9829 { PC8-Turkish csPC8Turkish }
9830 { IBM-Symbols csIBMSymbols }
9831 { IBM-Thai csIBMThai }
9832 { HP-Legal csHPLegal }
9833 { HP-Pi-font csHPPiFont }
9834 { HP-Math8 csHPMath8 }
9835 { Adobe-Symbol-Encoding csHPPSMath }
9836 { HP-DeskTop csHPDesktop }
9837 { Ventura-Math csVenturaMath }
9838 { Microsoft-Publishing csMicrosoftPublishing }
9839 { Windows-31J csWindows31J }
9844 proc tcl_encoding {enc} {
9845 global encoding_aliases tcl_encoding_cache
9846 if {[info exists tcl_encoding_cache($enc)]} {
9847 return $tcl_encoding_cache($enc)
9849 set names [encoding names]
9850 set lcnames [string tolower $names]
9851 set enc [string tolower $enc]
9852 set i [lsearch -exact $lcnames $enc]
9854 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9855 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
9856 set i [lsearch -exact $lcnames $encx]
9860 foreach l $encoding_aliases {
9861 set ll [string tolower $l]
9862 if {[lsearch -exact $ll $enc] < 0} continue
9863 # look through the aliases for one that tcl knows about
9865 set i [lsearch -exact $lcnames $e]
9867 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
9868 set i [lsearch -exact $lcnames $ex]
9878 set tclenc [lindex $names $i]
9880 set tcl_encoding_cache($enc) $tclenc
9884 proc gitattr {path attr default} {
9885 global path_attr_cache
9886 if {[info exists path_attr_cache($attr,$path)]} {
9887 set r $path_attr_cache($attr,$path)
9890 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
9891 regexp "(.*): encoding: (.*)" $line m f r
9893 set path_attr_cache($attr,$path) $r
9895 if {$r eq "unspecified"} {
9901 proc cache_gitattr {attr pathlist} {
9902 global path_attr_cache
9904 foreach path $pathlist {
9905 if {![info exists path_attr_cache($attr,$path)]} {
9906 lappend newlist $path
9910 if {[tk windowingsystem] == "win32"} {
9911 # windows has a 32k limit on the arguments to a command...
9914 while {$newlist ne {}} {
9915 set head [lrange $newlist 0 [expr {$lim - 1}]]
9916 set newlist [lrange $newlist $lim end]
9917 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
9918 foreach row [split $rlist "\n"] {
9919 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
9920 if {[string index $path 0] eq "\""} {
9921 set path [encoding convertfrom [lindex $path 0]]
9923 set path_attr_cache($attr,$path) $value
9930 proc get_path_encoding {path} {
9931 global gui_encoding perfile_attrs
9932 set tcl_enc $gui_encoding
9933 if {$path ne {} && $perfile_attrs} {
9934 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
9942 # First check that Tcl/Tk is recent enough
9943 if {[catch {package require Tk 8.4} err]} {
9944 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9945 Gitk requires at least Tcl/Tk 8.4."]
9950 set wrcomcmd "git diff-tree --stdin -p --pretty"
9954 set gitencoding [exec git config --get i18n.commitencoding]
9956 if {$gitencoding == ""} {
9957 set gitencoding "utf-8"
9959 set tclencoding [tcl_encoding $gitencoding]
9960 if {$tclencoding == {}} {
9961 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9964 set gui_encoding [encoding system]
9966 set enc [exec git config --get gui.encoding]
9968 set tclenc [tcl_encoding $enc]
9969 if {$tclenc ne {}} {
9970 set gui_encoding $tclenc
9972 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
9977 set mainfont {Helvetica 9}
9978 set textfont {Courier 9}
9979 set uifont {Helvetica 9 bold}
9981 set findmergefiles 0
9989 set cmitmode "patch"
9990 set wrapcomment "none"
9994 set showlocalchanges 1
9996 set datetimeformat "%Y-%m-%d %H:%M:%S"
10000 set extdifftool "meld"
10002 set colors {green red blue magenta darkgrey brown orange}
10005 set diffcolors {red "#00a000" blue}
10008 set selectbgcolor gray85
10010 set circlecolors {white blue gray blue blue}
10012 # button for popping up context menus
10013 if {[tk windowingsystem] eq "aqua"} {
10014 set ctxbut <Button-2>
10016 set ctxbut <Button-3>
10019 ## For msgcat loading, first locate the installation location.
10020 if { [info exists ::env(GITK_MSGSDIR)] } {
10021 ## Msgsdir was manually set in the environment.
10022 set gitk_msgsdir $::env(GITK_MSGSDIR)
10024 ## Let's guess the prefix from argv0.
10025 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10026 set gitk_libdir [file join $gitk_prefix share gitk lib]
10027 set gitk_msgsdir [file join $gitk_libdir msgs]
10031 ## Internationalization (i18n) through msgcat and gettext. See
10032 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10033 package require msgcat
10034 namespace import ::msgcat::mc
10035 ## And eventually load the actual message catalog
10036 ::msgcat::mcload $gitk_msgsdir
10038 catch {source ~/.gitk}
10040 font create optionfont -family sans-serif -size -12
10042 parsefont mainfont $mainfont
10043 eval font create mainfont [fontflags mainfont]
10044 eval font create mainfontbold [fontflags mainfont 1]
10046 parsefont textfont $textfont
10047 eval font create textfont [fontflags textfont]
10048 eval font create textfontbold [fontflags textfont 1]
10050 parsefont uifont $uifont
10051 eval font create uifont [fontflags uifont]
10055 # check that we can find a .git directory somewhere...
10056 if {[catch {set gitdir [gitdir]}]} {
10057 show_error {} . [mc "Cannot find a git repository here."]
10060 if {![file isdirectory $gitdir]} {
10061 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10066 set selectheadid {}
10069 set cmdline_files {}
10071 set revtreeargscmd {}
10072 foreach arg $argv {
10073 switch -glob -- $arg {
10076 set cmdline_files [lrange $argv [expr {$i + 1}] end]
10079 "--select-commit=*" {
10080 set selecthead [string range $arg 16 end]
10083 set revtreeargscmd [string range $arg 10 end]
10086 lappend revtreeargs $arg
10092 if {$selecthead eq "HEAD"} {
10096 if {$i >= [llength $argv] && $revtreeargs ne {}} {
10097 # no -- on command line, but some arguments (other than --argscmd)
10099 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10100 set cmdline_files [split $f "\n"]
10101 set n [llength $cmdline_files]
10102 set revtreeargs [lrange $revtreeargs 0 end-$n]
10103 # Unfortunately git rev-parse doesn't produce an error when
10104 # something is both a revision and a filename. To be consistent
10105 # with git log and git rev-list, check revtreeargs for filenames.
10106 foreach arg $revtreeargs {
10107 if {[file exists $arg]} {
10108 show_error {} . [mc "Ambiguous argument '%s': both revision\
10109 and filename" $arg]
10114 # unfortunately we get both stdout and stderr in $err,
10115 # so look for "fatal:".
10116 set i [string first "fatal:" $err]
10118 set err [string range $err [expr {$i + 6}] end]
10120 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10125 set nullid "0000000000000000000000000000000000000000"
10126 set nullid2 "0000000000000000000000000000000000000001"
10127 set nullfile "/dev/null"
10129 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10136 set highlight_paths {}
10138 set searchdirn -forwards
10140 set boldnamerows {}
10141 set diffelide {0 0}
10142 set markingmatches 0
10143 set linkentercount 0
10144 set need_redisplay 0
10151 set selectedhlview [mc "None"]
10152 set highlight_related [mc "None"]
10153 set highlight_files {}
10154 set viewfiles(0) {}
10157 set viewargscmd(0) {}
10159 set selectedline {}
10167 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10170 # wait for the window to become visible
10171 tkwait visibility .
10172 wm title . "[file tail $argv0]: [file tail [pwd]]"
10175 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10176 # create a view for the files/dirs specified on the command line
10180 set viewname(1) [mc "Command line"]
10181 set viewfiles(1) $cmdline_files
10182 set viewargs(1) $revtreeargs
10183 set viewargscmd(1) $revtreeargscmd
10187 .bar.view entryconf [mca "Edit view..."] -state normal
10188 .bar.view entryconf [mca "Delete view"] -state normal
10191 if {[info exists permviews]} {
10192 foreach v $permviews {
10195 set viewname($n) [lindex $v 0]
10196 set viewfiles($n) [lindex $v 1]
10197 set viewargs($n) [lindex $v 2]
10198 set viewargscmd($n) [lindex $v 3]