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
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 interestedin
$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 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 set scripts
[check_interest
$p $scripts]
1262 if {$missing_parents > 0} {
1263 foreach s
$scripts {
1269 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1270 # Assumes we already have an arc for $rwid.
1271 proc rewrite_commit
{v id rwid
} {
1272 global children parents varcid varctok vtokmod varccommits
1274 foreach ch
$children($v,$id) {
1275 # make $rwid be $ch's parent in place of $id
1276 set i
[lsearch
-exact $parents($v,$ch) $id]
1278 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1280 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1281 # add $ch to $rwid's children and sort the list if necessary
1282 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1283 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1284 $children($v,$rwid)]
1286 # fix the graph after joining $id to $rwid
1287 set a
$varcid($v,$ch)
1288 fix_reversal
$rwid $a $v
1289 # parentlist is wrong for the last element of arc $a
1290 # even if displayorder is right, hence the 3rd arg here
1291 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1295 # Mechanism for registering a command to be executed when we come
1296 # across a particular commit. To handle the case when only the
1297 # prefix of the commit is known, the commitinterest array is now
1298 # indexed by the first 4 characters of the ID. Each element is a
1299 # list of id, cmd pairs.
1300 proc interestedin
{id cmd
} {
1301 global commitinterest
1303 lappend commitinterest
([string range
$id 0 3]) $id $cmd
1306 proc check_interest
{id scripts
} {
1307 global commitinterest
1309 set prefix
[string range
$id 0 3]
1310 if {[info exists commitinterest
($prefix)]} {
1312 foreach
{i
script} $commitinterest($prefix) {
1313 if {[string match
"$i*" $id]} {
1314 lappend scripts
[string map
[list
"%I" $id "%P" $i] $script]
1316 lappend newlist
$i $script
1319 if {$newlist ne
{}} {
1320 set commitinterest
($prefix) $newlist
1322 unset commitinterest
($prefix)
1328 proc getcommitlines
{fd inst view updating
} {
1329 global cmitlisted leftover
1330 global commitidx commitdata vdatemode
1331 global parents children curview hlview
1332 global idpending ordertok
1333 global varccommits varcid varctok vtokmod vfilelimit
1335 set stuff
[read $fd 500000]
1336 # git log doesn't terminate the last commit with a null...
1337 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1344 global commfd viewcomplete viewactive viewname
1345 global viewinstances
1347 set i
[lsearch
-exact $viewinstances($view) $inst]
1349 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1351 # set it blocking so we wait for the process to terminate
1352 fconfigure
$fd -blocking 1
1353 if {[catch
{close
$fd} err
]} {
1355 if {$view != $curview} {
1356 set fv
" for the \"$viewname($view)\" view"
1358 if {[string range
$err 0 4] == "usage"} {
1359 set err
"Gitk: error reading commits$fv:\
1360 bad arguments to git log."
1361 if {$viewname($view) eq
"Command line"} {
1363 " (Note: arguments to gitk are passed to git log\
1364 to allow selection of commits to be displayed.)"
1367 set err
"Error reading commits$fv: $err"
1371 if {[incr viewactive
($view) -1] <= 0} {
1372 set viewcomplete
($view) 1
1373 # Check if we have seen any ids listed as parents that haven't
1374 # appeared in the list
1378 if {$view == $curview} {
1387 set i
[string first
"\0" $stuff $start]
1389 append leftover
($inst) [string range
$stuff $start end
]
1393 set cmit
$leftover($inst)
1394 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1395 set leftover
($inst) {}
1397 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1399 set start
[expr {$i + 1}]
1400 set j
[string first
"\n" $cmit]
1403 if {$j >= 0 && [string match
"commit *" $cmit]} {
1404 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1405 if {[string match
{[-^
<>]*} $ids]} {
1406 switch
-- [string index
$ids 0] {
1412 set ids
[string range
$ids 1 end
]
1416 if {[string length
$id] != 40} {
1424 if {[string length
$shortcmit] > 80} {
1425 set shortcmit
"[string range $shortcmit 0 80]..."
1427 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1430 set id [lindex $ids 0]
1433 if {!$listed && $updating && ![info exists varcid($vid)] &&
1434 $vfilelimit($view) ne {}} {
1435 # git log doesn't rewrite parents
for unlisted commits
1436 # when doing path limiting, so work around that here
1437 # by working out the rewritten parent with git rev-list
1438 # and if we already know about it, using the rewritten
1439 # parent as a substitute parent for $id's children.
1441 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1442 $id -- $vfilelimit($view)]
1444 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1445 # use $rwid in place of $id
1446 rewrite_commit
$view $id $rwid
1453 if {[info exists varcid
($vid)]} {
1454 if {$cmitlisted($vid) ||
!$listed} continue
1458 set olds
[lrange
$ids 1 end
]
1462 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1463 set cmitlisted
($vid) $listed
1464 set parents
($vid) $olds
1465 if {![info exists children
($vid)]} {
1466 set children
($vid) {}
1467 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1468 set k
[lindex
$children($vid) 0]
1469 if {[llength
$parents($view,$k)] == 1 &&
1470 (!$vdatemode($view) ||
1471 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1472 set a
$varcid($view,$k)
1477 set a
[newvarc
$view $id]
1479 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1482 if {![info exists varcid
($vid)]} {
1484 lappend varccommits
($view,$a) $id
1485 incr commitidx
($view)
1490 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1492 if {[llength
[lappend children
($vp) $id]] > 1 &&
1493 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1494 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1496 catch
{unset ordertok
}
1498 if {[info exists varcid
($view,$p)]} {
1499 fix_reversal
$p $a $view
1505 set scripts
[check_interest
$id $scripts]
1509 global numcommits hlview
1511 if {$view == $curview} {
1512 set numcommits
$commitidx($view)
1515 if {[info exists hlview
] && $view == $hlview} {
1516 # we never actually get here...
1519 foreach s
$scripts {
1526 proc chewcommits
{} {
1527 global curview hlview viewcomplete
1528 global pending_select
1531 if {$viewcomplete($curview)} {
1532 global commitidx varctok
1533 global numcommits startmsecs
1535 if {[info exists pending_select
]} {
1537 reset_pending_select
{}
1539 if {[commitinview
$pending_select $curview]} {
1540 selectline
[rowofcommit
$pending_select] 1
1542 set row
[first_real_row
]
1546 if {$commitidx($curview) > 0} {
1547 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1548 #puts "overall $ms ms for $numcommits commits"
1549 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1551 show_status
[mc
"No commits selected"]
1558 proc readcommit
{id
} {
1559 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
1560 parsecommit
$id $contents 0
1563 proc parsecommit
{id contents listed
} {
1564 global commitinfo cdate
1573 set hdrend
[string first
"\n\n" $contents]
1575 # should never happen...
1576 set hdrend
[string length
$contents]
1578 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1579 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1580 foreach line
[split $header "\n"] {
1581 set tag
[lindex
$line 0]
1582 if {$tag == "author"} {
1583 set audate
[lindex
$line end-1
]
1584 set auname
[lrange
$line 1 end-2
]
1585 } elseif
{$tag == "committer"} {
1586 set comdate
[lindex
$line end-1
]
1587 set comname
[lrange
$line 1 end-2
]
1591 # take the first non-blank line of the comment as the headline
1592 set headline
[string trimleft
$comment]
1593 set i
[string first
"\n" $headline]
1595 set headline
[string range
$headline 0 $i]
1597 set headline
[string trimright
$headline]
1598 set i
[string first
"\r" $headline]
1600 set headline
[string trimright
[string range
$headline 0 $i]]
1603 # git log indents the comment by 4 spaces;
1604 # if we got this via git cat-file, add the indentation
1606 foreach line
[split $comment "\n"] {
1607 append newcomment
" "
1608 append newcomment
$line
1609 append newcomment
"\n"
1611 set comment
$newcomment
1613 if {$comdate != {}} {
1614 set cdate
($id) $comdate
1616 set commitinfo
($id) [list
$headline $auname $audate \
1617 $comname $comdate $comment]
1620 proc getcommit
{id
} {
1621 global commitdata commitinfo
1623 if {[info exists commitdata
($id)]} {
1624 parsecommit
$id $commitdata($id) 1
1627 if {![info exists commitinfo
($id)]} {
1628 set commitinfo
($id) [list
[mc
"No commit information available"]]
1634 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1635 # and are present in the current view.
1636 # This is fairly slow...
1637 proc longid
{prefix
} {
1638 global varcid curview
1641 foreach match
[array names varcid
"$curview,$prefix*"] {
1642 lappend ids
[lindex
[split $match ","] 1]
1648 global tagids idtags headids idheads tagobjid
1649 global otherrefids idotherrefs mainhead mainheadid
1650 global selecthead selectheadid
1652 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1655 set refd
[open
[list | git show-ref
-d] r
]
1656 while {[gets
$refd line
] >= 0} {
1657 if {[string index
$line 40] ne
" "} continue
1658 set id
[string range
$line 0 39]
1659 set ref
[string range
$line 41 end
]
1660 if {![string match
"refs/*" $ref]} continue
1661 set name
[string range
$ref 5 end
]
1662 if {[string match
"remotes/*" $name]} {
1663 if {![string match
"*/HEAD" $name]} {
1664 set headids
($name) $id
1665 lappend idheads
($id) $name
1667 } elseif
{[string match
"heads/*" $name]} {
1668 set name
[string range
$name 6 end
]
1669 set headids
($name) $id
1670 lappend idheads
($id) $name
1671 } elseif
{[string match
"tags/*" $name]} {
1672 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1673 # which is what we want since the former is the commit ID
1674 set name
[string range
$name 5 end
]
1675 if {[string match
"*^{}" $name]} {
1676 set name
[string range
$name 0 end-3
]
1678 set tagobjid
($name) $id
1680 set tagids
($name) $id
1681 lappend idtags
($id) $name
1683 set otherrefids
($name) $id
1684 lappend idotherrefs
($id) $name
1691 set mainheadid
[exec git rev-parse HEAD
]
1692 set thehead
[exec git symbolic-ref HEAD
]
1693 if {[string match
"refs/heads/*" $thehead]} {
1694 set mainhead
[string range
$thehead 11 end
]
1698 if {$selecthead ne
{}} {
1700 set selectheadid
[exec git rev-parse
--verify $selecthead]
1705 # skip over fake commits
1706 proc first_real_row
{} {
1707 global nullid nullid2 numcommits
1709 for {set row
0} {$row < $numcommits} {incr row
} {
1710 set id
[commitonrow
$row]
1711 if {$id ne
$nullid && $id ne
$nullid2} {
1718 # update things for a head moved to a child of its previous location
1719 proc movehead
{id name
} {
1720 global headids idheads
1722 removehead
$headids($name) $name
1723 set headids
($name) $id
1724 lappend idheads
($id) $name
1727 # update things when a head has been removed
1728 proc removehead
{id name
} {
1729 global headids idheads
1731 if {$idheads($id) eq
$name} {
1734 set i
[lsearch
-exact $idheads($id) $name]
1736 set idheads
($id) [lreplace
$idheads($id) $i $i]
1739 unset headids
($name)
1742 proc show_error
{w top msg
} {
1743 message
$w.m
-text $msg -justify center
-aspect 400
1744 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1745 button
$w.ok
-text [mc OK
] -command "destroy $top"
1746 pack
$w.ok
-side bottom
-fill x
1747 bind $top <Visibility
> "grab $top; focus $top"
1748 bind $top <Key-Return
> "destroy $top"
1752 proc error_popup msg
{
1756 show_error
$w $w $msg
1759 proc confirm_popup msg
{
1765 message
$w.m
-text $msg -justify center
-aspect 400
1766 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1767 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1768 pack
$w.ok
-side left
-fill x
1769 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1770 pack
$w.cancel
-side right
-fill x
1771 bind $w <Visibility
> "grab $w; focus $w"
1776 proc setoptions
{} {
1777 option add
*Panedwindow.showHandle
1 startupFile
1778 option add
*Panedwindow.sashRelief raised startupFile
1779 option add
*Button.font uifont startupFile
1780 option add
*Checkbutton.font uifont startupFile
1781 option add
*Radiobutton.font uifont startupFile
1782 option add
*Menu.font uifont startupFile
1783 option add
*Menubutton.font uifont startupFile
1784 option add
*Label.font uifont startupFile
1785 option add
*Message.font uifont startupFile
1786 option add
*Entry.font uifont startupFile
1789 # Make a menu and submenus.
1790 # m is the window name for the menu, items is the list of menu items to add.
1791 # Each item is a list {mc label type description options...}
1792 # mc is ignored; it's so we can put mc there to alert xgettext
1793 # label is the string that appears in the menu
1794 # type is cascade, command or radiobutton (should add checkbutton)
1795 # description depends on type; it's the sublist for cascade, the
1796 # command to invoke for command, or {variable value} for radiobutton
1797 proc makemenu
{m items
} {
1800 set name
[mc
[lindex
$i 1]]
1801 set type [lindex
$i 2]
1802 set thing
[lindex
$i 3]
1803 set params
[list
$type]
1805 set u
[string first
"&" [string map
{&& x
} $name]]
1806 lappend params
-label [string map
{&& & & {}} $name]
1808 lappend params
-underline $u
1813 set submenu
[string tolower
[string map
{& ""} [lindex
$i 1]]]
1814 lappend params
-menu $m.
$submenu
1817 lappend params
-command $thing
1820 lappend params
-variable [lindex
$thing 0] \
1821 -value [lindex
$thing 1]
1824 eval $m add
$params [lrange
$i 4 end
]
1825 if {$type eq
"cascade"} {
1826 makemenu
$m.
$submenu $thing
1831 # translate string and remove ampersands
1833 return [string map
{&& & & {}} [mc
$str]]
1836 proc makewindow
{} {
1837 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1839 global findtype findtypemenu findloc findstring fstring geometry
1840 global entries sha1entry sha1string sha1but
1841 global diffcontextstring diffcontext
1843 global maincursor textcursor curtextcursor
1844 global rowctxmenu fakerowmenu mergemax wrapcomment
1845 global highlight_files gdttype
1846 global searchstring sstring
1847 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1848 global headctxmenu progresscanv progressitem progresscoords statusw
1849 global fprogitem fprogcoord lastprogupdate progupdatepending
1850 global rprogitem rprogcoord rownumsel numcommits
1853 # The "mc" arguments here are purely so that xgettext
1854 # sees the following string as needing to be translated
1856 {mc
"File" cascade
{
1857 {mc
"Update" command updatecommits
-accelerator F5
}
1858 {mc
"Reload" command reloadcommits
}
1859 {mc
"Reread references" command rereadrefs
}
1860 {mc
"List references" command showrefs
}
1861 {mc
"Quit" command doquit
}
1863 {mc
"Edit" cascade
{
1864 {mc
"Preferences" command doprefs
}
1866 {mc
"View" cascade
{
1867 {mc
"New view..." command {newview
0}}
1868 {mc
"Edit view..." command editview
-state disabled
}
1869 {mc
"Delete view" command delview
-state disabled
}
1871 {mc
"All files" radiobutton
{selectedview
0} -command {showview
0}}
1873 {mc
"Help" cascade
{
1874 {mc
"About gitk" command about
}
1875 {mc
"Key bindings" command keys
}
1878 . configure
-menu .bar
1880 # the gui has upper and lower half, parts of a paned window.
1881 panedwindow .ctop
-orient vertical
1883 # possibly use assumed geometry
1884 if {![info exists geometry
(pwsash0
)]} {
1885 set geometry
(topheight
) [expr {15 * $linespc}]
1886 set geometry
(topwidth
) [expr {80 * $charspc}]
1887 set geometry
(botheight
) [expr {15 * $linespc}]
1888 set geometry
(botwidth
) [expr {50 * $charspc}]
1889 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1890 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1893 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1894 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1896 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1898 # create three canvases
1899 set cscroll .tf.histframe.csb
1900 set canv .tf.histframe.pwclist.canv
1902 -selectbackground $selectbgcolor \
1903 -background $bgcolor -bd 0 \
1904 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1905 .tf.histframe.pwclist add
$canv
1906 set canv2 .tf.histframe.pwclist.canv2
1908 -selectbackground $selectbgcolor \
1909 -background $bgcolor -bd 0 -yscrollincr $linespc
1910 .tf.histframe.pwclist add
$canv2
1911 set canv3 .tf.histframe.pwclist.canv3
1913 -selectbackground $selectbgcolor \
1914 -background $bgcolor -bd 0 -yscrollincr $linespc
1915 .tf.histframe.pwclist add
$canv3
1916 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
1917 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
1919 # a scroll bar to rule them
1920 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
1921 pack
$cscroll -side right
-fill y
1922 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
1923 lappend bglist
$canv $canv2 $canv3
1924 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
1926 # we have two button bars at bottom of top frame. Bar 1
1928 frame .tf.lbar
-height 15
1930 set sha1entry .tf.bar.sha1
1931 set entries
$sha1entry
1932 set sha1but .tf.bar.sha1label
1933 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
1934 -command gotocommit
-width 8
1935 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
1936 pack .tf.bar.sha1label
-side left
1937 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
1938 trace add variable sha1string
write sha1change
1939 pack
$sha1entry -side left
-pady 2
1941 image create bitmap bm-left
-data {
1942 #define left_width 16
1943 #define left_height 16
1944 static unsigned char left_bits
[] = {
1945 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1946 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1947 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1949 image create bitmap bm-right
-data {
1950 #define right_width 16
1951 #define right_height 16
1952 static unsigned char right_bits
[] = {
1953 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1954 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1955 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1957 button .tf.bar.leftbut
-image bm-left
-command goback \
1958 -state disabled
-width 26
1959 pack .tf.bar.leftbut
-side left
-fill y
1960 button .tf.bar.rightbut
-image bm-right
-command goforw \
1961 -state disabled
-width 26
1962 pack .tf.bar.rightbut
-side left
-fill y
1964 label .tf.bar.rowlabel
-text [mc
"Row"]
1966 label .tf.bar.rownum
-width 7 -font textfont
-textvariable rownumsel \
1967 -relief sunken
-anchor e
1968 label .tf.bar.rowlabel2
-text "/"
1969 label .tf.bar.numcommits
-width 7 -font textfont
-textvariable numcommits \
1970 -relief sunken
-anchor e
1971 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
1974 trace add variable selectedline
write selectedline_change
1976 # Status label and progress bar
1977 set statusw .tf.bar.status
1978 label
$statusw -width 15 -relief sunken
1979 pack
$statusw -side left
-padx 5
1980 set h
[expr {[font metrics uifont
-linespace] + 2}]
1981 set progresscanv .tf.bar.progress
1982 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
1983 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
1984 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
1985 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
1986 pack
$progresscanv -side right
-expand 1 -fill x
1987 set progresscoords
{0 0}
1990 bind $progresscanv <Configure
> adjustprogress
1991 set lastprogupdate
[clock clicks
-milliseconds]
1992 set progupdatepending
0
1994 # build up the bottom bar of upper window
1995 label .tf.lbar.flabel
-text "[mc "Find
"] "
1996 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
1997 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
1998 label .tf.lbar.flab2
-text " [mc "commit
"] "
1999 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2001 set gdttype
[mc
"containing:"]
2002 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
2003 [mc
"containing:"] \
2004 [mc
"touching paths:"] \
2005 [mc
"adding/removing string:"]]
2006 trace add variable gdttype
write gdttype_change
2007 pack .tf.lbar.gdttype
-side left
-fill y
2010 set fstring .tf.lbar.findstring
2011 lappend entries
$fstring
2012 entry
$fstring -width 30 -font textfont
-textvariable findstring
2013 trace add variable findstring
write find_change
2014 set findtype
[mc
"Exact"]
2015 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
2016 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
2017 trace add variable findtype
write findcom_change
2018 set findloc
[mc
"All fields"]
2019 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
2020 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
2021 trace add variable findloc
write find_change
2022 pack .tf.lbar.findloc
-side right
2023 pack .tf.lbar.findtype
-side right
2024 pack
$fstring -side left
-expand 1 -fill x
2026 # Finish putting the upper half of the viewer together
2027 pack .tf.lbar
-in .tf
-side bottom
-fill x
2028 pack .tf.bar
-in .tf
-side bottom
-fill x
2029 pack .tf.histframe
-fill both
-side top
-expand 1
2031 .ctop paneconfigure .tf
-height $geometry(topheight
)
2032 .ctop paneconfigure .tf
-width $geometry(topwidth
)
2034 # now build up the bottom
2035 panedwindow .pwbottom
-orient horizontal
2037 # lower left, a text box over search bar, scroll bar to the right
2038 # if we know window height, then that will set the lower text height, otherwise
2039 # we set lower text height which will drive window height
2040 if {[info exists geometry
(main
)]} {
2041 frame .bleft
-width $geometry(botwidth
)
2043 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
2049 button .bleft.top.search
-text [mc
"Search"] -command dosearch
2050 pack .bleft.top.search
-side left
-padx 5
2051 set sstring .bleft.top.sstring
2052 entry
$sstring -width 20 -font textfont
-textvariable searchstring
2053 lappend entries
$sstring
2054 trace add variable searchstring
write incrsearch
2055 pack
$sstring -side left
-expand 1 -fill x
2056 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
2057 -command changediffdisp
-variable diffelide
-value {0 0}
2058 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
2059 -command changediffdisp
-variable diffelide
-value {0 1}
2060 radiobutton .bleft.mid.new
-text [mc
"New version"] \
2061 -command changediffdisp
-variable diffelide
-value {1 0}
2062 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
2063 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
2064 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
2065 -from 1 -increment 1 -to 10000000 \
2066 -validate all
-validatecommand "diffcontextvalidate %P" \
2067 -textvariable diffcontextstring
2068 .bleft.mid.diffcontext
set $diffcontext
2069 trace add variable diffcontextstring
write diffcontextchange
2070 lappend entries .bleft.mid.diffcontext
2071 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
2072 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
2073 -command changeignorespace
-variable ignorespace
2074 pack .bleft.mid.ignspace
-side left
-padx 5
2075 set ctext .bleft.bottom.ctext
2076 text
$ctext -background $bgcolor -foreground $fgcolor \
2077 -state disabled
-font textfont \
2078 -yscrollcommand scrolltext
-wrap none \
2079 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2081 $ctext conf
-tabstyle wordprocessor
2083 scrollbar .bleft.bottom.sb
-command "$ctext yview"
2084 scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h \
2086 pack .bleft.top
-side top
-fill x
2087 pack .bleft.mid
-side top
-fill x
2088 grid
$ctext .bleft.bottom.sb
-sticky nsew
2089 grid .bleft.bottom.sbhorizontal
-sticky ew
2090 grid columnconfigure .bleft.bottom
0 -weight 1
2091 grid rowconfigure .bleft.bottom
0 -weight 1
2092 grid rowconfigure .bleft.bottom
1 -weight 0
2093 pack .bleft.bottom
-side top
-fill both
-expand 1
2094 lappend bglist
$ctext
2095 lappend fglist
$ctext
2097 $ctext tag conf comment
-wrap $wrapcomment
2098 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
2099 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
2100 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
2101 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
2102 $ctext tag conf m0
-fore red
2103 $ctext tag conf m1
-fore blue
2104 $ctext tag conf m2
-fore green
2105 $ctext tag conf m3
-fore purple
2106 $ctext tag conf
m4 -fore brown
2107 $ctext tag conf m5
-fore "#009090"
2108 $ctext tag conf m6
-fore magenta
2109 $ctext tag conf m7
-fore "#808000"
2110 $ctext tag conf m8
-fore "#009000"
2111 $ctext tag conf m9
-fore "#ff0080"
2112 $ctext tag conf m10
-fore cyan
2113 $ctext tag conf m11
-fore "#b07070"
2114 $ctext tag conf m12
-fore "#70b0f0"
2115 $ctext tag conf m13
-fore "#70f0b0"
2116 $ctext tag conf m14
-fore "#f0b070"
2117 $ctext tag conf m15
-fore "#ff70b0"
2118 $ctext tag conf mmax
-fore darkgrey
2120 $ctext tag conf mresult
-font textfontbold
2121 $ctext tag conf msep
-font textfontbold
2122 $ctext tag conf found
-back yellow
2124 .pwbottom add .bleft
2125 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
2130 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
2131 -command reselectline
-variable cmitmode
-value "patch"
2132 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
2133 -command reselectline
-variable cmitmode
-value "tree"
2134 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
2135 pack .bright.mode
-side top
-fill x
2136 set cflist .bright.cfiles
2137 set indent
[font measure mainfont
"nn"]
2139 -selectbackground $selectbgcolor \
2140 -background $bgcolor -foreground $fgcolor \
2142 -tabs [list
$indent [expr {2 * $indent}]] \
2143 -yscrollcommand ".bright.sb set" \
2144 -cursor [. cget
-cursor] \
2145 -spacing1 1 -spacing3 1
2146 lappend bglist
$cflist
2147 lappend fglist
$cflist
2148 scrollbar .bright.sb
-command "$cflist yview"
2149 pack .bright.sb
-side right
-fill y
2150 pack
$cflist -side left
-fill both
-expand 1
2151 $cflist tag configure highlight \
2152 -background [$cflist cget
-selectbackground]
2153 $cflist tag configure bold
-font mainfontbold
2155 .pwbottom add .bright
2158 # restore window width & height if known
2159 if {[info exists geometry
(main
)]} {
2160 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
2161 if {$w > [winfo screenwidth .
]} {
2162 set w
[winfo screenwidth .
]
2164 if {$h > [winfo screenheight .
]} {
2165 set h
[winfo screenheight .
]
2167 wm geometry .
"${w}x$h"
2171 if {[tk windowingsystem
] eq
{aqua
}} {
2177 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2178 pack .ctop
-fill both
-expand 1
2179 bindall
<1> {selcanvline
%W
%x
%y
}
2180 #bindall <B1-Motion> {selcanvline %W %x %y}
2181 if {[tk windowingsystem
] == "win32"} {
2182 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2183 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2185 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2186 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2187 if {[tk windowingsystem
] eq
"aqua"} {
2188 bindall
<MouseWheel
> {
2189 set delta
[expr {- (%D
)}]
2190 allcanvs yview scroll
$delta units
2194 bindall
<2> "canvscan mark %W %x %y"
2195 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
2196 bindkey
<Home
> selfirstline
2197 bindkey
<End
> sellastline
2198 bind .
<Key-Up
> "selnextline -1"
2199 bind .
<Key-Down
> "selnextline 1"
2200 bind .
<Shift-Key-Up
> "dofind -1 0"
2201 bind .
<Shift-Key-Down
> "dofind 1 0"
2202 bindkey
<Key-Right
> "goforw"
2203 bindkey
<Key-Left
> "goback"
2204 bind .
<Key-Prior
> "selnextpage -1"
2205 bind .
<Key-Next
> "selnextpage 1"
2206 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2207 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2208 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2209 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2210 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2211 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2212 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2213 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2214 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2215 bindkey p
"selnextline -1"
2216 bindkey n
"selnextline 1"
2219 bindkey i
"selnextline -1"
2220 bindkey k
"selnextline 1"
2224 bindkey d
"$ctext yview scroll 18 units"
2225 bindkey u
"$ctext yview scroll -18 units"
2226 bindkey
/ {dofind
1 1}
2227 bindkey
<Key-Return
> {dofind
1 1}
2228 bindkey ?
{dofind
-1 1}
2230 bindkey
<F5
> updatecommits
2231 bind .
<$M1B-q> doquit
2232 bind .
<$M1B-f> {dofind
1 1}
2233 bind .
<$M1B-g> {dofind
1 0}
2234 bind .
<$M1B-r> dosearchback
2235 bind .
<$M1B-s> dosearch
2236 bind .
<$M1B-equal> {incrfont
1}
2237 bind .
<$M1B-plus> {incrfont
1}
2238 bind .
<$M1B-KP_Add> {incrfont
1}
2239 bind .
<$M1B-minus> {incrfont
-1}
2240 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2241 wm protocol . WM_DELETE_WINDOW doquit
2242 bind .
<Destroy
> {stop_backends
}
2243 bind .
<Button-1
> "click %W"
2244 bind $fstring <Key-Return
> {dofind
1 1}
2245 bind $sha1entry <Key-Return
> {gotocommit
; break}
2246 bind $sha1entry <<PasteSelection>> clearsha1
2247 bind $cflist <1> {sel_flist %W %x %y; break}
2248 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2249 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2251 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2253 set maincursor [. cget -cursor]
2254 set textcursor [$ctext cget -cursor]
2255 set curtextcursor $textcursor
2257 set rowctxmenu .rowctxmenu
2258 makemenu $rowctxmenu {
2259 {mc "Diff this -> selected" command {diffvssel 0}}
2260 {mc "Diff selected -> this" command {diffvssel 1}}
2261 {mc "Make patch" command mkpatch}
2262 {mc "Create tag" command mktag}
2263 {mc "Write commit to file" command writecommit}
2264 {mc "Create new branch" command mkbranch}
2265 {mc "Cherry-pick this commit" command cherrypick}
2266 {mc "Reset HEAD branch to here" command resethead}
2268 $rowctxmenu configure -tearoff 0
2270 set fakerowmenu .fakerowmenu
2271 makemenu $fakerowmenu {
2272 {mc "Diff this -> selected" command {diffvssel 0}}
2273 {mc "Diff selected -> this" command {diffvssel 1}}
2274 {mc "Make patch" command mkpatch}
2276 $fakerowmenu configure -tearoff 0
2278 set headctxmenu .headctxmenu
2279 makemenu $headctxmenu {
2280 {mc "Check out this branch" command cobranch}
2281 {mc "Remove this branch" command rmbranch}
2283 $headctxmenu configure -tearoff 0
2286 set flist_menu .flistctxmenu
2287 makemenu $flist_menu {
2288 {mc "Highlight this too" command {flist_hl 0}}
2289 {mc "Highlight this only" command {flist_hl 1}}
2290 {mc "External diff" command {external_diff}}
2291 {mc "Blame parent commit" command {external_blame 1}}
2293 $flist_menu configure -tearoff 0
2296 # Windows sends all mouse wheel events to the current focused window, not
2297 # the one where the mouse hovers, so bind those events here and redirect
2298 # to the correct window
2299 proc windows_mousewheel_redirector {W X Y D} {
2300 global canv canv2 canv3
2301 set w [winfo containing -displayof $W $X $Y]
2303 set u [expr {$D < 0 ? 5 : -5}]
2304 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2305 allcanvs yview scroll $u units
2308 $w yview scroll $u units
2314 # Update row number label when selectedline changes
2315 proc selectedline_change {n1 n2 op} {
2316 global selectedline rownumsel
2318 if {$selectedline eq {}} {
2321 set rownumsel [expr {$selectedline + 1}]
2325 # mouse-2 makes all windows scan vertically, but only the one
2326 # the cursor is in scans horizontally
2327 proc canvscan {op w x y} {
2328 global canv canv2 canv3
2329 foreach c [list $canv $canv2 $canv3] {
2338 proc scrollcanv {cscroll f0 f1} {
2339 $cscroll set $f0 $f1
2344 # when we make a key binding for the toplevel, make sure
2345 # it doesn't get triggered when that key is pressed in the
2346 # find string entry widget.
2347 proc bindkey {ev script} {
2350 set escript [bind Entry $ev]
2351 if {$escript == {}} {
2352 set escript [bind Entry <Key>]
2354 foreach e $entries {
2355 bind $e $ev "$escript; break"
2359 # set the focus back to the toplevel for any click outside
2362 global ctext entries
2363 foreach e [concat $entries $ctext] {
2364 if {$w == $e} return
2369 # Adjust the progress bar for a change in requested extent or canvas size
2370 proc adjustprogress {} {
2371 global progresscanv progressitem progresscoords
2372 global fprogitem fprogcoord lastprogupdate progupdatepending
2373 global rprogitem rprogcoord
2375 set w [expr {[winfo width $progresscanv] - 4}]
2376 set x0 [expr {$w * [lindex $progresscoords 0]}]
2377 set x1 [expr {$w * [lindex $progresscoords 1]}]
2378 set h [winfo height $progresscanv]
2379 $progresscanv coords $progressitem $x0 0 $x1 $h
2380 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2381 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2382 set now [clock clicks -milliseconds]
2383 if {$now >= $lastprogupdate + 100} {
2384 set progupdatepending 0
2386 } elseif {!$progupdatepending} {
2387 set progupdatepending 1
2388 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2392 proc doprogupdate {} {
2393 global lastprogupdate progupdatepending
2395 if {$progupdatepending} {
2396 set progupdatepending 0
2397 set lastprogupdate [clock clicks -milliseconds]
2402 proc savestuff {w} {
2403 global canv canv2 canv3 mainfont textfont uifont tabstop
2404 global stuffsaved findmergefiles maxgraphpct
2405 global maxwidth showneartags showlocalchanges
2406 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2407 global cmitmode wrapcomment datetimeformat limitdiffs
2408 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2409 global autoselect extdifftool perfile_attrs
2411 if {$stuffsaved} return
2412 if {![winfo viewable .]} return
2414 set f [open "~/.gitk-new" w]
2415 puts $f [list set mainfont $mainfont]
2416 puts $f [list set textfont $textfont]
2417 puts $f [list set uifont $uifont]
2418 puts $f [list set tabstop $tabstop]
2419 puts $f [list set findmergefiles $findmergefiles]
2420 puts $f [list set maxgraphpct $maxgraphpct]
2421 puts $f [list set maxwidth $maxwidth]
2422 puts $f [list set cmitmode $cmitmode]
2423 puts $f [list set wrapcomment $wrapcomment]
2424 puts $f [list set autoselect $autoselect]
2425 puts $f [list set showneartags $showneartags]
2426 puts $f [list set showlocalchanges $showlocalchanges]
2427 puts $f [list set datetimeformat $datetimeformat]
2428 puts $f [list set limitdiffs $limitdiffs]
2429 puts $f [list set bgcolor $bgcolor]
2430 puts $f [list set fgcolor $fgcolor]
2431 puts $f [list set colors $colors]
2432 puts $f [list set diffcolors $diffcolors]
2433 puts $f [list set diffcontext $diffcontext]
2434 puts $f [list set selectbgcolor $selectbgcolor]
2435 puts $f [list set extdifftool $extdifftool]
2436 puts $f [list set perfile_attrs $perfile_attrs]
2438 puts $f "set geometry(main) [wm geometry .]"
2439 puts $f "set geometry(topwidth) [winfo width .tf]"
2440 puts $f "set geometry(topheight) [winfo height .tf]"
2441 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2442 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2443 puts $f "set geometry(botwidth) [winfo width .bleft]"
2444 puts $f "set geometry(botheight) [winfo height .bleft]"
2446 puts -nonewline $f "set permviews {"
2447 for {set v 0} {$v < $nextviewnum} {incr v} {
2448 if {$viewperm($v)} {
2449 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2454 file rename -force "~/.gitk-new" "~/.gitk"
2459 proc resizeclistpanes {win w} {
2461 if {[info exists oldwidth($win)]} {
2462 set s0 [$win sash coord 0]
2463 set s1 [$win sash coord 1]
2465 set sash0 [expr {int($w/2 - 2)}]
2466 set sash1 [expr {int($w*5/6 - 2)}]
2468 set factor [expr {1.0 * $w / $oldwidth($win)}]
2469 set sash0 [expr {int($factor * [lindex $s0 0])}]
2470 set sash1 [expr {int($factor * [lindex $s1 0])}]
2474 if {$sash1 < $sash0 + 20} {
2475 set sash1 [expr {$sash0 + 20}]
2477 if {$sash1 > $w - 10} {
2478 set sash1 [expr {$w - 10}]
2479 if {$sash0 > $sash1 - 20} {
2480 set sash0 [expr {$sash1 - 20}]
2484 $win sash place 0 $sash0 [lindex $s0 1]
2485 $win sash place 1 $sash1 [lindex $s1 1]
2487 set oldwidth($win) $w
2490 proc resizecdetpanes {win w} {
2492 if {[info exists oldwidth($win)]} {
2493 set s0 [$win sash coord 0]
2495 set sash0 [expr {int($w*3/4 - 2)}]
2497 set factor [expr {1.0 * $w / $oldwidth($win)}]
2498 set sash0 [expr {int($factor * [lindex $s0 0])}]
2502 if {$sash0 > $w - 15} {
2503 set sash0 [expr {$w - 15}]
2506 $win sash place 0 $sash0 [lindex $s0 1]
2508 set oldwidth($win) $w
2511 proc allcanvs args {
2512 global canv canv2 canv3
2518 proc bindall {event action} {
2519 global canv canv2 canv3
2520 bind $canv $event $action
2521 bind $canv2 $event $action
2522 bind $canv3 $event $action
2528 if {[winfo exists $w]} {
2533 wm title $w [mc "About gitk"]
2534 message $w.m -text [mc "
2535 Gitk - a commit viewer for git
2537 Copyright © 2005-2008 Paul Mackerras
2539 Use and redistribute under the terms of the GNU General Public License"] \
2540 -justify center -aspect 400 -border 2 -bg white -relief groove
2541 pack $w.m -side top -fill x -padx 2 -pady 2
2542 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2543 pack $w.ok -side bottom
2544 bind $w <Visibility> "focus $w.ok"
2545 bind $w <Key-Escape> "destroy $w"
2546 bind $w <Key-Return> "destroy $w"
2551 if {[winfo exists $w]} {
2555 if {[tk windowingsystem] eq {aqua}} {
2561 wm title $w [mc "Gitk key bindings"]
2562 message $w.m -text "
2563 [mc "Gitk key bindings:"]
2565 [mc "<%s-Q> Quit" $M1T]
2566 [mc "<Home> Move to first commit"]
2567 [mc "<End> Move to last commit"]
2568 [mc "<Up>, p, i Move up one commit"]
2569 [mc "<Down>, n, k Move down one commit"]
2570 [mc "<Left>, z, j Go back in history list"]
2571 [mc "<Right>, x, l Go forward in history list"]
2572 [mc "<PageUp> Move up one page in commit list"]
2573 [mc "<PageDown> Move down one page in commit list"]
2574 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2575 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2576 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2577 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2578 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2579 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2580 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2581 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2582 [mc "<Delete>, b Scroll diff view up one page"]
2583 [mc "<Backspace> Scroll diff view up one page"]
2584 [mc "<Space> Scroll diff view down one page"]
2585 [mc "u Scroll diff view up 18 lines"]
2586 [mc "d Scroll diff view down 18 lines"]
2587 [mc "<%s-F> Find" $M1T]
2588 [mc "<%s-G> Move to next find hit" $M1T]
2589 [mc "<Return> Move to next find hit"]
2590 [mc "/ Move to next find hit, or redo find"]
2591 [mc "? Move to previous find hit"]
2592 [mc "f Scroll diff view to next file"]
2593 [mc "<%s-S> Search for next hit in diff view" $M1T]
2594 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2595 [mc "<%s-KP+> Increase font size" $M1T]
2596 [mc "<%s-plus> Increase font size" $M1T]
2597 [mc "<%s-KP-> Decrease font size" $M1T]
2598 [mc "<%s-minus> Decrease font size" $M1T]
2601 -justify left -bg white -border 2 -relief groove
2602 pack $w.m -side top -fill both -padx 2 -pady 2
2603 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2604 pack $w.ok -side bottom
2605 bind $w <Visibility> "focus $w.ok"
2606 bind $w <Key-Escape> "destroy $w"
2607 bind $w <Key-Return> "destroy $w"
2610 # Procedures for manipulating the file list window at the
2611 # bottom right of the overall window.
2613 proc treeview {w l openlevs} {
2614 global treecontents treediropen treeheight treeparent treeindex
2624 set treecontents() {}
2625 $w conf -state normal
2627 while {[string range $f 0 $prefixend] ne $prefix} {
2628 if {$lev <= $openlevs} {
2629 $w mark set e:$treeindex($prefix) "end -1c"
2630 $w mark gravity e:$treeindex($prefix) left
2632 set treeheight($prefix) $ht
2633 incr ht [lindex $htstack end]
2634 set htstack [lreplace $htstack end end]
2635 set prefixend [lindex $prefendstack end]
2636 set prefendstack [lreplace $prefendstack end end]
2637 set prefix [string range $prefix 0 $prefixend]
2640 set tail [string range $f [expr {$prefixend+1}] end]
2641 while {[set slash [string first "/" $tail]] >= 0} {
2644 lappend prefendstack $prefixend
2645 incr prefixend [expr {$slash + 1}]
2646 set d [string range $tail 0 $slash]
2647 lappend treecontents($prefix) $d
2648 set oldprefix $prefix
2650 set treecontents($prefix) {}
2651 set treeindex($prefix) [incr ix]
2652 set treeparent($prefix) $oldprefix
2653 set tail [string range $tail [expr {$slash+1}] end]
2654 if {$lev <= $openlevs} {
2656 set treediropen($prefix) [expr {$lev < $openlevs}]
2657 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2658 $w mark set d:$ix "end -1c"
2659 $w mark gravity d:$ix left
2661 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2663 $w image create end -align center -image $bm -padx 1 \
2665 $w insert end $d [highlight_tag $prefix]
2666 $w mark set s:$ix "end -1c"
2667 $w mark gravity s:$ix left
2672 if {$lev <= $openlevs} {
2675 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2677 $w insert end $tail [highlight_tag $f]
2679 lappend treecontents($prefix) $tail
2682 while {$htstack ne {}} {
2683 set treeheight($prefix) $ht
2684 incr ht [lindex $htstack end]
2685 set htstack [lreplace $htstack end end]
2686 set prefixend [lindex $prefendstack end]
2687 set prefendstack [lreplace $prefendstack end end]
2688 set prefix [string range $prefix 0 $prefixend]
2690 $w conf -state disabled
2693 proc linetoelt {l} {
2694 global treeheight treecontents
2699 foreach e $treecontents($prefix) {
2704 if {[string index $e end] eq "/"} {
2705 set n $treeheight($prefix$e)
2717 proc highlight_tree {y prefix} {
2718 global treeheight treecontents cflist
2720 foreach e $treecontents($prefix) {
2722 if {[highlight_tag $path] ne {}} {
2723 $cflist tag add bold $y.0 "$y.0 lineend"
2726 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2727 set y [highlight_tree $y $path]
2733 proc treeclosedir {w dir} {
2734 global treediropen treeheight treeparent treeindex
2736 set ix $treeindex($dir)
2737 $w conf -state normal
2738 $w delete s:$ix e:$ix
2739 set treediropen($dir) 0
2740 $w image configure a:$ix -image tri-rt
2741 $w conf -state disabled
2742 set n [expr {1 - $treeheight($dir)}]
2743 while {$dir ne {}} {
2744 incr treeheight($dir) $n
2745 set dir $treeparent($dir)
2749 proc treeopendir {w dir} {
2750 global treediropen treeheight treeparent treecontents treeindex
2752 set ix $treeindex($dir)
2753 $w conf -state normal
2754 $w image configure a:$ix -image tri-dn
2755 $w mark set e:$ix s:$ix
2756 $w mark gravity e:$ix right
2759 set n [llength $treecontents($dir)]
2760 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2763 incr treeheight($x) $n
2765 foreach e $treecontents($dir) {
2767 if {[string index $e end] eq "/"} {
2768 set iy $treeindex($de)
2769 $w mark set d:$iy e:$ix
2770 $w mark gravity d:$iy left
2771 $w insert e:$ix $str
2772 set treediropen($de) 0
2773 $w image create e:$ix -align center -image tri-rt -padx 1 \
2775 $w insert e:$ix $e [highlight_tag $de]
2776 $w mark set s:$iy e:$ix
2777 $w mark gravity s:$iy left
2778 set treeheight($de) 1
2780 $w insert e:$ix $str
2781 $w insert e:$ix $e [highlight_tag $de]
2784 $w mark gravity e:$ix right
2785 $w conf -state disabled
2786 set treediropen($dir) 1
2787 set top [lindex [split [$w index @0,0] .] 0]
2788 set ht [$w cget -height]
2789 set l [lindex [split [$w index s:$ix] .] 0]
2792 } elseif {$l + $n + 1 > $top + $ht} {
2793 set top [expr {$l + $n + 2 - $ht}]
2801 proc treeclick {w x y} {
2802 global treediropen cmitmode ctext cflist cflist_top
2804 if {$cmitmode ne "tree"} return
2805 if {![info exists cflist_top]} return
2806 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2807 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2808 $cflist tag add highlight $l.0 "$l.0 lineend"
2814 set e [linetoelt $l]
2815 if {[string index $e end] ne "/"} {
2817 } elseif {$treediropen($e)} {
2824 proc setfilelist {id} {
2825 global treefilelist cflist
2827 treeview $cflist $treefilelist($id) 0
2830 image create bitmap tri-rt -background black -foreground blue -data {
2831 #define tri-rt_width 13
2832 #define tri-rt_height 13
2833 static unsigned char tri-rt_bits[] = {
2834 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2835 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2838 #define tri-rt-mask_width 13
2839 #define tri-rt-mask_height 13
2840 static unsigned char tri-rt-mask_bits[] = {
2841 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2842 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2845 image create bitmap tri-dn -background black -foreground blue -data {
2846 #define tri-dn_width 13
2847 #define tri-dn_height 13
2848 static unsigned char tri-dn_bits[] = {
2849 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2850 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2853 #define tri-dn-mask_width 13
2854 #define tri-dn-mask_height 13
2855 static unsigned char tri-dn-mask_bits[] = {
2856 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2857 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2861 image create bitmap reficon-T -background black -foreground yellow -data {
2862 #define tagicon_width 13
2863 #define tagicon_height 9
2864 static unsigned char tagicon_bits[] = {
2865 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2866 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2868 #define tagicon-mask_width 13
2869 #define tagicon-mask_height 9
2870 static unsigned char tagicon-mask_bits[] = {
2871 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2872 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2875 #define headicon_width 13
2876 #define headicon_height 9
2877 static unsigned char headicon_bits[] = {
2878 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2879 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2882 #define headicon-mask_width 13
2883 #define headicon-mask_height 9
2884 static unsigned char headicon-mask_bits[] = {
2885 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2886 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2888 image create bitmap reficon-H -background black -foreground green \
2889 -data $rectdata -maskdata $rectmask
2890 image create bitmap reficon-o -background black -foreground "#ddddff" \
2891 -data $rectdata -maskdata $rectmask
2893 proc init_flist {first} {
2894 global cflist cflist_top difffilestart
2896 $cflist conf -state normal
2897 $cflist delete 0.0 end
2899 $cflist insert end $first
2901 $cflist tag add highlight 1.0 "1.0 lineend"
2903 catch {unset cflist_top}
2905 $cflist conf -state disabled
2906 set difffilestart {}
2909 proc highlight_tag {f} {
2910 global highlight_paths
2912 foreach p $highlight_paths {
2913 if {[string match $p $f]} {
2920 proc highlight_filelist {} {
2921 global cmitmode cflist
2923 $cflist conf -state normal
2924 if {$cmitmode ne "tree"} {
2925 set end [lindex [split [$cflist index end] .] 0]
2926 for {set l 2} {$l < $end} {incr l} {
2927 set line [$cflist get $l.0 "$l.0 lineend"]
2928 if {[highlight_tag $line] ne {}} {
2929 $cflist tag add bold $l.0 "$l.0 lineend"
2935 $cflist conf -state disabled
2938 proc unhighlight_filelist {} {
2941 $cflist conf -state normal
2942 $cflist tag remove bold 1.0 end
2943 $cflist conf -state disabled
2946 proc add_flist {fl} {
2949 $cflist conf -state normal
2951 $cflist insert end "\n"
2952 $cflist insert end $f [highlight_tag $f]
2954 $cflist conf -state disabled
2957 proc sel_flist {w x y} {
2958 global ctext difffilestart cflist cflist_top cmitmode
2960 if {$cmitmode eq "tree"} return
2961 if {![info exists cflist_top]} return
2962 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2963 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2964 $cflist tag add highlight $l.0 "$l.0 lineend"
2969 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2973 proc pop_flist_menu {w X Y x y} {
2974 global ctext cflist cmitmode flist_menu flist_menu_file
2975 global treediffs diffids
2978 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2980 if {$cmitmode eq "tree"} {
2981 set e [linetoelt $l]
2982 if {[string index $e end] eq "/"} return
2984 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2986 set flist_menu_file $e
2987 set xdiffstate "normal"
2988 if {$cmitmode eq "tree"} {
2989 set xdiffstate "disabled"
2991 # Disable "External diff" item in tree mode
2992 $flist_menu entryconf 2 -state $xdiffstate
2993 tk_popup $flist_menu $X $Y
2996 proc flist_hl {only} {
2997 global flist_menu_file findstring gdttype
2999 set x [shellquote $flist_menu_file]
3000 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3003 append findstring " " $x
3005 set gdttype [mc "touching paths:"]
3008 proc save_file_from_commit {filename output what} {
3011 if {[catch {exec git show $filename -- > $output} err]} {
3012 if {[string match "fatal: bad revision *" $err]} {
3015 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3021 proc external_diff_get_one_file {diffid filename diffdir} {
3022 global nullid nullid2 nullfile
3025 if {$diffid == $nullid} {
3026 set difffile [file join [file dirname $gitdir] $filename]
3027 if {[file exists $difffile]} {
3032 if {$diffid == $nullid2} {
3033 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3034 return [save_file_from_commit :$filename $difffile index]
3036 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3037 return [save_file_from_commit $diffid:$filename $difffile \
3041 proc external_diff {} {
3042 global gitktmpdir nullid nullid2
3043 global flist_menu_file
3046 global gitdir extdifftool
3048 if {[llength $diffids] == 1} {
3049 # no reference commit given
3050 set diffidto [lindex $diffids 0]
3051 if {$diffidto eq $nullid} {
3052 # diffing working copy with index
3053 set diffidfrom $nullid2
3054 } elseif {$diffidto eq $nullid2} {
3055 # diffing index with HEAD
3056 set diffidfrom "HEAD"
3058 # use first parent commit
3059 global parentlist selectedline
3060 set diffidfrom [lindex $parentlist $selectedline 0]
3063 set diffidfrom [lindex $diffids 0]
3064 set diffidto [lindex $diffids 1]
3067 # make sure that several diffs wont collide
3068 if {![info exists gitktmpdir]} {
3069 set gitktmpdir [file join [file dirname $gitdir] \
3070 [format ".gitk-tmp.%s" [pid]]]
3071 if {[catch {file mkdir $gitktmpdir} err]} {
3072 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3079 set diffdir [file join $gitktmpdir $diffnum]
3080 if {[catch {file mkdir $diffdir} err]} {
3081 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3085 # gather files to diff
3086 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3087 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3089 if {$difffromfile ne {} && $difftofile ne {}} {
3090 set cmd [concat | [shellsplit $extdifftool] \
3091 [list $difffromfile $difftofile]]
3092 if {[catch {set fl [open $cmd r]} err]} {
3093 file delete -force $diffdir
3094 error_popup "$extdifftool: [mc "command failed:"] $err"
3096 fconfigure $fl -blocking 0
3097 filerun $fl [list delete_at_eof $fl $diffdir]
3102 proc external_blame {parent_idx} {
3103 global flist_menu_file
3104 global nullid nullid2
3105 global parentlist selectedline currentid
3107 if {$parent_idx > 0} {
3108 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3110 set base_commit $currentid
3113 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3114 error_popup [mc "No such commit"]
3118 if {[catch {exec git gui blame $base_commit $flist_menu_file &} err]} {
3119 error_popup "[mc "git gui blame: command failed:"] $err"
3123 # delete $dir when we see eof on $f (presumably because the child has exited)
3124 proc delete_at_eof {f dir} {
3125 while {[gets $f line] >= 0} {}
3127 if {[catch {close $f} err]} {
3128 error_popup "[mc "External diff viewer failed:"] $err"
3130 file delete -force $dir
3136 # Functions for adding and removing shell-type quoting
3138 proc shellquote {str} {
3139 if {![string match "*\['\"\\ \t]*" $str]} {
3142 if {![string match "*\['\"\\]*" $str]} {
3145 if {![string match "*'*" $str]} {
3148 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3151 proc shellarglist {l} {
3157 append str [shellquote $a]
3162 proc shelldequote {str} {
3167 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3168 append ret [string range $str $used end]
3169 set used [string length $str]
3172 set first [lindex $first 0]
3173 set ch [string index $str $first]
3174 if {$first > $used} {
3175 append ret [string range $str $used [expr {$first - 1}]]
3178 if {$ch eq " " || $ch eq "\t"} break
3181 set first [string first "'" $str $used]
3183 error "unmatched single-quote"
3185 append ret [string range $str $used [expr {$first - 1}]]
3190 if {$used >= [string length $str]} {
3191 error "trailing backslash"
3193 append ret [string index $str $used]
3198 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3199 error "unmatched double-quote"
3201 set first [lindex $first 0]
3202 set ch [string index $str $first]
3203 if {$first > $used} {
3204 append ret [string range $str $used [expr {$first - 1}]]
3207 if {$ch eq "\""} break
3209 append ret [string index $str $used]
3213 return [list $used $ret]
3216 proc shellsplit {str} {
3219 set str [string trimleft $str]
3220 if {$str eq {}} break
3221 set dq [shelldequote $str]
3222 set n [lindex $dq 0]
3223 set word [lindex $dq 1]
3224 set str [string range $str $n end]
3230 # Code to implement multiple views
3232 proc newview {ishighlight} {
3233 global nextviewnum newviewname newviewperm newishighlight
3234 global newviewargs revtreeargs viewargscmd newviewargscmd curview
3236 set newishighlight $ishighlight
3238 if {[winfo exists $top]} {
3242 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3243 set newviewperm($nextviewnum) 0
3244 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
3245 set newviewargscmd($nextviewnum) $viewargscmd($curview)
3246 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3251 global viewname viewperm newviewname newviewperm
3252 global viewargs newviewargs viewargscmd newviewargscmd
3254 set top .gitkvedit-$curview
3255 if {[winfo exists $top]} {
3259 set newviewname($curview) $viewname($curview)
3260 set newviewperm($curview) $viewperm($curview)
3261 set newviewargs($curview) [shellarglist $viewargs($curview)]
3262 set newviewargscmd($curview) $viewargscmd($curview)
3263 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
3266 proc vieweditor {top n title} {
3267 global newviewname newviewperm viewfiles bgcolor
3270 wm title $top $title
3271 label $top.nl -text [mc "Name"]
3272 entry $top.name -width 20 -textvariable newviewname($n)
3273 grid $top.nl $top.name -sticky w -pady 5
3274 checkbutton $top.perm -text [mc "Remember this view"] \
3275 -variable newviewperm($n)
3276 grid $top.perm - -pady 5 -sticky w
3277 message $top.al -aspect 1000 \
3278 -text [mc "Commits to include (arguments to git log):"]
3279 grid $top.al - -sticky w -pady 5
3280 entry $top.args -width 50 -textvariable newviewargs($n) \
3281 -background $bgcolor
3282 grid $top.args - -sticky ew -padx 5
3284 message $top.ac -aspect 1000 \
3285 -text [mc "Command to generate more commits to include:"]
3286 grid $top.ac - -sticky w -pady 5
3287 entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
3289 grid $top.argscmd - -sticky ew -padx 5
3291 message $top.l -aspect 1000 \
3292 -text [mc "Enter files and directories to include, one per line:"]
3293 grid $top.l - -sticky w
3294 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
3295 if {[info exists viewfiles($n)]} {
3296 foreach f $viewfiles($n) {
3297 $top.t insert end $f
3298 $top.t insert end "\n"
3300 $top.t delete {end - 1c} end
3301 $top.t mark set insert 0.0
3303 grid $top.t - -sticky ew -padx 5
3305 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3306 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3307 grid $top.buts.ok $top.buts.can
3308 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3309 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3310 grid $top.buts - -pady 10 -sticky ew
3314 proc doviewmenu {m first cmd op argv} {
3315 set nmenu [$m index end]
3316 for {set i $first} {$i <= $nmenu} {incr i} {
3317 if {[$m entrycget $i -command] eq $cmd} {
3318 eval $m $op $i $argv
3324 proc allviewmenus {n op args} {
3327 doviewmenu .bar.view 5 [list showview $n] $op $args
3328 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3331 proc newviewok {top n} {
3332 global nextviewnum newviewperm newviewname newishighlight
3333 global viewname viewfiles viewperm selectedview curview
3334 global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
3337 set newargs [shellsplit $newviewargs($n)]
3339 error_popup "[mc "Error in commit selection arguments:"] $err"
3345 foreach f [split [$top.t get 0.0 end] "\n"] {
3346 set ft [string trim $f]
3351 if {![info exists viewfiles($n)]} {
3352 # creating a new view
3354 set viewname($n) $newviewname($n)
3355 set viewperm($n) $newviewperm($n)
3356 set viewfiles($n) $files
3357 set viewargs($n) $newargs
3358 set viewargscmd($n) $newviewargscmd($n)
3360 if {!$newishighlight} {
3363 run addvhighlight $n
3366 # editing an existing view
3367 set viewperm($n) $newviewperm($n)
3368 if {$newviewname($n) ne $viewname($n)} {
3369 set viewname($n) $newviewname($n)
3370 doviewmenu .bar.view 5 [list showview $n] \
3371 entryconf [list -label $viewname($n)]
3372 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3373 # entryconf [list -label $viewname($n) -value $viewname($n)]
3375 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3376 $newviewargscmd($n) ne $viewargscmd($n)} {
3377 set viewfiles($n) $files
3378 set viewargs($n) $newargs
3379 set viewargscmd($n) $newviewargscmd($n)
3380 if {$curview == $n} {
3385 catch {destroy $top}
3389 global curview viewperm hlview selectedhlview
3391 if {$curview == 0} return
3392 if {[info exists hlview] && $hlview == $curview} {
3393 set selectedhlview [mc "None"]
3396 allviewmenus $curview delete
3397 set viewperm($curview) 0
3401 proc addviewmenu {n} {
3402 global viewname viewhlmenu
3404 .bar.view add radiobutton -label $viewname($n) \
3405 -command [list showview $n] -variable selectedview -value $n
3406 #$viewhlmenu add radiobutton -label $viewname($n) \
3407 # -command [list addvhighlight $n] -variable selectedhlview
3411 global curview cached_commitrow ordertok
3412 global displayorder parentlist rowidlist rowisopt rowfinal
3413 global colormap rowtextx nextcolor canvxmax
3414 global numcommits viewcomplete
3415 global selectedline currentid canv canvy0
3417 global pending_select mainheadid
3420 global hlview selectedhlview commitinterest
3422 if {$n == $curview} return
3424 set ymax [lindex [$canv cget -scrollregion] 3]
3425 set span [$canv yview]
3426 set ytop [expr {[lindex $span 0] * $ymax}]
3427 set ybot [expr {[lindex $span 1] * $ymax}]
3428 set yscreen [expr {($ybot - $ytop) / 2}]
3429 if {$selectedline ne {}} {
3430 set selid $currentid
3431 set y [yc $selectedline]
3432 if {$ytop < $y && $y < $ybot} {
3433 set yscreen [expr {$y - $ytop}]
3435 } elseif {[info exists pending_select]} {
3436 set selid $pending_select
3437 unset pending_select
3441 catch {unset treediffs}
3443 if {[info exists hlview] && $hlview == $n} {
3445 set selectedhlview [mc "None"]
3447 catch {unset commitinterest}
3448 catch {unset cached_commitrow}
3449 catch {unset ordertok}
3453 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3454 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3457 if {![info exists viewcomplete($n)]} {
3467 set numcommits $commitidx($n)
3469 catch {unset colormap}
3470 catch {unset rowtextx}
3472 set canvxmax [$canv cget -width]
3478 if {$selid ne {} && [commitinview $selid $n]} {
3479 set row [rowofcommit $selid]
3480 # try to get the selected row in the same position on the screen
3481 set ymax [lindex [$canv cget -scrollregion] 3]
3482 set ytop [expr {[yc $row] - $yscreen}]
3486 set yf [expr {$ytop * 1.0 / $ymax}]
3488 allcanvs yview moveto $yf
3492 } elseif {!$viewcomplete($n)} {
3493 reset_pending_select $selid
3495 reset_pending_select {}
3497 if {[commitinview $pending_select $curview]} {
3498 selectline [rowofcommit $pending_select] 1
3500 set row [first_real_row]
3501 if {$row < $numcommits} {
3506 if {!$viewcomplete($n)} {
3507 if {$numcommits == 0} {
3508 show_status [mc "Reading commits..."]
3510 } elseif {$numcommits == 0} {
3511 show_status [mc "No commits selected"]
3515 # Stuff relating to the highlighting facility
3517 proc ishighlighted {id} {
3518 global vhighlights fhighlights nhighlights rhighlights
3520 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3521 return $nhighlights($id)
3523 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3524 return $vhighlights($id)
3526 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
3527 return $fhighlights($id)
3529 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
3530 return $rhighlights($id)
3535 proc bolden {row font} {
3536 global canv linehtag selectedline boldrows
3538 lappend boldrows $row
3539 $canv itemconf $linehtag($row) -font $font
3540 if {$row == $selectedline} {
3542 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
3543 -outline {{}} -tags secsel \
3544 -fill [$canv cget -selectbackground]]
3549 proc bolden_name {row font} {
3550 global canv2 linentag selectedline boldnamerows
3552 lappend boldnamerows $row
3553 $canv2 itemconf $linentag($row) -font $font
3554 if {$row == $selectedline} {
3555 $canv2 delete secsel
3556 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
3557 -outline {{}} -tags secsel \
3558 -fill [$canv2 cget -selectbackground]]
3567 foreach row $boldrows {
3568 if {![ishighlighted [commitonrow $row]]} {
3569 bolden $row mainfont
3571 lappend stillbold $row
3574 set boldrows $stillbold
3577 proc addvhighlight {n} {
3578 global hlview viewcomplete curview vhl_done commitidx
3580 if {[info exists hlview]} {
3584 if {$n != $curview && ![info exists viewcomplete($n)]} {
3587 set vhl_done $commitidx($hlview)
3588 if {$vhl_done > 0} {
3593 proc delvhighlight {} {
3594 global hlview vhighlights
3596 if {![info exists hlview]} return
3598 catch {unset vhighlights}
3602 proc vhighlightmore {} {
3603 global hlview vhl_done commitidx vhighlights curview
3605 set max $commitidx($hlview)
3606 set vr [visiblerows]
3607 set r0 [lindex $vr 0]
3608 set r1 [lindex $vr 1]
3609 for {set i $vhl_done} {$i < $max} {incr i} {
3610 set id [commitonrow $i $hlview]
3611 if {[commitinview $id $curview]} {
3612 set row [rowofcommit $id]
3613 if {$r0 <= $row && $row <= $r1} {
3614 if {![highlighted $row]} {
3615 bolden $row mainfontbold
3617 set vhighlights($id) 1
3625 proc askvhighlight {row id} {
3626 global hlview vhighlights iddrawn
3628 if {[commitinview $id $hlview]} {
3629 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3630 bolden $row mainfontbold
3632 set vhighlights($id) 1
3634 set vhighlights($id) 0
3638 proc hfiles_change {} {
3639 global highlight_files filehighlight fhighlights fh_serial
3640 global highlight_paths gdttype
3642 if {[info exists filehighlight]} {
3643 # delete previous highlights
3644 catch {close $filehighlight}
3646 catch {unset fhighlights}
3648 unhighlight_filelist
3650 set highlight_paths {}
3651 after cancel do_file_hl $fh_serial
3653 if {$highlight_files ne {}} {
3654 after 300 do_file_hl $fh_serial
3658 proc gdttype_change {name ix op} {
3659 global gdttype highlight_files findstring findpattern
3662 if {$findstring ne {}} {
3663 if {$gdttype eq [mc "containing:"]} {
3664 if {$highlight_files ne {}} {
3665 set highlight_files {}
3670 if {$findpattern ne {}} {
3674 set highlight_files $findstring
3679 # enable/disable findtype/findloc menus too
3682 proc find_change {name ix op} {
3683 global gdttype findstring highlight_files
3686 if {$gdttype eq [mc "containing:"]} {
3689 if {$highlight_files ne $findstring} {
3690 set highlight_files $findstring
3697 proc findcom_change args {
3698 global nhighlights boldnamerows
3699 global findpattern findtype findstring gdttype
3702 # delete previous highlights, if any
3703 foreach row $boldnamerows {
3704 bolden_name $row mainfont
3707 catch {unset nhighlights}
3710 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3712 } elseif {$findtype eq [mc "Regexp"]} {
3713 set findpattern $findstring
3715 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3717 set findpattern "*$e*"
3721 proc makepatterns {l} {
3724 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3725 if {[string index $ee end] eq "/"} {
3735 proc do_file_hl {serial} {
3736 global highlight_files filehighlight highlight_paths gdttype fhl_list
3738 if {$gdttype eq [mc "touching paths:"]} {
3739 if {[catch {set paths [shellsplit $highlight_files]}]} return
3740 set highlight_paths [makepatterns $paths]
3742 set gdtargs [concat -- $paths]
3743 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3744 set gdtargs [list "-S$highlight_files"]
3746 # must be "containing:", i.e. we're searching commit info
3749 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3750 set filehighlight [open $cmd r+]
3751 fconfigure $filehighlight -blocking 0
3752 filerun $filehighlight readfhighlight
3758 proc flushhighlights {} {
3759 global filehighlight fhl_list
3761 if {[info exists filehighlight]} {
3763 puts $filehighlight ""
3764 flush $filehighlight
3768 proc askfilehighlight {row id} {
3769 global filehighlight fhighlights fhl_list
3771 lappend fhl_list $id
3772 set fhighlights($id) -1
3773 puts $filehighlight $id
3776 proc readfhighlight {} {
3777 global filehighlight fhighlights curview iddrawn
3778 global fhl_list find_dirn
3780 if {![info exists filehighlight]} {
3784 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3785 set line [string trim $line]
3786 set i [lsearch -exact $fhl_list $line]
3787 if {$i < 0} continue
3788 for {set j 0} {$j < $i} {incr j} {
3789 set id [lindex $fhl_list $j]
3790 set fhighlights($id) 0
3792 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3793 if {$line eq {}} continue
3794 if {![commitinview $line $curview]} continue
3795 set row [rowofcommit $line]
3796 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3797 bolden $row mainfontbold
3799 set fhighlights($line) 1
3801 if {[eof $filehighlight]} {
3803 puts "oops, git diff-tree died"
3804 catch {close $filehighlight}
3808 if {[info exists find_dirn]} {
3814 proc doesmatch {f} {
3815 global findtype findpattern
3817 if {$findtype eq [mc "Regexp"]} {
3818 return [regexp $findpattern $f]
3819 } elseif {$findtype eq [mc "IgnCase"]} {
3820 return [string match -nocase $findpattern $f]
3822 return [string match $findpattern $f]
3826 proc askfindhighlight {row id} {
3827 global nhighlights commitinfo iddrawn
3829 global markingmatches
3831 if {![info exists commitinfo($id)]} {
3834 set info $commitinfo($id)
3836 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3837 foreach f $info ty $fldtypes {
3838 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3840 if {$ty eq [mc "Author"]} {
3847 if {$isbold && [info exists iddrawn($id)]} {
3848 if {![ishighlighted $id]} {
3849 bolden $row mainfontbold
3851 bolden_name $row mainfontbold
3854 if {$markingmatches} {
3855 markrowmatches $row $id
3858 set nhighlights($id) $isbold
3861 proc markrowmatches {row id} {
3862 global canv canv2 linehtag linentag commitinfo findloc
3864 set headline [lindex $commitinfo($id) 0]
3865 set author [lindex $commitinfo($id) 1]
3866 $canv delete match$row
3867 $canv2 delete match$row
3868 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3869 set m [findmatches $headline]
3871 markmatches $canv $row $headline $linehtag($row) $m \
3872 [$canv itemcget $linehtag($row) -font] $row
3875 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3876 set m [findmatches $author]
3878 markmatches $canv2 $row $author $linentag($row) $m \
3879 [$canv2 itemcget $linentag($row) -font] $row
3884 proc vrel_change {name ix op} {
3885 global highlight_related
3888 if {$highlight_related ne [mc "None"]} {
3893 # prepare for testing whether commits are descendents or ancestors of a
3894 proc rhighlight_sel {a} {
3895 global descendent desc_todo ancestor anc_todo
3896 global highlight_related
3898 catch {unset descendent}
3899 set desc_todo [list $a]
3900 catch {unset ancestor}
3901 set anc_todo [list $a]
3902 if {$highlight_related ne [mc "None"]} {
3908 proc rhighlight_none {} {
3911 catch {unset rhighlights}
3915 proc is_descendent {a} {
3916 global curview children descendent desc_todo
3919 set la [rowofcommit $a]
3923 for {set i 0} {$i < [llength $todo]} {incr i} {
3924 set do [lindex $todo $i]
3925 if {[rowofcommit $do] < $la} {
3926 lappend leftover $do
3929 foreach nk $children($v,$do) {
3930 if {![info exists descendent($nk)]} {
3931 set descendent($nk) 1
3939 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3943 set descendent($a) 0
3944 set desc_todo $leftover
3947 proc is_ancestor {a} {
3948 global curview parents ancestor anc_todo
3951 set la [rowofcommit $a]
3955 for {set i 0} {$i < [llength $todo]} {incr i} {
3956 set do [lindex $todo $i]
3957 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3958 lappend leftover $do
3961 foreach np $parents($v,$do) {
3962 if {![info exists ancestor($np)]} {
3971 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3976 set anc_todo $leftover
3979 proc askrelhighlight {row id} {
3980 global descendent highlight_related iddrawn rhighlights
3981 global selectedline ancestor
3983 if {$selectedline eq {}} return
3985 if {$highlight_related eq [mc "Descendant"] ||
3986 $highlight_related eq [mc "Not descendant"]} {
3987 if {![info exists descendent($id)]} {
3990 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
3993 } elseif {$highlight_related eq [mc "Ancestor"] ||
3994 $highlight_related eq [mc "Not ancestor"]} {
3995 if {![info exists ancestor($id)]} {
3998 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4002 if {[info exists iddrawn($id)]} {
4003 if {$isbold && ![ishighlighted $id]} {
4004 bolden $row mainfontbold
4007 set rhighlights($id) $isbold
4010 # Graph layout functions
4012 proc shortids {ids} {
4015 if {[llength $id] > 1} {
4016 lappend res [shortids $id]
4017 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4018 lappend res [string range $id 0 7]
4029 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4030 if {($n & $mask) != 0} {
4031 set ret [concat $ret $o]
4033 set o [concat $o $o]
4038 proc ordertoken {id} {
4039 global ordertok curview varcid varcstart varctok curview parents children
4040 global nullid nullid2
4042 if {[info exists ordertok($id)]} {
4043 return $ordertok($id)
4048 if {[info exists varcid($curview,$id)]} {
4049 set a $varcid($curview,$id)
4050 set p [lindex $varcstart($curview) $a]
4052 set p [lindex $children($curview,$id) 0]
4054 if {[info exists ordertok($p)]} {
4055 set tok $ordertok($p)
4058 set id [first_real_child $curview,$p]
4061 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4064 if {[llength $parents($curview,$id)] == 1} {
4065 lappend todo [list $p {}]
4067 set j [lsearch -exact $parents($curview,$id) $p]
4069 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4071 lappend todo [list $p [strrep $j]]
4074 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4075 set p [lindex $todo $i 0]
4076 append tok [lindex $todo $i 1]
4077 set ordertok($p) $tok
4079 set ordertok($origid) $tok
4083 # Work out where id should go in idlist so that order-token
4084 # values increase from left to right
4085 proc idcol {idlist id {i 0}} {
4086 set t [ordertoken $id]
4090 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4091 if {$i > [llength $idlist]} {
4092 set i [llength $idlist]
4094 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4097 if {$t > [ordertoken [lindex $idlist $i]]} {
4098 while {[incr i] < [llength $idlist] &&
4099 $t >= [ordertoken [lindex $idlist $i]]} {}
4105 proc initlayout {} {
4106 global rowidlist rowisopt rowfinal displayorder parentlist
4107 global numcommits canvxmax canv
4109 global colormap rowtextx
4118 set canvxmax [$canv cget -width]
4119 catch {unset colormap}
4120 catch {unset rowtextx}
4124 proc setcanvscroll {} {
4125 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4126 global lastscrollset lastscrollrows
4128 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4129 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4130 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4131 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4132 set lastscrollset [clock clicks -milliseconds]
4133 set lastscrollrows $numcommits
4136 proc visiblerows {} {
4137 global canv numcommits linespc
4139 set ymax [lindex [$canv cget -scrollregion] 3]
4140 if {$ymax eq {} || $ymax == 0} return
4142 set y0 [expr {int([lindex $f 0] * $ymax)}]
4143 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4147 set y1 [expr {int([lindex $f 1] * $ymax)}]
4148 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4149 if {$r1 >= $numcommits} {
4150 set r1 [expr {$numcommits - 1}]
4152 return [list $r0 $r1]
4155 proc layoutmore {} {
4156 global commitidx viewcomplete curview
4157 global numcommits pending_select curview
4158 global lastscrollset lastscrollrows
4160 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4161 [clock clicks -milliseconds] - $lastscrollset > 500} {
4164 if {[info exists pending_select] &&
4165 [commitinview $pending_select $curview]} {
4167 selectline [rowofcommit $pending_select] 1
4172 proc doshowlocalchanges {} {
4173 global curview mainheadid
4175 if {$mainheadid eq {}} return
4176 if {[commitinview $mainheadid $curview]} {
4179 interestedin $mainheadid dodiffindex
4183 proc dohidelocalchanges {} {
4184 global nullid nullid2 lserial curview
4186 if {[commitinview $nullid $curview]} {
4187 removefakerow $nullid
4189 if {[commitinview $nullid2 $curview]} {
4190 removefakerow $nullid2
4195 # spawn off a process to do git diff-index --cached HEAD
4196 proc dodiffindex {} {
4197 global lserial showlocalchanges
4200 if {!$showlocalchanges || !$isworktree} return
4202 set fd [open "|git diff-index --cached HEAD" r]
4203 fconfigure $fd -blocking 0
4204 set i [reg_instance $fd]
4205 filerun $fd [list readdiffindex $fd $lserial $i]
4208 proc readdiffindex {fd serial inst} {
4209 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4212 if {[gets $fd line] < 0} {
4218 # we only need to see one line and we don't really care what it says...
4221 if {$serial != $lserial} {
4225 # now see if there are any local changes not checked in to the index
4226 set fd [open "|git diff-files" r]
4227 fconfigure $fd -blocking 0
4228 set i [reg_instance $fd]
4229 filerun $fd [list readdifffiles $fd $serial $i]
4231 if {$isdiff && ![commitinview $nullid2 $curview]} {
4232 # add the line for the changes in the index to the graph
4233 set hl [mc "Local changes checked in to index but not committed"]
4234 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4235 set commitdata($nullid2) "\n $hl\n"
4236 if {[commitinview $nullid $curview]} {
4237 removefakerow $nullid
4239 insertfakerow $nullid2 $mainheadid
4240 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4241 removefakerow $nullid2
4246 proc readdifffiles {fd serial inst} {
4247 global mainheadid nullid nullid2 curview
4248 global commitinfo commitdata lserial
4251 if {[gets $fd line] < 0} {
4257 # we only need to see one line and we don't really care what it says...
4260 if {$serial != $lserial} {
4264 if {$isdiff && ![commitinview $nullid $curview]} {
4265 # add the line for the local diff to the graph
4266 set hl [mc "Local uncommitted changes, not checked in to index"]
4267 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4268 set commitdata($nullid) "\n $hl\n"
4269 if {[commitinview $nullid2 $curview]} {
4274 insertfakerow $nullid $p
4275 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4276 removefakerow $nullid
4281 proc nextuse {id row} {
4282 global curview children
4284 if {[info exists children($curview,$id)]} {
4285 foreach kid $children($curview,$id) {
4286 if {![commitinview $kid $curview]} {
4289 if {[rowofcommit $kid] > $row} {
4290 return [rowofcommit $kid]
4294 if {[commitinview $id $curview]} {
4295 return [rowofcommit $id]
4300 proc prevuse {id row} {
4301 global curview children
4304 if {[info exists children($curview,$id)]} {
4305 foreach kid $children($curview,$id) {
4306 if {![commitinview $kid $curview]} break
4307 if {[rowofcommit $kid] < $row} {
4308 set ret [rowofcommit $kid]
4315 proc make_idlist {row} {
4316 global displayorder parentlist uparrowlen downarrowlen mingaplen
4317 global commitidx curview children
4319 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4323 set ra [expr {$row - $downarrowlen}]
4327 set rb [expr {$row + $uparrowlen}]
4328 if {$rb > $commitidx($curview)} {
4329 set rb $commitidx($curview)
4331 make_disporder $r [expr {$rb + 1}]
4333 for {} {$r < $ra} {incr r} {
4334 set nextid [lindex $displayorder [expr {$r + 1}]]
4335 foreach p [lindex $parentlist $r] {
4336 if {$p eq $nextid} continue
4337 set rn [nextuse $p $r]
4339 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4340 lappend ids [list [ordertoken $p] $p]
4344 for {} {$r < $row} {incr r} {
4345 set nextid [lindex $displayorder [expr {$r + 1}]]
4346 foreach p [lindex $parentlist $r] {
4347 if {$p eq $nextid} continue
4348 set rn [nextuse $p $r]
4349 if {$rn < 0 || $rn >= $row} {
4350 lappend ids [list [ordertoken $p] $p]
4354 set id [lindex $displayorder $row]
4355 lappend ids [list [ordertoken $id] $id]
4357 foreach p [lindex $parentlist $r] {
4358 set firstkid [lindex $children($curview,$p) 0]
4359 if {[rowofcommit $firstkid] < $row} {
4360 lappend ids [list [ordertoken $p] $p]
4364 set id [lindex $displayorder $r]
4366 set firstkid [lindex $children($curview,$id) 0]
4367 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4368 lappend ids [list [ordertoken $id] $id]
4373 foreach idx [lsort -unique $ids] {
4374 lappend idlist [lindex $idx 1]
4379 proc rowsequal {a b} {
4380 while {[set i [lsearch -exact $a {}]] >= 0} {
4381 set a [lreplace $a $i $i]
4383 while {[set i [lsearch -exact $b {}]] >= 0} {
4384 set b [lreplace $b $i $i]
4386 return [expr {$a eq $b}]
4389 proc makeupline {id row rend col} {
4390 global rowidlist uparrowlen downarrowlen mingaplen
4392 for {set r $rend} {1} {set r $rstart} {
4393 set rstart [prevuse $id $r]
4394 if {$rstart < 0} return
4395 if {$rstart < $row} break
4397 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4398 set rstart [expr {$rend - $uparrowlen - 1}]
4400 for {set r $rstart} {[incr r] <= $row} {} {
4401 set idlist [lindex $rowidlist $r]
4402 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4403 set col [idcol $idlist $id $col]
4404 lset rowidlist $r [linsert $idlist $col $id]
4410 proc layoutrows {row endrow} {
4411 global rowidlist rowisopt rowfinal displayorder
4412 global uparrowlen downarrowlen maxwidth mingaplen
4413 global children parentlist
4414 global commitidx viewcomplete curview
4416 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4419 set rm1 [expr {$row - 1}]
4420 foreach id [lindex $rowidlist $rm1] {
4425 set final [lindex $rowfinal $rm1]
4427 for {} {$row < $endrow} {incr row} {
4428 set rm1 [expr {$row - 1}]
4429 if {$rm1 < 0 || $idlist eq {}} {
4430 set idlist [make_idlist $row]
4433 set id [lindex $displayorder $rm1]
4434 set col [lsearch -exact $idlist $id]
4435 set idlist [lreplace $idlist $col $col]
4436 foreach p [lindex $parentlist $rm1] {
4437 if {[lsearch -exact $idlist $p] < 0} {
4438 set col [idcol $idlist $p $col]
4439 set idlist [linsert $idlist $col $p]
4440 # if not the first child, we have to insert a line going up
4441 if {$id ne [lindex $children($curview,$p) 0]} {
4442 makeupline $p $rm1 $row $col
4446 set id [lindex $displayorder $row]
4447 if {$row > $downarrowlen} {
4448 set termrow [expr {$row - $downarrowlen - 1}]
4449 foreach p [lindex $parentlist $termrow] {
4450 set i [lsearch -exact $idlist $p]
4451 if {$i < 0} continue
4452 set nr [nextuse $p $termrow]
4453 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4454 set idlist [lreplace $idlist $i $i]
4458 set col [lsearch -exact $idlist $id]
4460 set col [idcol $idlist $id]
4461 set idlist [linsert $idlist $col $id]
4462 if {$children($curview,$id) ne {}} {
4463 makeupline $id $rm1 $row $col
4466 set r [expr {$row + $uparrowlen - 1}]
4467 if {$r < $commitidx($curview)} {
4469 foreach p [lindex $parentlist $r] {
4470 if {[lsearch -exact $idlist $p] >= 0} continue
4471 set fk [lindex $children($curview,$p) 0]
4472 if {[rowofcommit $fk] < $row} {
4473 set x [idcol $idlist $p $x]
4474 set idlist [linsert $idlist $x $p]
4477 if {[incr r] < $commitidx($curview)} {
4478 set p [lindex $displayorder $r]
4479 if {[lsearch -exact $idlist $p] < 0} {
4480 set fk [lindex $children($curview,$p) 0]
4481 if {$fk ne {} && [rowofcommit $fk] < $row} {
4482 set x [idcol $idlist $p $x]
4483 set idlist [linsert $idlist $x $p]
4489 if {$final && !$viewcomplete($curview) &&
4490 $row + $uparrowlen + $mingaplen + $downarrowlen
4491 >= $commitidx($curview)} {
4494 set l [llength $rowidlist]
4496 lappend rowidlist $idlist
4498 lappend rowfinal $final
4499 } elseif {$row < $l} {
4500 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4501 lset rowidlist $row $idlist
4504 lset rowfinal $row $final
4506 set pad [ntimes [expr {$row - $l}] {}]
4507 set rowidlist [concat $rowidlist $pad]
4508 lappend rowidlist $idlist
4509 set rowfinal [concat $rowfinal $pad]
4510 lappend rowfinal $final
4511 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4517 proc changedrow {row} {
4518 global displayorder iddrawn rowisopt need_redisplay
4520 set l [llength $rowisopt]
4522 lset rowisopt $row 0
4523 if {$row + 1 < $l} {
4524 lset rowisopt [expr {$row + 1}] 0
4525 if {$row + 2 < $l} {
4526 lset rowisopt [expr {$row + 2}] 0
4530 set id [lindex $displayorder $row]
4531 if {[info exists iddrawn($id)]} {
4532 set need_redisplay 1
4536 proc insert_pad {row col npad} {
4539 set pad [ntimes $npad {}]
4540 set idlist [lindex $rowidlist $row]
4541 set bef [lrange $idlist 0 [expr {$col - 1}]]
4542 set aft [lrange $idlist $col end]
4543 set i [lsearch -exact $aft {}]
4545 set aft [lreplace $aft $i $i]
4547 lset rowidlist $row [concat $bef $pad $aft]
4551 proc optimize_rows {row col endrow} {
4552 global rowidlist rowisopt displayorder curview children
4557 for {} {$row < $endrow} {incr row; set col 0} {
4558 if {[lindex $rowisopt $row]} continue
4560 set y0 [expr {$row - 1}]
4561 set ym [expr {$row - 2}]
4562 set idlist [lindex $rowidlist $row]
4563 set previdlist [lindex $rowidlist $y0]
4564 if {$idlist eq {} || $previdlist eq {}} continue
4566 set pprevidlist [lindex $rowidlist $ym]
4567 if {$pprevidlist eq {}} continue
4573 for {} {$col < [llength $idlist]} {incr col} {
4574 set id [lindex $idlist $col]
4575 if {[lindex $previdlist $col] eq $id} continue
4580 set x0 [lsearch -exact $previdlist $id]
4581 if {$x0 < 0} continue
4582 set z [expr {$x0 - $col}]
4586 set xm [lsearch -exact $pprevidlist $id]
4588 set z0 [expr {$xm - $x0}]
4592 # if row y0 is the first child of $id then it's not an arrow
4593 if {[lindex $children($curview,$id) 0] ne
4594 [lindex $displayorder $y0]} {
4598 if {!$isarrow && $id ne [lindex $displayorder $row] &&
4599 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4602 # Looking at lines from this row to the previous row,
4603 # make them go straight up if they end in an arrow on
4604 # the previous row; otherwise make them go straight up
4606 if {$z < -1 || ($z < 0 && $isarrow)} {
4607 # Line currently goes left too much;
4608 # insert pads in the previous row, then optimize it
4609 set npad [expr {-1 - $z + $isarrow}]
4610 insert_pad $y0 $x0 $npad
4612 optimize_rows $y0 $x0 $row
4614 set previdlist [lindex $rowidlist $y0]
4615 set x0 [lsearch -exact $previdlist $id]
4616 set z [expr {$x0 - $col}]
4618 set pprevidlist [lindex $rowidlist $ym]
4619 set xm [lsearch -exact $pprevidlist $id]
4620 set z0 [expr {$xm - $x0}]
4622 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4623 # Line currently goes right too much;
4624 # insert pads in this line
4625 set npad [expr {$z - 1 + $isarrow}]
4626 insert_pad $row $col $npad
4627 set idlist [lindex $rowidlist $row]
4629 set z [expr {$x0 - $col}]
4632 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4633 # this line links to its first child on row $row-2
4634 set id [lindex $displayorder $ym]
4635 set xc [lsearch -exact $pprevidlist $id]
4637 set z0 [expr {$xc - $x0}]
4640 # avoid lines jigging left then immediately right
4641 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4642 insert_pad $y0 $x0 1
4644 optimize_rows $y0 $x0 $row
4645 set previdlist [lindex $rowidlist $y0]
4649 # Find the first column that doesn't have a line going right
4650 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4651 set id [lindex $idlist $col]
4652 if {$id eq {}} break
4653 set x0 [lsearch -exact $previdlist $id]
4655 # check if this is the link to the first child
4656 set kid [lindex $displayorder $y0]
4657 if {[lindex $children($curview,$id) 0] eq $kid} {
4658 # it is, work out offset to child
4659 set x0 [lsearch -exact $previdlist $kid]
4662 if {$x0 <= $col} break
4664 # Insert a pad at that column as long as it has a line and
4665 # isn't the last column
4666 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4667 set idlist [linsert $idlist $col {}]
4668 lset rowidlist $row $idlist
4676 global canvx0 linespc
4677 return [expr {$canvx0 + $col * $linespc}]
4681 global canvy0 linespc
4682 return [expr {$canvy0 + $row * $linespc}]
4685 proc linewidth {id} {
4686 global thickerline lthickness
4689 if {[info exists thickerline] && $id eq $thickerline} {
4690 set wid [expr {2 * $lthickness}]
4695 proc rowranges {id} {
4696 global curview children uparrowlen downarrowlen
4699 set kids $children($curview,$id)
4705 foreach child $kids {
4706 if {![commitinview $child $curview]} break
4707 set row [rowofcommit $child]
4708 if {![info exists prev]} {
4709 lappend ret [expr {$row + 1}]
4711 if {$row <= $prevrow} {
4712 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4714 # see if the line extends the whole way from prevrow to row
4715 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4716 [lsearch -exact [lindex $rowidlist \
4717 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4718 # it doesn't, see where it ends
4719 set r [expr {$prevrow + $downarrowlen}]
4720 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4721 while {[incr r -1] > $prevrow &&
4722 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4724 while {[incr r] <= $row &&
4725 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4729 # see where it starts up again
4730 set r [expr {$row - $uparrowlen}]
4731 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4732 while {[incr r] < $row &&
4733 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4735 while {[incr r -1] >= $prevrow &&
4736 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4742 if {$child eq $id} {
4751 proc drawlineseg {id row endrow arrowlow} {
4752 global rowidlist displayorder iddrawn linesegs
4753 global canv colormap linespc curview maxlinelen parentlist
4755 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4756 set le [expr {$row + 1}]
4759 set c [lsearch -exact [lindex $rowidlist $le] $id]
4765 set x [lindex $displayorder $le]
4770 if {[info exists iddrawn($x)] || $le == $endrow} {
4771 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4787 if {[info exists linesegs($id)]} {
4788 set lines $linesegs($id)
4790 set r0 [lindex $li 0]
4792 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4802 set li [lindex $lines [expr {$i-1}]]
4803 set r1 [lindex $li 1]
4804 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4809 set x [lindex $cols [expr {$le - $row}]]
4810 set xp [lindex $cols [expr {$le - 1 - $row}]]
4811 set dir [expr {$xp - $x}]
4813 set ith [lindex $lines $i 2]
4814 set coords [$canv coords $ith]
4815 set ah [$canv itemcget $ith -arrow]
4816 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4817 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4818 if {$x2 ne {} && $x - $x2 == $dir} {
4819 set coords [lrange $coords 0 end-2]
4822 set coords [list [xc $le $x] [yc $le]]
4825 set itl [lindex $lines [expr {$i-1}] 2]
4826 set al [$canv itemcget $itl -arrow]
4827 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4828 } elseif {$arrowlow} {
4829 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4830 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4834 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4835 for {set y $le} {[incr y -1] > $row} {} {
4837 set xp [lindex $cols [expr {$y - 1 - $row}]]
4838 set ndir [expr {$xp - $x}]
4839 if {$dir != $ndir || $xp < 0} {
4840 lappend coords [xc $y $x] [yc $y]
4846 # join parent line to first child
4847 set ch [lindex $displayorder $row]
4848 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4850 puts "oops: drawlineseg: child $ch not on row $row"
4851 } elseif {$xc != $x} {
4852 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4853 set d [expr {int(0.5 * $linespc)}]
4856 set x2 [expr {$x1 - $d}]
4858 set x2 [expr {$x1 + $d}]
4861 set y1 [expr {$y2 + $d}]
4862 lappend coords $x1 $y1 $x2 $y2
4863 } elseif {$xc < $x - 1} {
4864 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4865 } elseif {$xc > $x + 1} {
4866 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4870 lappend coords [xc $row $x] [yc $row]
4872 set xn [xc $row $xp]
4874 lappend coords $xn $yn
4878 set t [$canv create line $coords -width [linewidth $id] \
4879 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4882 set lines [linsert $lines $i [list $row $le $t]]
4884 $canv coords $ith $coords
4885 if {$arrow ne $ah} {
4886 $canv itemconf $ith -arrow $arrow
4888 lset lines $i 0 $row
4891 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4892 set ndir [expr {$xo - $xp}]
4893 set clow [$canv coords $itl]
4894 if {$dir == $ndir} {
4895 set clow [lrange $clow 2 end]
4897 set coords [concat $coords $clow]
4899 lset lines [expr {$i-1}] 1 $le
4901 # coalesce two pieces
4903 set b [lindex $lines [expr {$i-1}] 0]
4904 set e [lindex $lines $i 1]
4905 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4907 $canv coords $itl $coords
4908 if {$arrow ne $al} {
4909 $canv itemconf $itl -arrow $arrow
4913 set linesegs($id) $lines
4917 proc drawparentlinks {id row} {
4918 global rowidlist canv colormap curview parentlist
4919 global idpos linespc
4921 set rowids [lindex $rowidlist $row]
4922 set col [lsearch -exact $rowids $id]
4923 if {$col < 0} return
4924 set olds [lindex $parentlist $row]
4925 set row2 [expr {$row + 1}]
4926 set x [xc $row $col]
4929 set d [expr {int(0.5 * $linespc)}]
4930 set ymid [expr {$y + $d}]
4931 set ids [lindex $rowidlist $row2]
4932 # rmx = right-most X coord used
4935 set i [lsearch -exact $ids $p]
4937 puts "oops, parent $p of $id not in list"
4940 set x2 [xc $row2 $i]
4944 set j [lsearch -exact $rowids $p]
4946 # drawlineseg will do this one for us
4950 # should handle duplicated parents here...
4951 set coords [list $x $y]
4953 # if attaching to a vertical segment, draw a smaller
4954 # slant for visual distinctness
4957 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4959 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4961 } elseif {$i < $col && $i < $j} {
4962 # segment slants towards us already
4963 lappend coords [xc $row $j] $y
4965 if {$i < $col - 1} {
4966 lappend coords [expr {$x2 + $linespc}] $y
4967 } elseif {$i > $col + 1} {
4968 lappend coords [expr {$x2 - $linespc}] $y
4970 lappend coords $x2 $y2
4973 lappend coords $x2 $y2
4975 set t [$canv create line $coords -width [linewidth $p] \
4976 -fill $colormap($p) -tags lines.$p]
4980 if {$rmx > [lindex $idpos($id) 1]} {
4981 lset idpos($id) 1 $rmx
4986 proc drawlines {id} {
4989 $canv itemconf lines.$id -width [linewidth $id]
4992 proc drawcmittext {id row col} {
4993 global linespc canv canv2 canv3 fgcolor curview
4994 global cmitlisted commitinfo rowidlist parentlist
4995 global rowtextx idpos idtags idheads idotherrefs
4996 global linehtag linentag linedtag selectedline
4997 global canvxmax boldrows boldnamerows fgcolor
4998 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5000 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5001 set listed $cmitlisted($curview,$id)
5002 if {$id eq $nullid} {
5004 } elseif {$id eq $nullid2} {
5006 } elseif {$id eq $mainheadid} {
5009 set ofill [lindex $circlecolors $listed]
5011 set x [xc $row $col]
5013 set orad [expr {$linespc / 3}]
5015 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5016 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5017 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5018 } elseif {$listed == 3} {
5019 # triangle pointing left for left-side commits
5020 set t [$canv create polygon \
5021 [expr {$x - $orad}] $y \
5022 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5023 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5024 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5026 # triangle pointing right for right-side commits
5027 set t [$canv create polygon \
5028 [expr {$x + $orad - 1}] $y \
5029 [expr {$x - $orad}] [expr {$y - $orad}] \
5030 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5031 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5033 set circleitem($row) $t
5035 $canv bind $t <1> {selcanvline {} %x %y}
5036 set rmx [llength [lindex $rowidlist $row]]
5037 set olds [lindex $parentlist $row]
5039 set nextids [lindex $rowidlist [expr {$row + 1}]]
5041 set i [lsearch -exact $nextids $p]
5047 set xt [xc $row $rmx]
5048 set rowtextx($row) $xt
5049 set idpos($id) [list $x $xt $y]
5050 if {[info exists idtags($id)] || [info exists idheads($id)]
5051 || [info exists idotherrefs($id)]} {
5052 set xt [drawtags $id $x $xt $y]
5054 set headline [lindex $commitinfo($id) 0]
5055 set name [lindex $commitinfo($id) 1]
5056 set date [lindex $commitinfo($id) 2]
5057 set date [formatdate $date]
5060 set isbold [ishighlighted $id]
5062 lappend boldrows $row
5063 set font mainfontbold
5065 lappend boldnamerows $row
5066 set nfont mainfontbold
5069 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
5070 -text $headline -font $font -tags text]
5071 $canv bind $linehtag($row) $ctxbut "rowmenu %X %Y $id"
5072 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5073 -text $name -font $nfont -tags text]
5074 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5075 -text $date -font mainfont -tags text]
5076 if {$selectedline == $row} {
5079 set xr [expr {$xt + [font measure $font $headline]}]
5080 if {$xr > $canvxmax} {
5086 proc drawcmitrow {row} {
5087 global displayorder rowidlist nrows_drawn
5088 global iddrawn markingmatches
5089 global commitinfo numcommits
5090 global filehighlight fhighlights findpattern nhighlights
5091 global hlview vhighlights
5092 global highlight_related rhighlights
5094 if {$row >= $numcommits} return
5096 set id [lindex $displayorder $row]
5097 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5098 askvhighlight $row $id
5100 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5101 askfilehighlight $row $id
5103 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5104 askfindhighlight $row $id
5106 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5107 askrelhighlight $row $id
5109 if {![info exists iddrawn($id)]} {
5110 set col [lsearch -exact [lindex $rowidlist $row] $id]
5112 puts "oops, row $row id $id not in list"
5115 if {![info exists commitinfo($id)]} {
5119 drawcmittext $id $row $col
5123 if {$markingmatches} {
5124 markrowmatches $row $id
5128 proc drawcommits {row {endrow {}}} {
5129 global numcommits iddrawn displayorder curview need_redisplay
5130 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5135 if {$endrow eq {}} {
5138 if {$endrow >= $numcommits} {
5139 set endrow [expr {$numcommits - 1}]
5142 set rl1 [expr {$row - $downarrowlen - 3}]
5146 set ro1 [expr {$row - 3}]
5150 set r2 [expr {$endrow + $uparrowlen + 3}]
5151 if {$r2 > $numcommits} {
5154 for {set r $rl1} {$r < $r2} {incr r} {
5155 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5159 set rl1 [expr {$r + 1}]
5165 optimize_rows $ro1 0 $r2
5166 if {$need_redisplay || $nrows_drawn > 2000} {
5171 # make the lines join to already-drawn rows either side
5172 set r [expr {$row - 1}]
5173 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5176 set er [expr {$endrow + 1}]
5177 if {$er >= $numcommits ||
5178 ![info exists iddrawn([lindex $displayorder $er])]} {
5181 for {} {$r <= $er} {incr r} {
5182 set id [lindex $displayorder $r]
5183 set wasdrawn [info exists iddrawn($id)]
5185 if {$r == $er} break
5186 set nextid [lindex $displayorder [expr {$r + 1}]]
5187 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5188 drawparentlinks $id $r
5190 set rowids [lindex $rowidlist $r]
5191 foreach lid $rowids {
5192 if {$lid eq {}} continue
5193 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5195 # see if this is the first child of any of its parents
5196 foreach p [lindex $parentlist $r] {
5197 if {[lsearch -exact $rowids $p] < 0} {
5198 # make this line extend up to the child
5199 set lineend($p) [drawlineseg $p $r $er 0]
5203 set lineend($lid) [drawlineseg $lid $r $er 1]
5209 proc undolayout {row} {
5210 global uparrowlen mingaplen downarrowlen
5211 global rowidlist rowisopt rowfinal need_redisplay
5213 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5217 if {[llength $rowidlist] > $r} {
5219 set rowidlist [lrange $rowidlist 0 $r]
5220 set rowfinal [lrange $rowfinal 0 $r]
5221 set rowisopt [lrange $rowisopt 0 $r]
5222 set need_redisplay 1
5227 proc drawvisible {} {
5228 global canv linespc curview vrowmod selectedline targetrow targetid
5229 global need_redisplay cscroll numcommits
5231 set fs [$canv yview]
5232 set ymax [lindex [$canv cget -scrollregion] 3]
5233 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5234 set f0 [lindex $fs 0]
5235 set f1 [lindex $fs 1]
5236 set y0 [expr {int($f0 * $ymax)}]
5237 set y1 [expr {int($f1 * $ymax)}]
5239 if {[info exists targetid]} {
5240 if {[commitinview $targetid $curview]} {
5241 set r [rowofcommit $targetid]
5242 if {$r != $targetrow} {
5243 # Fix up the scrollregion and change the scrolling position
5244 # now that our target row has moved.
5245 set diff [expr {($r - $targetrow) * $linespc}]
5248 set ymax [lindex [$canv cget -scrollregion] 3]
5251 set f0 [expr {$y0 / $ymax}]
5252 set f1 [expr {$y1 / $ymax}]
5253 allcanvs yview moveto $f0
5254 $cscroll set $f0 $f1
5255 set need_redisplay 1
5262 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5263 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5264 if {$endrow >= $vrowmod($curview)} {
5265 update_arcrows $curview
5267 if {$selectedline ne {} &&
5268 $row <= $selectedline && $selectedline <= $endrow} {
5269 set targetrow $selectedline
5270 } elseif {[info exists targetid]} {
5271 set targetrow [expr {int(($row + $endrow) / 2)}]
5273 if {[info exists targetrow]} {
5274 if {$targetrow >= $numcommits} {
5275 set targetrow [expr {$numcommits - 1}]
5277 set targetid [commitonrow $targetrow]
5279 drawcommits $row $endrow
5282 proc clear_display {} {
5283 global iddrawn linesegs need_redisplay nrows_drawn
5284 global vhighlights fhighlights nhighlights rhighlights
5285 global linehtag linentag linedtag boldrows boldnamerows
5288 catch {unset iddrawn}
5289 catch {unset linesegs}
5290 catch {unset linehtag}
5291 catch {unset linentag}
5292 catch {unset linedtag}
5295 catch {unset vhighlights}
5296 catch {unset fhighlights}
5297 catch {unset nhighlights}
5298 catch {unset rhighlights}
5299 set need_redisplay 0
5303 proc findcrossings {id} {
5304 global rowidlist parentlist numcommits displayorder
5308 foreach {s e} [rowranges $id] {
5309 if {$e >= $numcommits} {
5310 set e [expr {$numcommits - 1}]
5312 if {$e <= $s} continue
5313 for {set row $e} {[incr row -1] >= $s} {} {
5314 set x [lsearch -exact [lindex $rowidlist $row] $id]
5316 set olds [lindex $parentlist $row]
5317 set kid [lindex $displayorder $row]
5318 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5319 if {$kidx < 0} continue
5320 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5322 set px [lsearch -exact $nextrow $p]
5323 if {$px < 0} continue
5324 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5325 if {[lsearch -exact $ccross $p] >= 0} continue
5326 if {$x == $px + ($kidx < $px? -1: 1)} {
5328 } elseif {[lsearch -exact $cross $p] < 0} {
5335 return [concat $ccross {{}} $cross]
5338 proc assigncolor {id} {
5339 global colormap colors nextcolor
5340 global parents children children curview
5342 if {[info exists colormap($id)]} return
5343 set ncolors [llength $colors]
5344 if {[info exists children($curview,$id)]} {
5345 set kids $children($curview,$id)
5349 if {[llength $kids] == 1} {
5350 set child [lindex $kids 0]
5351 if {[info exists colormap($child)]
5352 && [llength $parents($curview,$child)] == 1} {
5353 set colormap($id) $colormap($child)
5359 foreach x [findcrossings $id] {
5361 # delimiter between corner crossings and other crossings
5362 if {[llength $badcolors] >= $ncolors - 1} break
5363 set origbad $badcolors
5365 if {[info exists colormap($x)]
5366 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5367 lappend badcolors $colormap($x)
5370 if {[llength $badcolors] >= $ncolors} {
5371 set badcolors $origbad
5373 set origbad $badcolors
5374 if {[llength $badcolors] < $ncolors - 1} {
5375 foreach child $kids {
5376 if {[info exists colormap($child)]
5377 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5378 lappend badcolors $colormap($child)
5380 foreach p $parents($curview,$child) {
5381 if {[info exists colormap($p)]
5382 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5383 lappend badcolors $colormap($p)
5387 if {[llength $badcolors] >= $ncolors} {
5388 set badcolors $origbad
5391 for {set i 0} {$i <= $ncolors} {incr i} {
5392 set c [lindex $colors $nextcolor]
5393 if {[incr nextcolor] >= $ncolors} {
5396 if {[lsearch -exact $badcolors $c]} break
5398 set colormap($id) $c
5401 proc bindline {t id} {
5404 $canv bind $t <Enter> "lineenter %x %y $id"
5405 $canv bind $t <Motion> "linemotion %x %y $id"
5406 $canv bind $t <Leave> "lineleave $id"
5407 $canv bind $t <Button-1> "lineclick %x %y $id 1"
5410 proc drawtags {id x xt y1} {
5411 global idtags idheads idotherrefs mainhead
5412 global linespc lthickness
5413 global canv rowtextx curview fgcolor bgcolor ctxbut
5418 if {[info exists idtags($id)]} {
5419 set marks $idtags($id)
5420 set ntags [llength $marks]
5422 if {[info exists idheads($id)]} {
5423 set marks [concat $marks $idheads($id)]
5424 set nheads [llength $idheads($id)]
5426 if {[info exists idotherrefs($id)]} {
5427 set marks [concat $marks $idotherrefs($id)]
5433 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5434 set yt [expr {$y1 - 0.5 * $linespc}]
5435 set yb [expr {$yt + $linespc - 1}]
5439 foreach tag $marks {
5441 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5442 set wid [font measure mainfontbold $tag]
5444 set wid [font measure mainfont $tag]
5448 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5450 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5451 -width $lthickness -fill black -tags tag.$id]
5453 foreach tag $marks x $xvals wid $wvals {
5454 set xl [expr {$x + $delta}]
5455 set xr [expr {$x + $delta + $wid + $lthickness}]
5457 if {[incr ntags -1] >= 0} {
5459 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5460 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5461 -width 1 -outline black -fill yellow -tags tag.$id]
5462 $canv bind $t <1> [list showtag $tag 1]
5463 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5465 # draw a head or other ref
5466 if {[incr nheads -1] >= 0} {
5468 if {$tag eq $mainhead} {
5469 set font mainfontbold
5474 set xl [expr {$xl - $delta/2}]
5475 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5476 -width 1 -outline black -fill $col -tags tag.$id
5477 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5478 set rwid [font measure mainfont $remoteprefix]
5479 set xi [expr {$x + 1}]
5480 set yti [expr {$yt + 1}]
5481 set xri [expr {$x + $rwid}]
5482 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5483 -width 0 -fill "#ffddaa" -tags tag.$id
5486 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5487 -font $font -tags [list tag.$id text]]
5489 $canv bind $t <1> [list showtag $tag 1]
5490 } elseif {$nheads >= 0} {
5491 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
5497 proc xcoord {i level ln} {
5498 global canvx0 xspc1 xspc2
5500 set x [expr {$canvx0 + $i * $xspc1($ln)}]
5501 if {$i > 0 && $i == $level} {
5502 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5503 } elseif {$i > $level} {
5504 set x [expr {$x + $xspc2 - $xspc1($ln)}]
5509 proc show_status {msg} {
5513 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5514 -tags text -fill $fgcolor
5517 # Don't change the text pane cursor if it is currently the hand cursor,
5518 # showing that we are over a sha1 ID link.
5519 proc settextcursor {c} {
5520 global ctext curtextcursor
5522 if {[$ctext cget -cursor] == $curtextcursor} {
5523 $ctext config -cursor $c
5525 set curtextcursor $c
5528 proc nowbusy {what {name {}}} {
5529 global isbusy busyname statusw
5531 if {[array names isbusy] eq {}} {
5532 . config -cursor watch
5536 set busyname($what) $name
5538 $statusw conf -text $name
5542 proc notbusy {what} {
5543 global isbusy maincursor textcursor busyname statusw
5547 if {$busyname($what) ne {} &&
5548 [$statusw cget -text] eq $busyname($what)} {
5549 $statusw conf -text {}
5552 if {[array names isbusy] eq {}} {
5553 . config -cursor $maincursor
5554 settextcursor $textcursor
5558 proc findmatches {f} {
5559 global findtype findstring
5560 if {$findtype == [mc "Regexp"]} {
5561 set matches [regexp -indices -all -inline $findstring $f]
5564 if {$findtype == [mc "IgnCase"]} {
5565 set f [string tolower $f]
5566 set fs [string tolower $fs]
5570 set l [string length $fs]
5571 while {[set j [string first $fs $f $i]] >= 0} {
5572 lappend matches [list $j [expr {$j+$l-1}]]
5573 set i [expr {$j + $l}]
5579 proc dofind {{dirn 1} {wrap 1}} {
5580 global findstring findstartline findcurline selectedline numcommits
5581 global gdttype filehighlight fh_serial find_dirn findallowwrap
5583 if {[info exists find_dirn]} {
5584 if {$find_dirn == $dirn} return
5588 if {$findstring eq {} || $numcommits == 0} return
5589 if {$selectedline eq {}} {
5590 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5592 set findstartline $selectedline
5594 set findcurline $findstartline
5595 nowbusy finding [mc "Searching"]
5596 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5597 after cancel do_file_hl $fh_serial
5598 do_file_hl $fh_serial
5601 set findallowwrap $wrap
5605 proc stopfinding {} {
5606 global find_dirn findcurline fprogcoord
5608 if {[info exists find_dirn]} {
5618 global commitdata commitinfo numcommits findpattern findloc
5619 global findstartline findcurline findallowwrap
5620 global find_dirn gdttype fhighlights fprogcoord
5621 global curview varcorder vrownum varccommits vrowmod
5623 if {![info exists find_dirn]} {
5626 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5629 if {$find_dirn > 0} {
5631 if {$l >= $numcommits} {
5634 if {$l <= $findstartline} {
5635 set lim [expr {$findstartline + 1}]
5638 set moretodo $findallowwrap
5645 if {$l >= $findstartline} {
5646 set lim [expr {$findstartline - 1}]
5649 set moretodo $findallowwrap
5652 set n [expr {($lim - $l) * $find_dirn}]
5657 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5658 update_arcrows $curview
5662 set ai [bsearch $vrownum($curview) $l]
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]}]
5667 if {$gdttype eq [mc "containing:"]} {
5668 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5669 if {$l < $arow || $l >= $arowend} {
5671 set a [lindex $varcorder($curview) $ai]
5672 set arow [lindex $vrownum($curview) $ai]
5673 set ids [lindex $varccommits($curview,$a)]
5674 set arowend [expr {$arow + [llength $ids]}]
5676 set id [lindex $ids [expr {$l - $arow}]]
5677 # shouldn't happen unless git log doesn't give all the commits...
5678 if {![info exists commitdata($id)] ||
5679 ![doesmatch $commitdata($id)]} {
5682 if {![info exists commitinfo($id)]} {
5685 set info $commitinfo($id)
5686 foreach f $info ty $fldtypes {
5687 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5696 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5697 if {$l < $arow || $l >= $arowend} {
5699 set a [lindex $varcorder($curview) $ai]
5700 set arow [lindex $vrownum($curview) $ai]
5701 set ids [lindex $varccommits($curview,$a)]
5702 set arowend [expr {$arow + [llength $ids]}]
5704 set id [lindex $ids [expr {$l - $arow}]]
5705 if {![info exists fhighlights($id)]} {
5706 # this sets fhighlights($id) to -1
5707 askfilehighlight $l $id
5709 if {$fhighlights($id) > 0} {
5713 if {$fhighlights($id) < 0} {
5716 set findcurline [expr {$l - $find_dirn}]
5721 if {$found || ($domore && !$moretodo)} {
5737 set findcurline [expr {$l - $find_dirn}]
5739 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5743 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5748 proc findselectline {l} {
5749 global findloc commentend ctext findcurline markingmatches gdttype
5751 set markingmatches 1
5754 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5755 # highlight the matches in the comments
5756 set f [$ctext get 1.0 $commentend]
5757 set matches [findmatches $f]
5758 foreach match $matches {
5759 set start [lindex $match 0]
5760 set end [expr {[lindex $match 1] + 1}]
5761 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5767 # mark the bits of a headline or author that match a find string
5768 proc markmatches {canv l str tag matches font row} {
5771 set bbox [$canv bbox $tag]
5772 set x0 [lindex $bbox 0]
5773 set y0 [lindex $bbox 1]
5774 set y1 [lindex $bbox 3]
5775 foreach match $matches {
5776 set start [lindex $match 0]
5777 set end [lindex $match 1]
5778 if {$start > $end} continue
5779 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5780 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5781 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5782 [expr {$x0+$xlen+2}] $y1 \
5783 -outline {} -tags [list match$l matches] -fill yellow]
5785 if {$row == $selectedline} {
5786 $canv raise $t secsel
5791 proc unmarkmatches {} {
5792 global markingmatches
5794 allcanvs delete matches
5795 set markingmatches 0
5799 proc selcanvline {w x y} {
5800 global canv canvy0 ctext linespc
5802 set ymax [lindex [$canv cget -scrollregion] 3]
5803 if {$ymax == {}} return
5804 set yfrac [lindex [$canv yview] 0]
5805 set y [expr {$y + $yfrac * $ymax}]
5806 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5811 set xmax [lindex [$canv cget -scrollregion] 2]
5812 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5813 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5819 proc commit_descriptor {p} {
5821 if {![info exists commitinfo($p)]} {
5825 if {[llength $commitinfo($p)] > 1} {
5826 set l [lindex $commitinfo($p) 0]
5831 # append some text to the ctext widget, and make any SHA1 ID
5832 # that we know about be a clickable link.
5833 proc appendwithlinks {text tags} {
5834 global ctext linknum curview
5836 set start [$ctext index "end - 1c"]
5837 $ctext insert end $text $tags
5838 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
5842 set linkid [string range $text $s $e]
5844 $ctext tag delete link$linknum
5845 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5846 setlink $linkid link$linknum
5851 proc setlink {id lk} {
5852 global curview ctext pendinglinks
5855 if {[string length $id] < 40} {
5856 set matches [longid $id]
5857 if {[llength $matches] > 0} {
5858 if {[llength $matches] > 1} return
5860 set id [lindex $matches 0]
5863 set known [commitinview $id $curview]
5866 $ctext tag conf $lk -foreground blue -underline 1
5867 $ctext tag bind $lk <1> [list selbyid $id]
5868 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5869 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5871 lappend pendinglinks($id) $lk
5872 interestedin $id {makelink %P}
5876 proc makelink {id} {
5879 if {![info exists pendinglinks($id)]} return
5880 foreach lk $pendinglinks($id) {
5883 unset pendinglinks($id)
5886 proc linkcursor {w inc} {
5887 global linkentercount curtextcursor
5889 if {[incr linkentercount $inc] > 0} {
5890 $w configure -cursor hand2
5892 $w configure -cursor $curtextcursor
5893 if {$linkentercount < 0} {
5894 set linkentercount 0
5899 proc viewnextline {dir} {
5903 set ymax [lindex [$canv cget -scrollregion] 3]
5904 set wnow [$canv yview]
5905 set wtop [expr {[lindex $wnow 0] * $ymax}]
5906 set newtop [expr {$wtop + $dir * $linespc}]
5909 } elseif {$newtop > $ymax} {
5912 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5915 # add a list of tag or branch names at position pos
5916 # returns the number of names inserted
5917 proc appendrefs {pos ids var} {
5918 global ctext linknum curview $var maxrefs
5920 if {[catch {$ctext index $pos}]} {
5923 $ctext conf -state normal
5924 $ctext delete $pos "$pos lineend"
5927 foreach tag [set $var\($id\)] {
5928 lappend tags [list $tag $id]
5931 if {[llength $tags] > $maxrefs} {
5932 $ctext insert $pos "many ([llength $tags])"
5934 set tags [lsort -index 0 -decreasing $tags]
5937 set id [lindex $ti 1]
5940 $ctext tag delete $lk
5941 $ctext insert $pos $sep
5942 $ctext insert $pos [lindex $ti 0] $lk
5947 $ctext conf -state disabled
5948 return [llength $tags]
5951 # called when we have finished computing the nearby tags
5952 proc dispneartags {delay} {
5953 global selectedline currentid showneartags tagphase
5955 if {$selectedline eq {} || !$showneartags} return
5956 after cancel dispnexttag
5958 after 200 dispnexttag
5961 after idle dispnexttag
5966 proc dispnexttag {} {
5967 global selectedline currentid showneartags tagphase ctext
5969 if {$selectedline eq {} || !$showneartags} return
5970 switch -- $tagphase {
5972 set dtags [desctags $currentid]
5974 appendrefs precedes $dtags idtags
5978 set atags [anctags $currentid]
5980 appendrefs follows $atags idtags
5984 set dheads [descheads $currentid]
5985 if {$dheads ne {}} {
5986 if {[appendrefs branch $dheads idheads] > 1
5987 && [$ctext get "branch -3c"] eq "h"} {
5988 # turn "Branch" into "Branches"
5989 $ctext conf -state normal
5990 $ctext insert "branch -2c" "es"
5991 $ctext conf -state disabled
5996 if {[incr tagphase] <= 2} {
5997 after idle dispnexttag
6001 proc make_secsel {l} {
6002 global linehtag linentag linedtag canv canv2 canv3
6004 if {![info exists linehtag($l)]} return
6006 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
6007 -tags secsel -fill [$canv cget -selectbackground]]
6009 $canv2 delete secsel
6010 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
6011 -tags secsel -fill [$canv2 cget -selectbackground]]
6013 $canv3 delete secsel
6014 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
6015 -tags secsel -fill [$canv3 cget -selectbackground]]
6019 proc selectline {l isnew} {
6020 global canv ctext commitinfo selectedline
6021 global canvy0 linespc parents children curview
6022 global currentid sha1entry
6023 global commentend idtags linknum
6024 global mergemax numcommits pending_select
6025 global cmitmode showneartags allcommits
6026 global targetrow targetid lastscrollrows
6029 catch {unset pending_select}
6034 if {$l < 0 || $l >= $numcommits} return
6035 set id [commitonrow $l]
6040 if {$lastscrollrows < $numcommits} {
6044 set y [expr {$canvy0 + $l * $linespc}]
6045 set ymax [lindex [$canv cget -scrollregion] 3]
6046 set ytop [expr {$y - $linespc - 1}]
6047 set ybot [expr {$y + $linespc + 1}]
6048 set wnow [$canv yview]
6049 set wtop [expr {[lindex $wnow 0] * $ymax}]
6050 set wbot [expr {[lindex $wnow 1] * $ymax}]
6051 set wh [expr {$wbot - $wtop}]
6053 if {$ytop < $wtop} {
6054 if {$ybot < $wtop} {
6055 set newtop [expr {$y - $wh / 2.0}]
6058 if {$newtop > $wtop - $linespc} {
6059 set newtop [expr {$wtop - $linespc}]
6062 } elseif {$ybot > $wbot} {
6063 if {$ytop > $wbot} {
6064 set newtop [expr {$y - $wh / 2.0}]
6066 set newtop [expr {$ybot - $wh}]
6067 if {$newtop < $wtop + $linespc} {
6068 set newtop [expr {$wtop + $linespc}]
6072 if {$newtop != $wtop} {
6076 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6083 addtohistory [list selbyid $id]
6086 $sha1entry delete 0 end
6087 $sha1entry insert 0 $id
6089 $sha1entry selection from 0
6090 $sha1entry selection to end
6094 $ctext conf -state normal
6097 if {![info exists commitinfo($id)]} {
6100 set info $commitinfo($id)
6101 set date [formatdate [lindex $info 2]]
6102 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6103 set date [formatdate [lindex $info 4]]
6104 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6105 if {[info exists idtags($id)]} {
6106 $ctext insert end [mc "Tags:"]
6107 foreach tag $idtags($id) {
6108 $ctext insert end " $tag"
6110 $ctext insert end "\n"
6114 set olds $parents($curview,$id)
6115 if {[llength $olds] > 1} {
6118 if {$np >= $mergemax} {
6123 $ctext insert end "[mc "Parent"]: " $tag
6124 appendwithlinks [commit_descriptor $p] {}
6129 append headers "[mc "Parent"]: [commit_descriptor $p]"
6133 foreach c $children($curview,$id) {
6134 append headers "[mc "Child"]: [commit_descriptor $c]"
6137 # make anything that looks like a SHA1 ID be a clickable link
6138 appendwithlinks $headers {}
6139 if {$showneartags} {
6140 if {![info exists allcommits]} {
6143 $ctext insert end "[mc "Branch"]: "
6144 $ctext mark set branch "end -1c"
6145 $ctext mark gravity branch left
6146 $ctext insert end "\n[mc "Follows"]: "
6147 $ctext mark set follows "end -1c"
6148 $ctext mark gravity follows left
6149 $ctext insert end "\n[mc "Precedes"]: "
6150 $ctext mark set precedes "end -1c"
6151 $ctext mark gravity precedes left
6152 $ctext insert end "\n"
6155 $ctext insert end "\n"
6156 set comment [lindex $info 5]
6157 if {[string first "\r" $comment] >= 0} {
6158 set comment [string map {"\r" "\n "} $comment]
6160 appendwithlinks $comment {comment}
6162 $ctext tag remove found 1.0 end
6163 $ctext conf -state disabled
6164 set commentend [$ctext index "end - 1c"]
6166 init_flist [mc "Comments"]
6167 if {$cmitmode eq "tree"} {
6169 } elseif {[llength $olds] <= 1} {
6176 proc selfirstline {} {
6181 proc sellastline {} {
6184 set l [expr {$numcommits - 1}]
6188 proc selnextline {dir} {
6191 if {$selectedline eq {}} return
6192 set l [expr {$selectedline + $dir}]
6197 proc selnextpage {dir} {
6198 global canv linespc selectedline numcommits
6200 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6204 allcanvs yview scroll [expr {$dir * $lpp}] units
6206 if {$selectedline eq {}} return
6207 set l [expr {$selectedline + $dir * $lpp}]
6210 } elseif {$l >= $numcommits} {
6211 set l [expr $numcommits - 1]
6217 proc unselectline {} {
6218 global selectedline currentid
6221 catch {unset currentid}
6222 allcanvs delete secsel
6226 proc reselectline {} {
6229 if {$selectedline ne {}} {
6230 selectline $selectedline 0
6234 proc addtohistory {cmd} {
6235 global history historyindex curview
6237 set elt [list $curview $cmd]
6238 if {$historyindex > 0
6239 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6243 if {$historyindex < [llength $history]} {
6244 set history [lreplace $history $historyindex end $elt]
6246 lappend history $elt
6249 if {$historyindex > 1} {
6250 .tf.bar.leftbut conf -state normal
6252 .tf.bar.leftbut conf -state disabled
6254 .tf.bar.rightbut conf -state disabled
6260 set view [lindex $elt 0]
6261 set cmd [lindex $elt 1]
6262 if {$curview != $view} {
6269 global history historyindex
6272 if {$historyindex > 1} {
6273 incr historyindex -1
6274 godo [lindex $history [expr {$historyindex - 1}]]
6275 .tf.bar.rightbut conf -state normal
6277 if {$historyindex <= 1} {
6278 .tf.bar.leftbut conf -state disabled
6283 global history historyindex
6286 if {$historyindex < [llength $history]} {
6287 set cmd [lindex $history $historyindex]
6290 .tf.bar.leftbut conf -state normal
6292 if {$historyindex >= [llength $history]} {
6293 .tf.bar.rightbut conf -state disabled
6298 global treefilelist treeidlist diffids diffmergeid treepending
6299 global nullid nullid2
6302 catch {unset diffmergeid}
6303 if {![info exists treefilelist($id)]} {
6304 if {![info exists treepending]} {
6305 if {$id eq $nullid} {
6306 set cmd [list | git ls-files]
6307 } elseif {$id eq $nullid2} {
6308 set cmd [list | git ls-files --stage -t]
6310 set cmd [list | git ls-tree -r $id]
6312 if {[catch {set gtf [open $cmd r]}]} {
6316 set treefilelist($id) {}
6317 set treeidlist($id) {}
6318 fconfigure $gtf -blocking 0 -encoding binary
6319 filerun $gtf [list gettreeline $gtf $id]
6326 proc gettreeline {gtf id} {
6327 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6330 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6331 if {$diffids eq $nullid} {
6334 set i [string first "\t" $line]
6335 if {$i < 0} continue
6336 set fname [string range $line [expr {$i+1}] end]
6337 set line [string range $line 0 [expr {$i-1}]]
6338 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6339 set sha1 [lindex $line 2]
6340 lappend treeidlist($id) $sha1
6342 if {[string index $fname 0] eq "\""} {
6343 set fname [lindex $fname 0]
6345 set fname [encoding convertfrom $fname]
6346 lappend treefilelist($id) $fname
6349 return [expr {$nl >= 1000? 2: 1}]
6353 if {$cmitmode ne "tree"} {
6354 if {![info exists diffmergeid]} {
6355 gettreediffs $diffids
6357 } elseif {$id ne $diffids} {
6366 global treefilelist treeidlist diffids nullid nullid2
6367 global ctext commentend
6369 set i [lsearch -exact $treefilelist($diffids) $f]
6371 puts "oops, $f not in list for id $diffids"
6374 if {$diffids eq $nullid} {
6375 if {[catch {set bf [open $f r]} err]} {
6376 puts "oops, can't read $f: $err"
6380 set blob [lindex $treeidlist($diffids) $i]
6381 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6382 puts "oops, error reading blob $blob: $err"
6386 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6387 filerun $bf [list getblobline $bf $diffids]
6388 $ctext config -state normal
6389 clear_ctext $commentend
6390 $ctext insert end "\n"
6391 $ctext insert end "$f\n" filesep
6392 $ctext config -state disabled
6393 $ctext yview $commentend
6397 proc getblobline {bf id} {
6398 global diffids cmitmode ctext
6400 if {$id ne $diffids || $cmitmode ne "tree"} {
6404 $ctext config -state normal
6406 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6407 $ctext insert end "$line\n"
6410 # delete last newline
6411 $ctext delete "end - 2c" "end - 1c"
6415 $ctext config -state disabled
6416 return [expr {$nl >= 1000? 2: 1}]
6419 proc mergediff {id} {
6420 global diffmergeid mdifffd
6425 global limitdiffs vfilelimit curview
6429 # this doesn't seem to actually affect anything...
6430 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
6431 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6432 set cmd [concat $cmd -- $vfilelimit($curview)]
6434 if {[catch {set mdf [open $cmd r]} err]} {
6435 error_popup "[mc "Error getting merge diffs:"] $err"
6438 fconfigure $mdf -blocking 0 -encoding binary
6439 set mdifffd($id) $mdf
6440 set np [llength $parents($curview,$id)]
6441 set diffencoding [get_path_encoding {}]
6443 filerun $mdf [list getmergediffline $mdf $id $np]
6446 proc getmergediffline {mdf id np} {
6447 global diffmergeid ctext cflist mergemax
6448 global difffilestart mdifffd
6451 $ctext conf -state normal
6453 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
6454 if {![info exists diffmergeid] || $id != $diffmergeid
6455 || $mdf != $mdifffd($id)} {
6459 if {[regexp {^diff --cc (.*)} $line match fname]} {
6460 # start of a new file
6461 set fname [encoding convertfrom $fname]
6462 $ctext insert end "\n"
6463 set here [$ctext index "end - 1c"]
6464 lappend difffilestart $here
6465 add_flist [list $fname]
6466 set diffencoding [get_path_encoding $fname]
6467 set l [expr {(78 - [string length $fname]) / 2}]
6468 set pad [string range "----------------------------------------" 1 $l]
6469 $ctext insert end "$pad $fname $pad\n" filesep
6470 } elseif {[regexp {^@@} $line]} {
6471 set line [encoding convertfrom $diffencoding $line]
6472 $ctext insert end "$line\n" hunksep
6473 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
6476 set line [encoding convertfrom $diffencoding $line]
6477 # parse the prefix - one ' ', '-' or '+' for each parent
6482 for {set j 0} {$j < $np} {incr j} {
6483 set c [string range $line $j $j]
6486 } elseif {$c == "-"} {
6488 } elseif {$c == "+"} {
6497 if {!$isbad && $minuses ne {} && $pluses eq {}} {
6498 # line doesn't appear in result, parents in $minuses have the line
6499 set num [lindex $minuses 0]
6500 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
6501 # line appears in result, parents in $pluses don't have the line
6502 lappend tags mresult
6503 set num [lindex $spaces 0]
6506 if {$num >= $mergemax} {
6511 $ctext insert end "$line\n" $tags
6514 $ctext conf -state disabled
6519 return [expr {$nr >= 1000? 2: 1}]
6522 proc startdiff {ids} {
6523 global treediffs diffids treepending diffmergeid nullid nullid2
6527 catch {unset diffmergeid}
6528 if {![info exists treediffs($ids)] ||
6529 [lsearch -exact $ids $nullid] >= 0 ||
6530 [lsearch -exact $ids $nullid2] >= 0} {
6531 if {![info exists treepending]} {
6539 proc path_filter {filter name} {
6541 set l [string length $p]
6542 if {[string index $p end] eq "/"} {
6543 if {[string compare -length $l $p $name] == 0} {
6547 if {[string compare -length $l $p $name] == 0 &&
6548 ([string length $name] == $l ||
6549 [string index $name $l] eq "/")} {
6557 proc addtocflist {ids} {
6560 add_flist $treediffs($ids)
6564 proc diffcmd {ids flags} {
6565 global nullid nullid2
6567 set i [lsearch -exact $ids $nullid]
6568 set j [lsearch -exact $ids $nullid2]
6570 if {[llength $ids] > 1 && $j < 0} {
6571 # comparing working directory with some specific revision
6572 set cmd [concat | git diff-index $flags]
6574 lappend cmd -R [lindex $ids 1]
6576 lappend cmd [lindex $ids 0]
6579 # comparing working directory with index
6580 set cmd [concat | git diff-files $flags]
6585 } elseif {$j >= 0} {
6586 set cmd [concat | git diff-index --cached $flags]
6587 if {[llength $ids] > 1} {
6588 # comparing index with specific revision
6590 lappend cmd -R [lindex $ids 1]
6592 lappend cmd [lindex $ids 0]
6595 # comparing index with HEAD
6599 set cmd [concat | git diff-tree -r $flags $ids]
6604 proc gettreediffs {ids} {
6605 global treediff treepending
6607 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6609 set treepending $ids
6611 fconfigure $gdtf -blocking 0 -encoding binary
6612 filerun $gdtf [list gettreediffline $gdtf $ids]
6615 proc gettreediffline {gdtf ids} {
6616 global treediff treediffs treepending diffids diffmergeid
6617 global cmitmode vfilelimit curview limitdiffs perfile_attrs
6622 if {$perfile_attrs} {
6623 # cache_gitattr is slow, and even slower on win32 where we
6624 # have to invoke it for only about 30 paths at a time
6626 if {[tk windowingsystem] == "win32"} {
6630 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
6631 set i [string first "\t" $line]
6633 set file [string range $line [expr {$i+1}] end]
6634 if {[string index $file 0] eq "\""} {
6635 set file [lindex $file 0]
6637 set file [encoding convertfrom $file]
6638 lappend treediff $file
6639 lappend sublist $file
6642 if {$perfile_attrs} {
6643 cache_gitattr encoding $sublist
6646 return [expr {$nr >= $max? 2: 1}]
6649 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6651 foreach f $treediff {
6652 if {[path_filter $vfilelimit($curview) $f]} {
6656 set treediffs($ids) $flist
6658 set treediffs($ids) $treediff
6661 if {$cmitmode eq "tree"} {
6663 } elseif {$ids != $diffids} {
6664 if {![info exists diffmergeid]} {
6665 gettreediffs $diffids
6673 # empty string or positive integer
6674 proc diffcontextvalidate {v} {
6675 return [regexp {^(|[1-9][0-9]*)$} $v]
6678 proc diffcontextchange {n1 n2 op} {
6679 global diffcontextstring diffcontext
6681 if {[string is integer -strict $diffcontextstring]} {
6682 if {$diffcontextstring > 0} {
6683 set diffcontext $diffcontextstring
6689 proc changeignorespace {} {
6693 proc getblobdiffs {ids} {
6694 global blobdifffd diffids env
6695 global diffinhdr treediffs
6698 global limitdiffs vfilelimit curview
6701 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6705 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6706 set cmd [concat $cmd -- $vfilelimit($curview)]
6708 if {[catch {set bdf [open $cmd r]} err]} {
6709 puts "error getting diffs: $err"
6713 set diffencoding [get_path_encoding {}]
6714 fconfigure $bdf -blocking 0 -encoding binary
6715 set blobdifffd($ids) $bdf
6716 filerun $bdf [list getblobdiffline $bdf $diffids]
6719 proc setinlist {var i val} {
6722 while {[llength [set $var]] < $i} {
6725 if {[llength [set $var]] == $i} {
6732 proc makediffhdr {fname ids} {
6733 global ctext curdiffstart treediffs
6735 set i [lsearch -exact $treediffs($ids) $fname]
6737 setinlist difffilestart $i $curdiffstart
6739 set l [expr {(78 - [string length $fname]) / 2}]
6740 set pad [string range "----------------------------------------" 1 $l]
6741 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6744 proc getblobdiffline {bdf ids} {
6745 global diffids blobdifffd ctext curdiffstart
6746 global diffnexthead diffnextnote difffilestart
6747 global diffinhdr treediffs
6751 $ctext conf -state normal
6752 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6753 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6757 if {![string compare -length 11 "diff --git " $line]} {
6758 # trim off "diff --git "
6759 set line [string range $line 11 end]
6761 # start of a new file
6762 $ctext insert end "\n"
6763 set curdiffstart [$ctext index "end - 1c"]
6764 $ctext insert end "\n" filesep
6765 # If the name hasn't changed the length will be odd,
6766 # the middle char will be a space, and the two bits either
6767 # side will be a/name and b/name, or "a/name" and "b/name".
6768 # If the name has changed we'll get "rename from" and
6769 # "rename to" or "copy from" and "copy to" lines following this,
6770 # and we'll use them to get the filenames.
6771 # This complexity is necessary because spaces in the filename(s)
6772 # don't get escaped.
6773 set l [string length $line]
6774 set i [expr {$l / 2}]
6775 if {!(($l & 1) && [string index $line $i] eq " " &&
6776 [string range $line 2 [expr {$i - 1}]] eq \
6777 [string range $line [expr {$i + 3}] end])} {
6780 # unescape if quoted and chop off the a/ from the front
6781 if {[string index $line 0] eq "\""} {
6782 set fname [string range [lindex $line 0] 2 end]
6784 set fname [string range $line 2 [expr {$i - 1}]]
6786 set fname [encoding convertfrom $fname]
6787 set diffencoding [get_path_encoding $fname]
6788 makediffhdr $fname $ids
6790 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6791 $line match f1l f1c f2l f2c rest]} {
6792 set line [encoding convertfrom $diffencoding $line]
6793 $ctext insert end "$line\n" hunksep
6796 } elseif {$diffinhdr} {
6797 if {![string compare -length 12 "rename from " $line]} {
6798 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6799 if {[string index $fname 0] eq "\""} {
6800 set fname [lindex $fname 0]
6802 set fname [encoding convertfrom $fname]
6803 set i [lsearch -exact $treediffs($ids) $fname]
6805 setinlist difffilestart $i $curdiffstart
6807 } elseif {![string compare -length 10 $line "rename to "] ||
6808 ![string compare -length 8 $line "copy to "]} {
6809 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6810 if {[string index $fname 0] eq "\""} {
6811 set fname [lindex $fname 0]
6813 set fname [encoding convertfrom $fname]
6814 set diffencoding [get_path_encoding $fname]
6815 makediffhdr $fname $ids
6816 } elseif {[string compare -length 3 $line "---"] == 0} {
6819 } elseif {[string compare -length 3 $line "+++"] == 0} {
6823 $ctext insert end "$line\n" filesep
6826 set line [encoding convertfrom $diffencoding $line]
6827 set x [string range $line 0 0]
6828 if {$x == "-" || $x == "+"} {
6829 set tag [expr {$x == "+"}]
6830 $ctext insert end "$line\n" d$tag
6831 } elseif {$x == " "} {
6832 $ctext insert end "$line\n"
6834 # "\ No newline at end of file",
6835 # or something else we don't recognize
6836 $ctext insert end "$line\n" hunksep
6840 $ctext conf -state disabled
6845 return [expr {$nr >= 1000? 2: 1}]
6848 proc changediffdisp {} {
6849 global ctext diffelide
6851 $ctext tag conf d0 -elide [lindex $diffelide 0]
6852 $ctext tag conf d1 -elide [lindex $diffelide 1]
6855 proc highlightfile {loc cline} {
6856 global ctext cflist cflist_top
6859 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
6860 $cflist tag add highlight $cline.0 "$cline.0 lineend"
6861 $cflist see $cline.0
6862 set cflist_top $cline
6866 global difffilestart ctext cmitmode
6868 if {$cmitmode eq "tree"} return
6871 set here [$ctext index @0,0]
6872 foreach loc $difffilestart {
6873 if {[$ctext compare $loc >= $here]} {
6874 highlightfile $prev $prevline
6880 highlightfile $prev $prevline
6884 global difffilestart ctext cmitmode
6886 if {$cmitmode eq "tree"} return
6887 set here [$ctext index @0,0]
6889 foreach loc $difffilestart {
6891 if {[$ctext compare $loc > $here]} {
6892 highlightfile $loc $line
6898 proc clear_ctext {{first 1.0}} {
6899 global ctext smarktop smarkbot
6902 set l [lindex [split $first .] 0]
6903 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6906 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6909 $ctext delete $first end
6910 if {$first eq "1.0"} {
6911 catch {unset pendinglinks}
6915 proc settabs {{firstab {}}} {
6916 global firsttabstop tabstop ctext have_tk85
6918 if {$firstab ne {} && $have_tk85} {
6919 set firsttabstop $firstab
6921 set w [font measure textfont "0"]
6922 if {$firsttabstop != 0} {
6923 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6924 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6925 } elseif {$have_tk85 || $tabstop != 8} {
6926 $ctext conf -tabs [expr {$tabstop * $w}]
6928 $ctext conf -tabs {}
6932 proc incrsearch {name ix op} {
6933 global ctext searchstring searchdirn
6935 $ctext tag remove found 1.0 end
6936 if {[catch {$ctext index anchor}]} {
6937 # no anchor set, use start of selection, or of visible area
6938 set sel [$ctext tag ranges sel]
6940 $ctext mark set anchor [lindex $sel 0]
6941 } elseif {$searchdirn eq "-forwards"} {
6942 $ctext mark set anchor @0,0
6944 $ctext mark set anchor @0,[winfo height $ctext]
6947 if {$searchstring ne {}} {
6948 set here [$ctext search $searchdirn -- $searchstring anchor]
6957 global sstring ctext searchstring searchdirn
6960 $sstring icursor end
6961 set searchdirn -forwards
6962 if {$searchstring ne {}} {
6963 set sel [$ctext tag ranges sel]
6965 set start "[lindex $sel 0] + 1c"
6966 } elseif {[catch {set start [$ctext index anchor]}]} {
6969 set match [$ctext search -count mlen -- $searchstring $start]
6970 $ctext tag remove sel 1.0 end
6976 set mend "$match + $mlen c"
6977 $ctext tag add sel $match $mend
6978 $ctext mark unset anchor
6982 proc dosearchback {} {
6983 global sstring ctext searchstring searchdirn
6986 $sstring icursor end
6987 set searchdirn -backwards
6988 if {$searchstring ne {}} {
6989 set sel [$ctext tag ranges sel]
6991 set start [lindex $sel 0]
6992 } elseif {[catch {set start [$ctext index anchor]}]} {
6993 set start @0,[winfo height $ctext]
6995 set match [$ctext search -backwards -count ml -- $searchstring $start]
6996 $ctext tag remove sel 1.0 end
7002 set mend "$match + $ml c"
7003 $ctext tag add sel $match $mend
7004 $ctext mark unset anchor
7008 proc searchmark {first last} {
7009 global ctext searchstring
7013 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7014 if {$match eq {}} break
7015 set mend "$match + $mlen c"
7016 $ctext tag add found $match $mend
7020 proc searchmarkvisible {doall} {
7021 global ctext smarktop smarkbot
7023 set topline [lindex [split [$ctext index @0,0] .] 0]
7024 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7025 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7026 # no overlap with previous
7027 searchmark $topline $botline
7028 set smarktop $topline
7029 set smarkbot $botline
7031 if {$topline < $smarktop} {
7032 searchmark $topline [expr {$smarktop-1}]
7033 set smarktop $topline
7035 if {$botline > $smarkbot} {
7036 searchmark [expr {$smarkbot+1}] $botline
7037 set smarkbot $botline
7042 proc scrolltext {f0 f1} {
7045 .bleft.bottom.sb set $f0 $f1
7046 if {$searchstring ne {}} {
7052 global linespc charspc canvx0 canvy0
7053 global xspc1 xspc2 lthickness
7055 set linespc [font metrics mainfont -linespace]
7056 set charspc [font measure mainfont "m"]
7057 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7058 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7059 set lthickness [expr {int($linespc / 9) + 1}]
7060 set xspc1(0) $linespc
7068 set ymax [lindex [$canv cget -scrollregion] 3]
7069 if {$ymax eq {} || $ymax == 0} return
7070 set span [$canv yview]
7073 allcanvs yview moveto [lindex $span 0]
7075 if {$selectedline ne {}} {
7076 selectline $selectedline 0
7077 allcanvs yview moveto [lindex $span 0]
7081 proc parsefont {f n} {
7084 set fontattr($f,family) [lindex $n 0]
7086 if {$s eq {} || $s == 0} {
7089 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7091 set fontattr($f,size) $s
7092 set fontattr($f,weight) normal
7093 set fontattr($f,slant) roman
7094 foreach style [lrange $n 2 end] {
7097 "bold" {set fontattr($f,weight) $style}
7099 "italic" {set fontattr($f,slant) $style}
7104 proc fontflags {f {isbold 0}} {
7107 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7108 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7109 -slant $fontattr($f,slant)]
7115 set n [list $fontattr($f,family) $fontattr($f,size)]
7116 if {$fontattr($f,weight) eq "bold"} {
7119 if {$fontattr($f,slant) eq "italic"} {
7125 proc incrfont {inc} {
7126 global mainfont textfont ctext canv cflist showrefstop
7127 global stopped entries fontattr
7130 set s $fontattr(mainfont,size)
7135 set fontattr(mainfont,size) $s
7136 font config mainfont -size $s
7137 font config mainfontbold -size $s
7138 set mainfont [fontname mainfont]
7139 set s $fontattr(textfont,size)
7144 set fontattr(textfont,size) $s
7145 font config textfont -size $s
7146 font config textfontbold -size $s
7147 set textfont [fontname textfont]
7154 global sha1entry sha1string
7155 if {[string length $sha1string] == 40} {
7156 $sha1entry delete 0 end
7160 proc sha1change {n1 n2 op} {
7161 global sha1string currentid sha1but
7162 if {$sha1string == {}
7163 || ([info exists currentid] && $sha1string == $currentid)} {
7168 if {[$sha1but cget -state] == $state} return
7169 if {$state == "normal"} {
7170 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7172 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7176 proc gotocommit {} {
7177 global sha1string tagids headids curview varcid
7179 if {$sha1string == {}
7180 || ([info exists currentid] && $sha1string == $currentid)} return
7181 if {[info exists tagids($sha1string)]} {
7182 set id $tagids($sha1string)
7183 } elseif {[info exists headids($sha1string)]} {
7184 set id $headids($sha1string)
7186 set id [string tolower $sha1string]
7187 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7188 set matches [longid $id]
7189 if {$matches ne {}} {
7190 if {[llength $matches] > 1} {
7191 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7194 set id [lindex $matches 0]
7198 if {[commitinview $id $curview]} {
7199 selectline [rowofcommit $id] 1
7202 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7203 set msg [mc "SHA1 id %s is not known" $sha1string]
7205 set msg [mc "Tag/Head %s is not known" $sha1string]
7210 proc lineenter {x y id} {
7211 global hoverx hovery hoverid hovertimer
7212 global commitinfo canv
7214 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7218 if {[info exists hovertimer]} {
7219 after cancel $hovertimer
7221 set hovertimer [after 500 linehover]
7225 proc linemotion {x y id} {
7226 global hoverx hovery hoverid hovertimer
7228 if {[info exists hoverid] && $id == $hoverid} {
7231 if {[info exists hovertimer]} {
7232 after cancel $hovertimer
7234 set hovertimer [after 500 linehover]
7238 proc lineleave {id} {
7239 global hoverid hovertimer canv
7241 if {[info exists hoverid] && $id == $hoverid} {
7243 if {[info exists hovertimer]} {
7244 after cancel $hovertimer
7252 global hoverx hovery hoverid hovertimer
7253 global canv linespc lthickness
7256 set text [lindex $commitinfo($hoverid) 0]
7257 set ymax [lindex [$canv cget -scrollregion] 3]
7258 if {$ymax == {}} return
7259 set yfrac [lindex [$canv yview] 0]
7260 set x [expr {$hoverx + 2 * $linespc}]
7261 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7262 set x0 [expr {$x - 2 * $lthickness}]
7263 set y0 [expr {$y - 2 * $lthickness}]
7264 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7265 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7266 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7267 -fill \#ffff80 -outline black -width 1 -tags hover]
7269 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7274 proc clickisonarrow {id y} {
7277 set ranges [rowranges $id]
7278 set thresh [expr {2 * $lthickness + 6}]
7279 set n [expr {[llength $ranges] - 1}]
7280 for {set i 1} {$i < $n} {incr i} {
7281 set row [lindex $ranges $i]
7282 if {abs([yc $row] - $y) < $thresh} {
7289 proc arrowjump {id n y} {
7292 # 1 <-> 2, 3 <-> 4, etc...
7293 set n [expr {(($n - 1) ^ 1) + 1}]
7294 set row [lindex [rowranges $id] $n]
7296 set ymax [lindex [$canv cget -scrollregion] 3]
7297 if {$ymax eq {} || $ymax <= 0} return
7298 set view [$canv yview]
7299 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7300 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7304 allcanvs yview moveto $yfrac
7307 proc lineclick {x y id isnew} {
7308 global ctext commitinfo children canv thickerline curview
7310 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7315 # draw this line thicker than normal
7319 set ymax [lindex [$canv cget -scrollregion] 3]
7320 if {$ymax eq {}} return
7321 set yfrac [lindex [$canv yview] 0]
7322 set y [expr {$y + $yfrac * $ymax}]
7324 set dirn [clickisonarrow $id $y]
7326 arrowjump $id $dirn $y
7331 addtohistory [list lineclick $x $y $id 0]
7333 # fill the details pane with info about this line
7334 $ctext conf -state normal
7337 $ctext insert end "[mc "Parent"]:\t"
7338 $ctext insert end $id link0
7340 set info $commitinfo($id)
7341 $ctext insert end "\n\t[lindex $info 0]\n"
7342 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7343 set date [formatdate [lindex $info 2]]
7344 $ctext insert end "\t[mc "Date"]:\t$date\n"
7345 set kids $children($curview,$id)
7347 $ctext insert end "\n[mc "Children"]:"
7349 foreach child $kids {
7351 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7352 set info $commitinfo($child)
7353 $ctext insert end "\n\t"
7354 $ctext insert end $child link$i
7355 setlink $child link$i
7356 $ctext insert end "\n\t[lindex $info 0]"
7357 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7358 set date [formatdate [lindex $info 2]]
7359 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7362 $ctext conf -state disabled
7366 proc normalline {} {
7368 if {[info exists thickerline]} {
7377 if {[commitinview $id $curview]} {
7378 selectline [rowofcommit $id] 1
7384 if {![info exists startmstime]} {
7385 set startmstime [clock clicks -milliseconds]
7387 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7390 proc rowmenu {x y id} {
7391 global rowctxmenu selectedline rowmenuid curview
7392 global nullid nullid2 fakerowmenu mainhead
7396 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7401 if {$id ne $nullid && $id ne $nullid2} {
7402 set menu $rowctxmenu
7403 if {$mainhead ne {}} {
7404 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7406 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7409 set menu $fakerowmenu
7411 $menu entryconfigure [mca "Diff this -> selected"] -state $state
7412 $menu entryconfigure [mca "Diff selected -> this"] -state $state
7413 $menu entryconfigure [mca "Make patch"] -state $state
7414 tk_popup $menu $x $y
7417 proc diffvssel {dirn} {
7418 global rowmenuid selectedline
7420 if {$selectedline eq {}} return
7422 set oldid [commitonrow $selectedline]
7423 set newid $rowmenuid
7425 set oldid $rowmenuid
7426 set newid [commitonrow $selectedline]
7428 addtohistory [list doseldiff $oldid $newid]
7429 doseldiff $oldid $newid
7432 proc doseldiff {oldid newid} {
7436 $ctext conf -state normal
7438 init_flist [mc "Top"]
7439 $ctext insert end "[mc "From"] "
7440 $ctext insert end $oldid link0
7441 setlink $oldid link0
7442 $ctext insert end "\n "
7443 $ctext insert end [lindex $commitinfo($oldid) 0]
7444 $ctext insert end "\n\n[mc "To"] "
7445 $ctext insert end $newid link1
7446 setlink $newid link1
7447 $ctext insert end "\n "
7448 $ctext insert end [lindex $commitinfo($newid) 0]
7449 $ctext insert end "\n"
7450 $ctext conf -state disabled
7451 $ctext tag remove found 1.0 end
7452 startdiff [list $oldid $newid]
7456 global rowmenuid currentid commitinfo patchtop patchnum
7458 if {![info exists currentid]} return
7459 set oldid $currentid
7460 set oldhead [lindex $commitinfo($oldid) 0]
7461 set newid $rowmenuid
7462 set newhead [lindex $commitinfo($newid) 0]
7465 catch {destroy $top}
7467 label $top.title -text [mc "Generate patch"]
7468 grid $top.title - -pady 10
7469 label $top.from -text [mc "From:"]
7470 entry $top.fromsha1 -width 40 -relief flat
7471 $top.fromsha1 insert 0 $oldid
7472 $top.fromsha1 conf -state readonly
7473 grid $top.from $top.fromsha1 -sticky w
7474 entry $top.fromhead -width 60 -relief flat
7475 $top.fromhead insert 0 $oldhead
7476 $top.fromhead conf -state readonly
7477 grid x $top.fromhead -sticky w
7478 label $top.to -text [mc "To:"]
7479 entry $top.tosha1 -width 40 -relief flat
7480 $top.tosha1 insert 0 $newid
7481 $top.tosha1 conf -state readonly
7482 grid $top.to $top.tosha1 -sticky w
7483 entry $top.tohead -width 60 -relief flat
7484 $top.tohead insert 0 $newhead
7485 $top.tohead conf -state readonly
7486 grid x $top.tohead -sticky w
7487 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7488 grid $top.rev x -pady 10
7489 label $top.flab -text [mc "Output file:"]
7490 entry $top.fname -width 60
7491 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7493 grid $top.flab $top.fname -sticky w
7495 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7496 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7497 grid $top.buts.gen $top.buts.can
7498 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7499 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7500 grid $top.buts - -pady 10 -sticky ew
7504 proc mkpatchrev {} {
7507 set oldid [$patchtop.fromsha1 get]
7508 set oldhead [$patchtop.fromhead get]
7509 set newid [$patchtop.tosha1 get]
7510 set newhead [$patchtop.tohead get]
7511 foreach e [list fromsha1 fromhead tosha1 tohead] \
7512 v [list $newid $newhead $oldid $oldhead] {
7513 $patchtop.$e conf -state normal
7514 $patchtop.$e delete 0 end
7515 $patchtop.$e insert 0 $v
7516 $patchtop.$e conf -state readonly
7521 global patchtop nullid nullid2
7523 set oldid [$patchtop.fromsha1 get]
7524 set newid [$patchtop.tosha1 get]
7525 set fname [$patchtop.fname get]
7526 set cmd [diffcmd [list $oldid $newid] -p]
7527 # trim off the initial "|"
7528 set cmd [lrange $cmd 1 end]
7529 lappend cmd >$fname &
7530 if {[catch {eval exec $cmd} err]} {
7531 error_popup "[mc "Error creating patch:"] $err"
7533 catch {destroy $patchtop}
7537 proc mkpatchcan {} {
7540 catch {destroy $patchtop}
7545 global rowmenuid mktagtop commitinfo
7549 catch {destroy $top}
7551 label $top.title -text [mc "Create tag"]
7552 grid $top.title - -pady 10
7553 label $top.id -text [mc "ID:"]
7554 entry $top.sha1 -width 40 -relief flat
7555 $top.sha1 insert 0 $rowmenuid
7556 $top.sha1 conf -state readonly
7557 grid $top.id $top.sha1 -sticky w
7558 entry $top.head -width 60 -relief flat
7559 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7560 $top.head conf -state readonly
7561 grid x $top.head -sticky w
7562 label $top.tlab -text [mc "Tag name:"]
7563 entry $top.tag -width 60
7564 grid $top.tlab $top.tag -sticky w
7566 button $top.buts.gen -text [mc "Create"] -command mktaggo
7567 button $top.buts.can -text [mc "Cancel"] -command mktagcan
7568 grid $top.buts.gen $top.buts.can
7569 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7570 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7571 grid $top.buts - -pady 10 -sticky ew
7576 global mktagtop env tagids idtags
7578 set id [$mktagtop.sha1 get]
7579 set tag [$mktagtop.tag get]
7581 error_popup [mc "No tag name specified"]
7584 if {[info exists tagids($tag)]} {
7585 error_popup [mc "Tag \"%s\" already exists" $tag]
7589 exec git tag $tag $id
7591 error_popup "[mc "Error creating tag:"] $err"
7595 set tagids($tag) $id
7596 lappend idtags($id) $tag
7603 proc redrawtags {id} {
7604 global canv linehtag idpos currentid curview cmitlisted
7605 global canvxmax iddrawn circleitem mainheadid circlecolors
7607 if {![commitinview $id $curview]} return
7608 if {![info exists iddrawn($id)]} return
7609 set row [rowofcommit $id]
7610 if {$id eq $mainheadid} {
7613 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
7615 $canv itemconf $circleitem($row) -fill $ofill
7616 $canv delete tag.$id
7617 set xt [eval drawtags $id $idpos($id)]
7618 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7619 set text [$canv itemcget $linehtag($row) -text]
7620 set font [$canv itemcget $linehtag($row) -font]
7621 set xr [expr {$xt + [font measure $font $text]}]
7622 if {$xr > $canvxmax} {
7626 if {[info exists currentid] && $currentid == $id} {
7634 catch {destroy $mktagtop}
7643 proc writecommit {} {
7644 global rowmenuid wrcomtop commitinfo wrcomcmd
7646 set top .writecommit
7648 catch {destroy $top}
7650 label $top.title -text [mc "Write commit to file"]
7651 grid $top.title - -pady 10
7652 label $top.id -text [mc "ID:"]
7653 entry $top.sha1 -width 40 -relief flat
7654 $top.sha1 insert 0 $rowmenuid
7655 $top.sha1 conf -state readonly
7656 grid $top.id $top.sha1 -sticky w
7657 entry $top.head -width 60 -relief flat
7658 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7659 $top.head conf -state readonly
7660 grid x $top.head -sticky w
7661 label $top.clab -text [mc "Command:"]
7662 entry $top.cmd -width 60 -textvariable wrcomcmd
7663 grid $top.clab $top.cmd -sticky w -pady 10
7664 label $top.flab -text [mc "Output file:"]
7665 entry $top.fname -width 60
7666 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7667 grid $top.flab $top.fname -sticky w
7669 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7670 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7671 grid $top.buts.gen $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
7681 set id [$wrcomtop.sha1 get]
7682 set cmd "echo $id | [$wrcomtop.cmd get]"
7683 set fname [$wrcomtop.fname get]
7684 if {[catch {exec sh -c $cmd >$fname &} err]} {
7685 error_popup "[mc "Error writing commit:"] $err"
7687 catch {destroy $wrcomtop}
7694 catch {destroy $wrcomtop}
7699 global rowmenuid mkbrtop
7702 catch {destroy $top}
7704 label $top.title -text [mc "Create new branch"]
7705 grid $top.title - -pady 10
7706 label $top.id -text [mc "ID:"]
7707 entry $top.sha1 -width 40 -relief flat
7708 $top.sha1 insert 0 $rowmenuid
7709 $top.sha1 conf -state readonly
7710 grid $top.id $top.sha1 -sticky w
7711 label $top.nlab -text [mc "Name:"]
7712 entry $top.name -width 40
7713 bind $top.name <Key-Return> "[list mkbrgo $top]"
7714 grid $top.nlab $top.name -sticky w
7716 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7717 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7718 grid $top.buts.go $top.buts.can
7719 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7720 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7721 grid $top.buts - -pady 10 -sticky ew
7726 global headids idheads
7728 set name [$top.name get]
7729 set id [$top.sha1 get]
7731 error_popup [mc "Please specify a name for the new branch"]
7734 catch {destroy $top}
7738 exec git branch $name $id
7743 set headids($name) $id
7744 lappend idheads($id) $name
7753 proc cherrypick {} {
7754 global rowmenuid curview
7755 global mainhead mainheadid
7757 set oldhead [exec git rev-parse HEAD]
7758 set dheads [descheads $rowmenuid]
7759 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7760 set ok [confirm_popup [mc "Commit %s is already\
7761 included in branch %s -- really re-apply it?" \
7762 [string range $rowmenuid 0 7] $mainhead]]
7765 nowbusy cherrypick [mc "Cherry-picking"]
7767 # Unfortunately git-cherry-pick writes stuff to stderr even when
7768 # no error occurs, and exec takes that as an indication of error...
7769 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7774 set newhead [exec git rev-parse HEAD]
7775 if {$newhead eq $oldhead} {
7777 error_popup [mc "No changes committed"]
7780 addnewchild $newhead $oldhead
7781 if {[commitinview $oldhead $curview]} {
7782 insertrow $newhead $oldhead $curview
7783 if {$mainhead ne {}} {
7784 movehead $newhead $mainhead
7785 movedhead $newhead $mainhead
7787 set mainheadid $newhead
7796 global mainhead rowmenuid confirm_ok resettype
7799 set w ".confirmreset"
7802 wm title $w [mc "Confirm reset"]
7803 message $w.m -text \
7804 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7805 -justify center -aspect 1000
7806 pack $w.m -side top -fill x -padx 20 -pady 20
7807 frame $w.f -relief sunken -border 2
7808 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7809 grid $w.f.rt -sticky w
7811 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7812 -text [mc "Soft: Leave working tree and index untouched"]
7813 grid $w.f.soft -sticky w
7814 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7815 -text [mc "Mixed: Leave working tree untouched, reset index"]
7816 grid $w.f.mixed -sticky w
7817 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7818 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7819 grid $w.f.hard -sticky w
7820 pack $w.f -side top -fill x
7821 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7822 pack $w.ok -side left -fill x -padx 20 -pady 20
7823 button $w.cancel -text [mc Cancel] -command "destroy $w"
7824 pack $w.cancel -side right -fill x -padx 20 -pady 20
7825 bind $w <Visibility> "grab $w; focus $w"
7827 if {!$confirm_ok} return
7828 if {[catch {set fd [open \
7829 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
7833 filerun $fd [list readresetstat $fd]
7834 nowbusy reset [mc "Resetting"]
7839 proc readresetstat {fd} {
7840 global mainhead mainheadid showlocalchanges rprogcoord
7842 if {[gets $fd line] >= 0} {
7843 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7844 set rprogcoord [expr {1.0 * $m / $n}]
7852 if {[catch {close $fd} err]} {
7855 set oldhead $mainheadid
7856 set newhead [exec git rev-parse HEAD]
7857 if {$newhead ne $oldhead} {
7858 movehead $newhead $mainhead
7859 movedhead $newhead $mainhead
7860 set mainheadid $newhead
7864 if {$showlocalchanges} {
7870 # context menu for a head
7871 proc headmenu {x y id head} {
7872 global headmenuid headmenuhead headctxmenu mainhead
7876 set headmenuhead $head
7878 if {$head eq $mainhead} {
7881 $headctxmenu entryconfigure 0 -state $state
7882 $headctxmenu entryconfigure 1 -state $state
7883 tk_popup $headctxmenu $x $y
7887 global headmenuid headmenuhead headids
7888 global showlocalchanges mainheadid
7890 # check the tree is clean first??
7891 nowbusy checkout [mc "Checking out"]
7895 set fd [open [list | git checkout $headmenuhead 2>@1] r]
7899 if {$showlocalchanges} {
7903 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
7907 proc readcheckoutstat {fd newhead newheadid} {
7908 global mainhead mainheadid headids showlocalchanges progresscoords
7910 if {[gets $fd line] >= 0} {
7911 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7912 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
7917 set progresscoords {0 0}
7920 if {[catch {close $fd} err]} {
7923 set oldmainid $mainheadid
7924 set mainhead $newhead
7925 set mainheadid $newheadid
7926 redrawtags $oldmainid
7927 redrawtags $newheadid
7929 if {$showlocalchanges} {
7935 global headmenuid headmenuhead mainhead
7938 set head $headmenuhead
7940 # this check shouldn't be needed any more...
7941 if {$head eq $mainhead} {
7942 error_popup [mc "Cannot delete the currently checked-out branch"]
7945 set dheads [descheads $id]
7946 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7947 # the stuff on this branch isn't on any other branch
7948 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7949 branch.\nReally delete branch %s?" $head $head]]} return
7953 if {[catch {exec git branch -D $head} err]} {
7958 removehead $id $head
7959 removedhead $id $head
7966 # Display a list of tags and heads
7968 global showrefstop bgcolor fgcolor selectbgcolor
7969 global bglist fglist reflistfilter reflist maincursor
7972 set showrefstop $top
7973 if {[winfo exists $top]} {
7979 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7980 text $top.list -background $bgcolor -foreground $fgcolor \
7981 -selectbackground $selectbgcolor -font mainfont \
7982 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7983 -width 30 -height 20 -cursor $maincursor \
7984 -spacing1 1 -spacing3 1 -state disabled
7985 $top.list tag configure highlight -background $selectbgcolor
7986 lappend bglist $top.list
7987 lappend fglist $top.list
7988 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7989 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7990 grid $top.list $top.ysb -sticky nsew
7991 grid $top.xsb x -sticky ew
7993 label $top.f.l -text "[mc "Filter"]: "
7994 entry $top.f.e -width 20 -textvariable reflistfilter
7995 set reflistfilter "*"
7996 trace add variable reflistfilter write reflistfilter_change
7997 pack $top.f.e -side right -fill x -expand 1
7998 pack $top.f.l -side left
7999 grid $top.f - -sticky ew -pady 2
8000 button $top.close -command [list destroy $top] -text [mc "Close"]
8002 grid columnconfigure $top 0 -weight 1
8003 grid rowconfigure $top 0 -weight 1
8004 bind $top.list <1> {break}
8005 bind $top.list <B1-Motion> {break}
8006 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8011 proc sel_reflist {w x y} {
8012 global showrefstop reflist headids tagids otherrefids
8014 if {![winfo exists $showrefstop]} return
8015 set l [lindex [split [$w index "@$x,$y"] "."] 0]
8016 set ref [lindex $reflist [expr {$l-1}]]
8017 set n [lindex $ref 0]
8018 switch -- [lindex $ref 1] {
8019 "H" {selbyid $headids($n)}
8020 "T" {selbyid $tagids($n)}
8021 "o" {selbyid $otherrefids($n)}
8023 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8026 proc unsel_reflist {} {
8029 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8030 $showrefstop.list tag remove highlight 0.0 end
8033 proc reflistfilter_change {n1 n2 op} {
8034 global reflistfilter
8036 after cancel refill_reflist
8037 after 200 refill_reflist
8040 proc refill_reflist {} {
8041 global reflist reflistfilter showrefstop headids tagids otherrefids
8044 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8046 foreach n [array names headids] {
8047 if {[string match $reflistfilter $n]} {
8048 if {[commitinview $headids($n) $curview]} {
8049 lappend refs [list $n H]
8051 interestedin $headids($n) {run refill_reflist}
8055 foreach n [array names tagids] {
8056 if {[string match $reflistfilter $n]} {
8057 if {[commitinview $tagids($n) $curview]} {
8058 lappend refs [list $n T]
8060 interestedin $tagids($n) {run refill_reflist}
8064 foreach n [array names otherrefids] {
8065 if {[string match $reflistfilter $n]} {
8066 if {[commitinview $otherrefids($n) $curview]} {
8067 lappend refs [list $n o]
8069 interestedin $otherrefids($n) {run refill_reflist}
8073 set refs [lsort -index 0 $refs]
8074 if {$refs eq $reflist} return
8076 # Update the contents of $showrefstop.list according to the
8077 # differences between $reflist (old) and $refs (new)
8078 $showrefstop.list conf -state normal
8079 $showrefstop.list insert end "\n"
8082 while {$i < [llength $reflist] || $j < [llength $refs]} {
8083 if {$i < [llength $reflist]} {
8084 if {$j < [llength $refs]} {
8085 set cmp [string compare [lindex $reflist $i 0] \
8086 [lindex $refs $j 0]]
8088 set cmp [string compare [lindex $reflist $i 1] \
8089 [lindex $refs $j 1]]
8099 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8107 set l [expr {$j + 1}]
8108 $showrefstop.list image create $l.0 -align baseline \
8109 -image reficon-[lindex $refs $j 1] -padx 2
8110 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8116 # delete last newline
8117 $showrefstop.list delete end-2c end-1c
8118 $showrefstop.list conf -state disabled
8121 # Stuff for finding nearby tags
8122 proc getallcommits {} {
8123 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8124 global idheads idtags idotherrefs allparents tagobjid
8126 if {![info exists allcommits]} {
8132 set allccache [file join [gitdir] "gitk.cache"]
8134 set f [open $allccache r]
8143 set cmd [list | git rev-list --parents]
8144 set allcupdate [expr {$seeds ne {}}]
8148 set refs [concat [array names idheads] [array names idtags] \
8149 [array names idotherrefs]]
8152 foreach name [array names tagobjid] {
8153 lappend tagobjs $tagobjid($name)
8155 foreach id [lsort -unique $refs] {
8156 if {![info exists allparents($id)] &&
8157 [lsearch -exact $tagobjs $id] < 0} {
8168 set fd [open [concat $cmd $ids] r]
8169 fconfigure $fd -blocking 0
8172 filerun $fd [list getallclines $fd]
8178 # Since most commits have 1 parent and 1 child, we group strings of
8179 # such commits into "arcs" joining branch/merge points (BMPs), which
8180 # are commits that either don't have 1 parent or don't have 1 child.
8182 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8183 # arcout(id) - outgoing arcs for BMP
8184 # arcids(a) - list of IDs on arc including end but not start
8185 # arcstart(a) - BMP ID at start of arc
8186 # arcend(a) - BMP ID at end of arc
8187 # growing(a) - arc a is still growing
8188 # arctags(a) - IDs out of arcids (excluding end) that have tags
8189 # archeads(a) - IDs out of arcids (excluding end) that have heads
8190 # The start of an arc is at the descendent end, so "incoming" means
8191 # coming from descendents, and "outgoing" means going towards ancestors.
8193 proc getallclines {fd} {
8194 global allparents allchildren idtags idheads nextarc
8195 global arcnos arcids arctags arcout arcend arcstart archeads growing
8196 global seeds allcommits cachedarcs allcupdate
8199 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8200 set id [lindex $line 0]
8201 if {[info exists allparents($id)]} {
8206 set olds [lrange $line 1 end]
8207 set allparents($id) $olds
8208 if {![info exists allchildren($id)]} {
8209 set allchildren($id) {}
8214 if {[llength $olds] == 1 && [llength $a] == 1} {
8215 lappend arcids($a) $id
8216 if {[info exists idtags($id)]} {
8217 lappend arctags($a) $id
8219 if {[info exists idheads($id)]} {
8220 lappend archeads($a) $id
8222 if {[info exists allparents($olds)]} {
8223 # seen parent already
8224 if {![info exists arcout($olds)]} {
8227 lappend arcids($a) $olds
8228 set arcend($a) $olds
8231 lappend allchildren($olds) $id
8232 lappend arcnos($olds) $a
8236 foreach a $arcnos($id) {
8237 lappend arcids($a) $id
8244 lappend allchildren($p) $id
8245 set a [incr nextarc]
8246 set arcstart($a) $id
8253 if {[info exists allparents($p)]} {
8254 # seen it already, may need to make a new branch
8255 if {![info exists arcout($p)]} {
8258 lappend arcids($a) $p
8262 lappend arcnos($p) $a
8267 global cached_dheads cached_dtags cached_atags
8268 catch {unset cached_dheads}
8269 catch {unset cached_dtags}
8270 catch {unset cached_atags}
8273 return [expr {$nid >= 1000? 2: 1}]
8277 fconfigure $fd -blocking 1
8280 # got an error reading the list of commits
8281 # if we were updating, try rereading the whole thing again
8287 error_popup "[mc "Error reading commit topology information;\
8288 branch and preceding/following tag information\
8289 will be incomplete."]\n($err)"
8292 if {[incr allcommits -1] == 0} {
8302 proc recalcarc {a} {
8303 global arctags archeads arcids idtags idheads
8307 foreach id [lrange $arcids($a) 0 end-1] {
8308 if {[info exists idtags($id)]} {
8311 if {[info exists idheads($id)]} {
8316 set archeads($a) $ah
8320 global arcnos arcids nextarc arctags archeads idtags idheads
8321 global arcstart arcend arcout allparents growing
8324 if {[llength $a] != 1} {
8325 puts "oops splitarc called but [llength $a] arcs already"
8329 set i [lsearch -exact $arcids($a) $p]
8331 puts "oops splitarc $p not in arc $a"
8334 set na [incr nextarc]
8335 if {[info exists arcend($a)]} {
8336 set arcend($na) $arcend($a)
8338 set l [lindex $allparents([lindex $arcids($a) end]) 0]
8339 set j [lsearch -exact $arcnos($l) $a]
8340 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8342 set tail [lrange $arcids($a) [expr {$i+1}] end]
8343 set arcids($a) [lrange $arcids($a) 0 $i]
8345 set arcstart($na) $p
8347 set arcids($na) $tail
8348 if {[info exists growing($a)]} {
8354 if {[llength $arcnos($id)] == 1} {
8357 set j [lsearch -exact $arcnos($id) $a]
8358 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8362 # reconstruct tags and heads lists
8363 if {$arctags($a) ne {} || $archeads($a) ne {}} {
8368 set archeads($na) {}
8372 # Update things for a new commit added that is a child of one
8373 # existing commit. Used when cherry-picking.
8374 proc addnewchild {id p} {
8375 global allparents allchildren idtags nextarc
8376 global arcnos arcids arctags arcout arcend arcstart archeads growing
8377 global seeds allcommits
8379 if {![info exists allcommits] || ![info exists arcnos($p)]} return
8380 set allparents($id) [list $p]
8381 set allchildren($id) {}
8384 lappend allchildren($p) $id
8385 set a [incr nextarc]
8386 set arcstart($a) $id
8389 set arcids($a) [list $p]
8391 if {![info exists arcout($p)]} {
8394 lappend arcnos($p) $a
8395 set arcout($id) [list $a]
8398 # This implements a cache for the topology information.
8399 # The cache saves, for each arc, the start and end of the arc,
8400 # the ids on the arc, and the outgoing arcs from the end.
8401 proc readcache {f} {
8402 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8403 global idtags idheads allparents cachedarcs possible_seeds seeds growing
8408 if {$lim - $a > 500} {
8409 set lim [expr {$a + 500}]
8413 # finish reading the cache and setting up arctags, etc.
8415 if {$line ne "1"} {error "bad final version"}
8417 foreach id [array names idtags] {
8418 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8419 [llength $allparents($id)] == 1} {
8420 set a [lindex $arcnos($id) 0]
8421 if {$arctags($a) eq {}} {
8426 foreach id [array names idheads] {
8427 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8428 [llength $allparents($id)] == 1} {
8429 set a [lindex $arcnos($id) 0]
8430 if {$archeads($a) eq {}} {
8435 foreach id [lsort -unique $possible_seeds] {
8436 if {$arcnos($id) eq {}} {
8442 while {[incr a] <= $lim} {
8444 if {[llength $line] != 3} {error "bad line"}
8445 set s [lindex $line 0]
8447 lappend arcout($s) $a
8448 if {![info exists arcnos($s)]} {
8449 lappend possible_seeds $s
8452 set e [lindex $line 1]
8457 if {![info exists arcout($e)]} {
8461 set arcids($a) [lindex $line 2]
8462 foreach id $arcids($a) {
8463 lappend allparents($s) $id
8465 lappend arcnos($id) $a
8467 if {![info exists allparents($s)]} {
8468 set allparents($s) {}
8473 set nextarc [expr {$a - 1}]
8486 global nextarc cachedarcs possible_seeds
8490 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8491 # make sure it's an integer
8492 set cachedarcs [expr {int([lindex $line 1])}]
8493 if {$cachedarcs < 0} {error "bad number of arcs"}
8495 set possible_seeds {}
8503 proc dropcache {err} {
8504 global allcwait nextarc cachedarcs seeds
8506 #puts "dropping cache ($err)"
8507 foreach v {arcnos arcout arcids arcstart arcend growing \
8508 arctags archeads allparents allchildren} {
8519 proc writecache {f} {
8520 global cachearc cachedarcs allccache
8521 global arcstart arcend arcnos arcids arcout
8525 if {$lim - $a > 1000} {
8526 set lim [expr {$a + 1000}]
8529 while {[incr a] <= $lim} {
8530 if {[info exists arcend($a)]} {
8531 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8533 puts $f [list $arcstart($a) {} $arcids($a)]
8538 catch {file delete $allccache}
8539 #puts "writing cache failed ($err)"
8542 set cachearc [expr {$a - 1}]
8543 if {$a > $cachedarcs} {
8552 global nextarc cachedarcs cachearc allccache
8554 if {$nextarc == $cachedarcs} return
8556 set cachedarcs $nextarc
8558 set f [open $allccache w]
8559 puts $f [list 1 $cachedarcs]
8564 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8565 # or 0 if neither is true.
8566 proc anc_or_desc {a b} {
8567 global arcout arcstart arcend arcnos cached_isanc
8569 if {$arcnos($a) eq $arcnos($b)} {
8570 # Both are on the same arc(s); either both are the same BMP,
8571 # or if one is not a BMP, the other is also not a BMP or is
8572 # the BMP at end of the arc (and it only has 1 incoming arc).
8573 # Or both can be BMPs with no incoming arcs.
8574 if {$a eq $b || $arcnos($a) eq {}} {
8577 # assert {[llength $arcnos($a)] == 1}
8578 set arc [lindex $arcnos($a) 0]
8579 set i [lsearch -exact $arcids($arc) $a]
8580 set j [lsearch -exact $arcids($arc) $b]
8581 if {$i < 0 || $i > $j} {
8588 if {![info exists arcout($a)]} {
8589 set arc [lindex $arcnos($a) 0]
8590 if {[info exists arcend($arc)]} {
8591 set aend $arcend($arc)
8595 set a $arcstart($arc)
8599 if {![info exists arcout($b)]} {
8600 set arc [lindex $arcnos($b) 0]
8601 if {[info exists arcend($arc)]} {
8602 set bend $arcend($arc)
8606 set b $arcstart($arc)
8616 if {[info exists cached_isanc($a,$bend)]} {
8617 if {$cached_isanc($a,$bend)} {
8621 if {[info exists cached_isanc($b,$aend)]} {
8622 if {$cached_isanc($b,$aend)} {
8625 if {[info exists cached_isanc($a,$bend)]} {
8630 set todo [list $a $b]
8633 for {set i 0} {$i < [llength $todo]} {incr i} {
8634 set x [lindex $todo $i]
8635 if {$anc($x) eq {}} {
8638 foreach arc $arcnos($x) {
8639 set xd $arcstart($arc)
8641 set cached_isanc($a,$bend) 1
8642 set cached_isanc($b,$aend) 0
8644 } elseif {$xd eq $aend} {
8645 set cached_isanc($b,$aend) 1
8646 set cached_isanc($a,$bend) 0
8649 if {![info exists anc($xd)]} {
8650 set anc($xd) $anc($x)
8652 } elseif {$anc($xd) ne $anc($x)} {
8657 set cached_isanc($a,$bend) 0
8658 set cached_isanc($b,$aend) 0
8662 # This identifies whether $desc has an ancestor that is
8663 # a growing tip of the graph and which is not an ancestor of $anc
8664 # and returns 0 if so and 1 if not.
8665 # If we subsequently discover a tag on such a growing tip, and that
8666 # turns out to be a descendent of $anc (which it could, since we
8667 # don't necessarily see children before parents), then $desc
8668 # isn't a good choice to display as a descendent tag of
8669 # $anc (since it is the descendent of another tag which is
8670 # a descendent of $anc). Similarly, $anc isn't a good choice to
8671 # display as a ancestor tag of $desc.
8673 proc is_certain {desc anc} {
8674 global arcnos arcout arcstart arcend growing problems
8677 if {[llength $arcnos($anc)] == 1} {
8678 # tags on the same arc are certain
8679 if {$arcnos($desc) eq $arcnos($anc)} {
8682 if {![info exists arcout($anc)]} {
8683 # if $anc is partway along an arc, use the start of the arc instead
8684 set a [lindex $arcnos($anc) 0]
8685 set anc $arcstart($a)
8688 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8691 set a [lindex $arcnos($desc) 0]
8697 set anclist [list $x]
8701 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8702 set x [lindex $anclist $i]
8707 foreach a $arcout($x) {
8708 if {[info exists growing($a)]} {
8709 if {![info exists growanc($x)] && $dl($x)} {
8715 if {[info exists dl($y)]} {
8719 if {![info exists done($y)]} {
8722 if {[info exists growanc($x)]} {
8726 for {set k 0} {$k < [llength $xl]} {incr k} {
8727 set z [lindex $xl $k]
8728 foreach c $arcout($z) {
8729 if {[info exists arcend($c)]} {
8731 if {[info exists dl($v)] && $dl($v)} {
8733 if {![info exists done($v)]} {
8736 if {[info exists growanc($v)]} {
8746 } elseif {$y eq $anc || !$dl($x)} {
8757 foreach x [array names growanc] {
8766 proc validate_arctags {a} {
8767 global arctags idtags
8771 foreach id $arctags($a) {
8773 if {![info exists idtags($id)]} {
8774 set na [lreplace $na $i $i]
8781 proc validate_archeads {a} {
8782 global archeads idheads
8785 set na $archeads($a)
8786 foreach id $archeads($a) {
8788 if {![info exists idheads($id)]} {
8789 set na [lreplace $na $i $i]
8793 set archeads($a) $na
8796 # Return the list of IDs that have tags that are descendents of id,
8797 # ignoring IDs that are descendents of IDs already reported.
8798 proc desctags {id} {
8799 global arcnos arcstart arcids arctags idtags allparents
8800 global growing cached_dtags
8802 if {![info exists allparents($id)]} {
8805 set t1 [clock clicks -milliseconds]
8807 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8808 # part-way along an arc; check that arc first
8809 set a [lindex $arcnos($id) 0]
8810 if {$arctags($a) ne {}} {
8812 set i [lsearch -exact $arcids($a) $id]
8814 foreach t $arctags($a) {
8815 set j [lsearch -exact $arcids($a) $t]
8823 set id $arcstart($a)
8824 if {[info exists idtags($id)]} {
8828 if {[info exists cached_dtags($id)]} {
8829 return $cached_dtags($id)
8836 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8837 set id [lindex $todo $i]
8839 set ta [info exists hastaggedancestor($id)]
8843 # ignore tags on starting node
8844 if {!$ta && $i > 0} {
8845 if {[info exists idtags($id)]} {
8848 } elseif {[info exists cached_dtags($id)]} {
8849 set tagloc($id) $cached_dtags($id)
8853 foreach a $arcnos($id) {
8855 if {!$ta && $arctags($a) ne {}} {
8857 if {$arctags($a) ne {}} {
8858 lappend tagloc($id) [lindex $arctags($a) end]
8861 if {$ta || $arctags($a) ne {}} {
8862 set tomark [list $d]
8863 for {set j 0} {$j < [llength $tomark]} {incr j} {
8864 set dd [lindex $tomark $j]
8865 if {![info exists hastaggedancestor($dd)]} {
8866 if {[info exists done($dd)]} {
8867 foreach b $arcnos($dd) {
8868 lappend tomark $arcstart($b)
8870 if {[info exists tagloc($dd)]} {
8873 } elseif {[info exists queued($dd)]} {
8876 set hastaggedancestor($dd) 1
8880 if {![info exists queued($d)]} {
8883 if {![info exists hastaggedancestor($d)]} {
8890 foreach id [array names tagloc] {
8891 if {![info exists hastaggedancestor($id)]} {
8892 foreach t $tagloc($id) {
8893 if {[lsearch -exact $tags $t] < 0} {
8899 set t2 [clock clicks -milliseconds]
8902 # remove tags that are descendents of other tags
8903 for {set i 0} {$i < [llength $tags]} {incr i} {
8904 set a [lindex $tags $i]
8905 for {set j 0} {$j < $i} {incr j} {
8906 set b [lindex $tags $j]
8907 set r [anc_or_desc $a $b]
8909 set tags [lreplace $tags $j $j]
8912 } elseif {$r == -1} {
8913 set tags [lreplace $tags $i $i]
8920 if {[array names growing] ne {}} {
8921 # graph isn't finished, need to check if any tag could get
8922 # eclipsed by another tag coming later. Simply ignore any
8923 # tags that could later get eclipsed.
8926 if {[is_certain $t $origid]} {
8930 if {$tags eq $ctags} {
8931 set cached_dtags($origid) $tags
8936 set cached_dtags($origid) $tags
8938 set t3 [clock clicks -milliseconds]
8939 if {0 && $t3 - $t1 >= 100} {
8940 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8941 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8947 global arcnos arcids arcout arcend arctags idtags allparents
8948 global growing cached_atags
8950 if {![info exists allparents($id)]} {
8953 set t1 [clock clicks -milliseconds]
8955 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8956 # part-way along an arc; check that arc first
8957 set a [lindex $arcnos($id) 0]
8958 if {$arctags($a) ne {}} {
8960 set i [lsearch -exact $arcids($a) $id]
8961 foreach t $arctags($a) {
8962 set j [lsearch -exact $arcids($a) $t]
8968 if {![info exists arcend($a)]} {
8972 if {[info exists idtags($id)]} {
8976 if {[info exists cached_atags($id)]} {
8977 return $cached_atags($id)
8985 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8986 set id [lindex $todo $i]
8988 set td [info exists hastaggeddescendent($id)]
8992 # ignore tags on starting node
8993 if {!$td && $i > 0} {
8994 if {[info exists idtags($id)]} {
8997 } elseif {[info exists cached_atags($id)]} {
8998 set tagloc($id) $cached_atags($id)
9002 foreach a $arcout($id) {
9003 if {!$td && $arctags($a) ne {}} {
9005 if {$arctags($a) ne {}} {
9006 lappend tagloc($id) [lindex $arctags($a) 0]
9009 if {![info exists arcend($a)]} continue
9011 if {$td || $arctags($a) ne {}} {
9012 set tomark [list $d]
9013 for {set j 0} {$j < [llength $tomark]} {incr j} {
9014 set dd [lindex $tomark $j]
9015 if {![info exists hastaggeddescendent($dd)]} {
9016 if {[info exists done($dd)]} {
9017 foreach b $arcout($dd) {
9018 if {[info exists arcend($b)]} {
9019 lappend tomark $arcend($b)
9022 if {[info exists tagloc($dd)]} {
9025 } elseif {[info exists queued($dd)]} {
9028 set hastaggeddescendent($dd) 1
9032 if {![info exists queued($d)]} {
9035 if {![info exists hastaggeddescendent($d)]} {
9041 set t2 [clock clicks -milliseconds]
9044 foreach id [array names tagloc] {
9045 if {![info exists hastaggeddescendent($id)]} {
9046 foreach t $tagloc($id) {
9047 if {[lsearch -exact $tags $t] < 0} {
9054 # remove tags that are ancestors of other tags
9055 for {set i 0} {$i < [llength $tags]} {incr i} {
9056 set a [lindex $tags $i]
9057 for {set j 0} {$j < $i} {incr j} {
9058 set b [lindex $tags $j]
9059 set r [anc_or_desc $a $b]
9061 set tags [lreplace $tags $j $j]
9064 } elseif {$r == 1} {
9065 set tags [lreplace $tags $i $i]
9072 if {[array names growing] ne {}} {
9073 # graph isn't finished, need to check if any tag could get
9074 # eclipsed by another tag coming later. Simply ignore any
9075 # tags that could later get eclipsed.
9078 if {[is_certain $origid $t]} {
9082 if {$tags eq $ctags} {
9083 set cached_atags($origid) $tags
9088 set cached_atags($origid) $tags
9090 set t3 [clock clicks -milliseconds]
9091 if {0 && $t3 - $t1 >= 100} {
9092 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9093 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9098 # Return the list of IDs that have heads that are descendents of id,
9099 # including id itself if it has a head.
9100 proc descheads {id} {
9101 global arcnos arcstart arcids archeads idheads cached_dheads
9104 if {![info exists allparents($id)]} {
9108 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9109 # part-way along an arc; check it first
9110 set a [lindex $arcnos($id) 0]
9111 if {$archeads($a) ne {}} {
9112 validate_archeads $a
9113 set i [lsearch -exact $arcids($a) $id]
9114 foreach t $archeads($a) {
9115 set j [lsearch -exact $arcids($a) $t]
9120 set id $arcstart($a)
9126 for {set i 0} {$i < [llength $todo]} {incr i} {
9127 set id [lindex $todo $i]
9128 if {[info exists cached_dheads($id)]} {
9129 set ret [concat $ret $cached_dheads($id)]
9131 if {[info exists idheads($id)]} {
9134 foreach a $arcnos($id) {
9135 if {$archeads($a) ne {}} {
9136 validate_archeads $a
9137 if {$archeads($a) ne {}} {
9138 set ret [concat $ret $archeads($a)]
9142 if {![info exists seen($d)]} {
9149 set ret [lsort -unique $ret]
9150 set cached_dheads($origid) $ret
9151 return [concat $ret $aret]
9154 proc addedtag {id} {
9155 global arcnos arcout cached_dtags cached_atags
9157 if {![info exists arcnos($id)]} return
9158 if {![info exists arcout($id)]} {
9159 recalcarc [lindex $arcnos($id) 0]
9161 catch {unset cached_dtags}
9162 catch {unset cached_atags}
9165 proc addedhead {hid head} {
9166 global arcnos arcout cached_dheads
9168 if {![info exists arcnos($hid)]} return
9169 if {![info exists arcout($hid)]} {
9170 recalcarc [lindex $arcnos($hid) 0]
9172 catch {unset cached_dheads}
9175 proc removedhead {hid head} {
9176 global cached_dheads
9178 catch {unset cached_dheads}
9181 proc movedhead {hid head} {
9182 global arcnos arcout cached_dheads
9184 if {![info exists arcnos($hid)]} return
9185 if {![info exists arcout($hid)]} {
9186 recalcarc [lindex $arcnos($hid) 0]
9188 catch {unset cached_dheads}
9191 proc changedrefs {} {
9192 global cached_dheads cached_dtags cached_atags
9193 global arctags archeads arcnos arcout idheads idtags
9195 foreach id [concat [array names idheads] [array names idtags]] {
9196 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9197 set a [lindex $arcnos($id) 0]
9198 if {![info exists donearc($a)]} {
9204 catch {unset cached_dtags}
9205 catch {unset cached_atags}
9206 catch {unset cached_dheads}
9209 proc rereadrefs {} {
9210 global idtags idheads idotherrefs mainheadid
9212 set refids [concat [array names idtags] \
9213 [array names idheads] [array names idotherrefs]]
9214 foreach id $refids {
9215 if {![info exists ref($id)]} {
9216 set ref($id) [listrefs $id]
9219 set oldmainhead $mainheadid
9222 set refids [lsort -unique [concat $refids [array names idtags] \
9223 [array names idheads] [array names idotherrefs]]]
9224 foreach id $refids {
9225 set v [listrefs $id]
9226 if {![info exists ref($id)] || $ref($id) != $v} {
9230 if {$oldmainhead ne $mainheadid} {
9231 redrawtags $oldmainhead
9232 redrawtags $mainheadid
9237 proc listrefs {id} {
9238 global idtags idheads idotherrefs
9241 if {[info exists idtags($id)]} {
9245 if {[info exists idheads($id)]} {
9249 if {[info exists idotherrefs($id)]} {
9250 set z $idotherrefs($id)
9252 return [list $x $y $z]
9255 proc showtag {tag isnew} {
9256 global ctext tagcontents tagids linknum tagobjid
9259 addtohistory [list showtag $tag 0]
9261 $ctext conf -state normal
9265 if {![info exists tagcontents($tag)]} {
9267 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9270 if {[info exists tagcontents($tag)]} {
9271 set text $tagcontents($tag)
9273 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
9275 appendwithlinks $text {}
9276 $ctext conf -state disabled
9288 if {[info exists gitktmpdir]} {
9289 catch {file delete -force $gitktmpdir}
9293 proc mkfontdisp {font top which} {
9294 global fontattr fontpref $font
9296 set fontpref($font) [set $font]
9297 button $top.${font}but -text $which -font optionfont \
9298 -command [list choosefont $font $which]
9299 label $top.$font -relief flat -font $font \
9300 -text $fontattr($font,family) -justify left
9301 grid x $top.${font}but $top.$font -sticky w
9304 proc choosefont {font which} {
9305 global fontparam fontlist fonttop fontattr
9307 set fontparam(which) $which
9308 set fontparam(font) $font
9309 set fontparam(family) [font actual $font -family]
9310 set fontparam(size) $fontattr($font,size)
9311 set fontparam(weight) $fontattr($font,weight)
9312 set fontparam(slant) $fontattr($font,slant)
9315 if {![winfo exists $top]} {
9317 eval font config sample [font actual $font]
9319 wm title $top [mc "Gitk font chooser"]
9320 label $top.l -textvariable fontparam(which)
9321 pack $top.l -side top
9322 set fontlist [lsort [font families]]
9324 listbox $top.f.fam -listvariable fontlist \
9325 -yscrollcommand [list $top.f.sb set]
9326 bind $top.f.fam <<ListboxSelect>> selfontfam
9327 scrollbar $top.f.sb -command [list $top.f.fam yview]
9328 pack $top.f.sb -side right -fill y
9329 pack $top.f.fam -side left -fill both -expand 1
9330 pack $top.f -side top -fill both -expand 1
9332 spinbox $top.g.size -from 4 -to 40 -width 4 \
9333 -textvariable fontparam(size) \
9334 -validatecommand {string is integer -strict %s}
9335 checkbutton $top.g.bold -padx 5 \
9336 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9337 -variable fontparam(weight) -onvalue bold -offvalue normal
9338 checkbutton $top.g.ital -padx 5 \
9339 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9340 -variable fontparam(slant) -onvalue italic -offvalue roman
9341 pack $top.g.size $top.g.bold $top.g.ital -side left
9342 pack $top.g -side top
9343 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9345 $top.c create text 100 25 -anchor center -text $which -font sample \
9346 -fill black -tags text
9347 bind $top.c <Configure> [list centertext $top.c]
9348 pack $top.c -side top -fill x
9350 button $top.buts.ok -text [mc "OK"] -command fontok -default active
9351 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9352 grid $top.buts.ok $top.buts.can
9353 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9354 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9355 pack $top.buts -side bottom -fill x
9356 trace add variable fontparam write chg_fontparam
9359 $top.c itemconf text -text $which
9361 set i [lsearch -exact $fontlist $fontparam(family)]
9363 $top.f.fam selection set $i
9368 proc centertext {w} {
9369 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9373 global fontparam fontpref prefstop
9375 set f $fontparam(font)
9376 set fontpref($f) [list $fontparam(family) $fontparam(size)]
9377 if {$fontparam(weight) eq "bold"} {
9378 lappend fontpref($f) "bold"
9380 if {$fontparam(slant) eq "italic"} {
9381 lappend fontpref($f) "italic"
9384 $w conf -text $fontparam(family) -font $fontpref($f)
9390 global fonttop fontparam
9392 if {[info exists fonttop]} {
9393 catch {destroy $fonttop}
9394 catch {font delete sample}
9400 proc selfontfam {} {
9401 global fonttop fontparam
9403 set i [$fonttop.f.fam curselection]
9405 set fontparam(family) [$fonttop.f.fam get $i]
9409 proc chg_fontparam {v sub op} {
9412 font config sample -$sub $fontparam($sub)
9416 global maxwidth maxgraphpct
9417 global oldprefs prefstop showneartags showlocalchanges
9418 global bgcolor fgcolor ctext diffcolors selectbgcolor
9419 global tabstop limitdiffs autoselect extdifftool perfile_attrs
9423 if {[winfo exists $top]} {
9427 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9428 limitdiffs tabstop perfile_attrs} {
9429 set oldprefs($v) [set $v]
9432 wm title $top [mc "Gitk preferences"]
9433 label $top.ldisp -text [mc "Commit list display options"]
9434 grid $top.ldisp - -sticky w -pady 10
9435 label $top.spacer -text " "
9436 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9438 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9439 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9440 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9442 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9443 grid x $top.maxpctl $top.maxpct -sticky w
9444 frame $top.showlocal
9445 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9446 checkbutton $top.showlocal.b -variable showlocalchanges
9447 pack $top.showlocal.b $top.showlocal.l -side left
9448 grid x $top.showlocal -sticky w
9449 frame $top.autoselect
9450 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9451 checkbutton $top.autoselect.b -variable autoselect
9452 pack $top.autoselect.b $top.autoselect.l -side left
9453 grid x $top.autoselect -sticky w
9455 label $top.ddisp -text [mc "Diff display options"]
9456 grid $top.ddisp - -sticky w -pady 10
9457 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9458 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9459 grid x $top.tabstopl $top.tabstop -sticky w
9461 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9462 checkbutton $top.ntag.b -variable showneartags
9463 pack $top.ntag.b $top.ntag.l -side left
9464 grid x $top.ntag -sticky w
9466 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9467 checkbutton $top.ldiff.b -variable limitdiffs
9468 pack $top.ldiff.b $top.ldiff.l -side left
9469 grid x $top.ldiff -sticky w
9471 label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
9472 checkbutton $top.lattr.b -variable perfile_attrs
9473 pack $top.lattr.b $top.lattr.l -side left
9474 grid x $top.lattr -sticky w
9476 entry $top.extdifft -textvariable extdifftool
9478 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9480 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9481 -command choose_extdiff
9482 pack $top.extdifff.l $top.extdifff.b -side left
9483 grid x $top.extdifff $top.extdifft -sticky w
9485 label $top.cdisp -text [mc "Colors: press to choose"]
9486 grid $top.cdisp - -sticky w -pady 10
9487 label $top.bg -padx 40 -relief sunk -background $bgcolor
9488 button $top.bgbut -text [mc "Background"] -font optionfont \
9489 -command [list choosecolor bgcolor {} $top.bg background setbg]
9490 grid x $top.bgbut $top.bg -sticky w
9491 label $top.fg -padx 40 -relief sunk -background $fgcolor
9492 button $top.fgbut -text [mc "Foreground"] -font optionfont \
9493 -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9494 grid x $top.fgbut $top.fg -sticky w
9495 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9496 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9497 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9498 [list $ctext tag conf d0 -foreground]]
9499 grid x $top.diffoldbut $top.diffold -sticky w
9500 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9501 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9502 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9503 [list $ctext tag conf d1 -foreground]]
9504 grid x $top.diffnewbut $top.diffnew -sticky w
9505 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9506 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9507 -command [list choosecolor diffcolors 2 $top.hunksep \
9508 "diff hunk header" \
9509 [list $ctext tag conf hunksep -foreground]]
9510 grid x $top.hunksepbut $top.hunksep -sticky w
9511 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9512 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9513 -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9514 grid x $top.selbgbut $top.selbgsep -sticky w
9516 label $top.cfont -text [mc "Fonts: press to choose"]
9517 grid $top.cfont - -sticky w -pady 10
9518 mkfontdisp mainfont $top [mc "Main font"]
9519 mkfontdisp textfont $top [mc "Diff display font"]
9520 mkfontdisp uifont $top [mc "User interface font"]
9523 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9524 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9525 grid $top.buts.ok $top.buts.can
9526 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9527 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9528 grid $top.buts - - -pady 10 -sticky ew
9529 bind $top <Visibility> "focus $top.buts.ok"
9532 proc choose_extdiff {} {
9535 set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9537 set extdifftool $prog
9541 proc choosecolor {v vi w x cmd} {
9544 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9545 -title [mc "Gitk: choose color for %s" $x]]
9546 if {$c eq {}} return
9547 $w conf -background $c
9553 global bglist cflist
9555 $w configure -selectbackground $c
9557 $cflist tag configure highlight \
9558 -background [$cflist cget -selectbackground]
9559 allcanvs itemconf secsel -fill $c
9566 $w conf -background $c
9574 $w conf -foreground $c
9576 allcanvs itemconf text -fill $c
9577 $canv itemconf circle -outline $c
9581 global oldprefs prefstop
9583 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9584 limitdiffs tabstop perfile_attrs} {
9586 set $v $oldprefs($v)
9588 catch {destroy $prefstop}
9594 global maxwidth maxgraphpct
9595 global oldprefs prefstop showneartags showlocalchanges
9596 global fontpref mainfont textfont uifont
9597 global limitdiffs treediffs perfile_attrs
9599 catch {destroy $prefstop}
9603 if {$mainfont ne $fontpref(mainfont)} {
9604 set mainfont $fontpref(mainfont)
9605 parsefont mainfont $mainfont
9606 eval font configure mainfont [fontflags mainfont]
9607 eval font configure mainfontbold [fontflags mainfont 1]
9611 if {$textfont ne $fontpref(textfont)} {
9612 set textfont $fontpref(textfont)
9613 parsefont textfont $textfont
9614 eval font configure textfont [fontflags textfont]
9615 eval font configure textfontbold [fontflags textfont 1]
9617 if {$uifont ne $fontpref(uifont)} {
9618 set uifont $fontpref(uifont)
9619 parsefont uifont $uifont
9620 eval font configure uifont [fontflags uifont]
9623 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9624 if {$showlocalchanges} {
9630 if {$limitdiffs != $oldprefs(limitdiffs) ||
9631 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
9632 # treediffs elements are limited by path;
9633 # won't have encodings cached if perfile_attrs was just turned on
9634 catch {unset treediffs}
9636 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9637 || $maxgraphpct != $oldprefs(maxgraphpct)} {
9639 } elseif {$showneartags != $oldprefs(showneartags) ||
9640 $limitdiffs != $oldprefs(limitdiffs)} {
9645 proc formatdate {d} {
9646 global datetimeformat
9648 set d [clock format $d -format $datetimeformat]
9653 # This list of encoding names and aliases is distilled from
9654 # http://www.iana.org/assignments/character-sets.
9655 # Not all of them are supported by Tcl.
9656 set encoding_aliases {
9657 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9658 ISO646-US US-ASCII us IBM367 cp367 csASCII }
9659 { ISO-10646-UTF-1 csISO10646UTF1 }
9660 { ISO_646.basic:1983 ref csISO646basic1983 }
9661 { INVARIANT csINVARIANT }
9662 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9663 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9664 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9665 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9666 { NATS-DANO iso-ir-9-1 csNATSDANO }
9667 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9668 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9669 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9670 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9671 { ISO-2022-KR csISO2022KR }
9673 { ISO-2022-JP csISO2022JP }
9674 { ISO-2022-JP-2 csISO2022JP2 }
9675 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9677 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9678 { IT iso-ir-15 ISO646-IT csISO15Italian }
9679 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9680 { ES iso-ir-17 ISO646-ES csISO17Spanish }
9681 { greek7-old iso-ir-18 csISO18Greek7Old }
9682 { latin-greek iso-ir-19 csISO19LatinGreek }
9683 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9684 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9685 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9686 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9687 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9688 { BS_viewdata iso-ir-47 csISO47BSViewdata }
9689 { INIS iso-ir-49 csISO49INIS }
9690 { INIS-8 iso-ir-50 csISO50INIS8 }
9691 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9692 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9693 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9694 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9695 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9696 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9698 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9699 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9700 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9701 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9702 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9703 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9704 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9705 { greek7 iso-ir-88 csISO88Greek7 }
9706 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9707 { iso-ir-90 csISO90 }
9708 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9709 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9710 csISO92JISC62991984b }
9711 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9712 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9713 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9714 csISO95JIS62291984handadd }
9715 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9716 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9717 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9718 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9720 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9721 { T.61-7bit iso-ir-102 csISO102T617bit }
9722 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9723 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9724 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9725 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9726 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9727 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9728 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9729 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9730 arabic csISOLatinArabic }
9731 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9732 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9733 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9734 greek greek8 csISOLatinGreek }
9735 { T.101-G2 iso-ir-128 csISO128T101G2 }
9736 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9738 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9739 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9740 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9741 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9742 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9743 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9744 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9745 csISOLatinCyrillic }
9746 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9747 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9748 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9749 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9750 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9751 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9752 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9753 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9754 { ISO_10367-box iso-ir-155 csISO10367Box }
9755 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9756 { latin-lap lap iso-ir-158 csISO158Lap }
9757 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9758 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9761 { JIS_X0201 X0201 csHalfWidthKatakana }
9762 { KSC5636 ISO646-KR csKSC5636 }
9763 { ISO-10646-UCS-2 csUnicode }
9764 { ISO-10646-UCS-4 csUCS4 }
9765 { DEC-MCS dec csDECMCS }
9766 { hp-roman8 roman8 r8 csHPRoman8 }
9767 { macintosh mac csMacintosh }
9768 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9770 { IBM038 EBCDIC-INT cp038 csIBM038 }
9771 { IBM273 CP273 csIBM273 }
9772 { IBM274 EBCDIC-BE CP274 csIBM274 }
9773 { IBM275 EBCDIC-BR cp275 csIBM275 }
9774 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9775 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9776 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9777 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9778 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9779 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9780 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9781 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9782 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9783 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9784 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9785 { IBM437 cp437 437 csPC8CodePage437 }
9786 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9787 { IBM775 cp775 csPC775Baltic }
9788 { IBM850 cp850 850 csPC850Multilingual }
9789 { IBM851 cp851 851 csIBM851 }
9790 { IBM852 cp852 852 csPCp852 }
9791 { IBM855 cp855 855 csIBM855 }
9792 { IBM857 cp857 857 csIBM857 }
9793 { IBM860 cp860 860 csIBM860 }
9794 { IBM861 cp861 861 cp-is csIBM861 }
9795 { IBM862 cp862 862 csPC862LatinHebrew }
9796 { IBM863 cp863 863 csIBM863 }
9797 { IBM864 cp864 csIBM864 }
9798 { IBM865 cp865 865 csIBM865 }
9799 { IBM866 cp866 866 csIBM866 }
9800 { IBM868 CP868 cp-ar csIBM868 }
9801 { IBM869 cp869 869 cp-gr csIBM869 }
9802 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9803 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9804 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9805 { IBM891 cp891 csIBM891 }
9806 { IBM903 cp903 csIBM903 }
9807 { IBM904 cp904 904 csIBBM904 }
9808 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9809 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9810 { IBM1026 CP1026 csIBM1026 }
9811 { EBCDIC-AT-DE csIBMEBCDICATDE }
9812 { EBCDIC-AT-DE-A csEBCDICATDEA }
9813 { EBCDIC-CA-FR csEBCDICCAFR }
9814 { EBCDIC-DK-NO csEBCDICDKNO }
9815 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9816 { EBCDIC-FI-SE csEBCDICFISE }
9817 { EBCDIC-FI-SE-A csEBCDICFISEA }
9818 { EBCDIC-FR csEBCDICFR }
9819 { EBCDIC-IT csEBCDICIT }
9820 { EBCDIC-PT csEBCDICPT }
9821 { EBCDIC-ES csEBCDICES }
9822 { EBCDIC-ES-A csEBCDICESA }
9823 { EBCDIC-ES-S csEBCDICESS }
9824 { EBCDIC-UK csEBCDICUK }
9825 { EBCDIC-US csEBCDICUS }
9826 { UNKNOWN-8BIT csUnknown8BiT }
9827 { MNEMONIC csMnemonic }
9832 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9833 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9834 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9835 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9836 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9837 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9838 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9839 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9840 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9841 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9842 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9843 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9844 { IBM1047 IBM-1047 }
9845 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9846 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9847 { UNICODE-1-1 csUnicode11 }
9850 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9851 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9853 { ISO-8859-15 ISO_8859-15 Latin-9 }
9854 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9855 { GBK CP936 MS936 windows-936 }
9856 { JIS_Encoding csJISEncoding }
9857 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
9858 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9860 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9861 { ISO-10646-UCS-Basic csUnicodeASCII }
9862 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9863 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9864 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9865 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9866 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9867 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9868 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9869 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9870 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9871 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9872 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9873 { Ventura-US csVenturaUS }
9874 { Ventura-International csVenturaInternational }
9875 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9876 { PC8-Turkish csPC8Turkish }
9877 { IBM-Symbols csIBMSymbols }
9878 { IBM-Thai csIBMThai }
9879 { HP-Legal csHPLegal }
9880 { HP-Pi-font csHPPiFont }
9881 { HP-Math8 csHPMath8 }
9882 { Adobe-Symbol-Encoding csHPPSMath }
9883 { HP-DeskTop csHPDesktop }
9884 { Ventura-Math csVenturaMath }
9885 { Microsoft-Publishing csMicrosoftPublishing }
9886 { Windows-31J csWindows31J }
9891 proc tcl_encoding {enc} {
9892 global encoding_aliases tcl_encoding_cache
9893 if {[info exists tcl_encoding_cache($enc)]} {
9894 return $tcl_encoding_cache($enc)
9896 set names [encoding names]
9897 set lcnames [string tolower $names]
9898 set enc [string tolower $enc]
9899 set i [lsearch -exact $lcnames $enc]
9901 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9902 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
9903 set i [lsearch -exact $lcnames $encx]
9907 foreach l $encoding_aliases {
9908 set ll [string tolower $l]
9909 if {[lsearch -exact $ll $enc] < 0} continue
9910 # look through the aliases for one that tcl knows about
9912 set i [lsearch -exact $lcnames $e]
9914 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
9915 set i [lsearch -exact $lcnames $ex]
9925 set tclenc [lindex $names $i]
9927 set tcl_encoding_cache($enc) $tclenc
9931 proc gitattr {path attr default} {
9932 global path_attr_cache
9933 if {[info exists path_attr_cache($attr,$path)]} {
9934 set r $path_attr_cache($attr,$path)
9937 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
9938 regexp "(.*): encoding: (.*)" $line m f r
9940 set path_attr_cache($attr,$path) $r
9942 if {$r eq "unspecified"} {
9948 proc cache_gitattr {attr pathlist} {
9949 global path_attr_cache
9951 foreach path $pathlist {
9952 if {![info exists path_attr_cache($attr,$path)]} {
9953 lappend newlist $path
9957 if {[tk windowingsystem] == "win32"} {
9958 # windows has a 32k limit on the arguments to a command...
9961 while {$newlist ne {}} {
9962 set head [lrange $newlist 0 [expr {$lim - 1}]]
9963 set newlist [lrange $newlist $lim end]
9964 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
9965 foreach row [split $rlist "\n"] {
9966 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
9967 if {[string index $path 0] eq "\""} {
9968 set path [encoding convertfrom [lindex $path 0]]
9970 set path_attr_cache($attr,$path) $value
9977 proc get_path_encoding {path} {
9978 global gui_encoding perfile_attrs
9979 set tcl_enc $gui_encoding
9980 if {$path ne {} && $perfile_attrs} {
9981 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
9989 # First check that Tcl/Tk is recent enough
9990 if {[catch {package require Tk 8.4} err]} {
9991 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9992 Gitk requires at least Tcl/Tk 8.4."]
9997 set wrcomcmd "git diff-tree --stdin -p --pretty"
10001 set gitencoding [exec git config --get i18n.commitencoding]
10003 if {$gitencoding == ""} {
10004 set gitencoding "utf-8"
10006 set tclencoding [tcl_encoding $gitencoding]
10007 if {$tclencoding == {}} {
10008 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10011 set gui_encoding [encoding system]
10013 set enc [exec git config --get gui.encoding]
10015 set tclenc [tcl_encoding $enc]
10016 if {$tclenc ne {}} {
10017 set gui_encoding $tclenc
10019 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10024 set mainfont {Helvetica 9}
10025 set textfont {Courier 9}
10026 set uifont {Helvetica 9 bold}
10028 set findmergefiles 0
10036 set cmitmode "patch"
10037 set wrapcomment "none"
10041 set showlocalchanges 1
10043 set datetimeformat "%Y-%m-%d %H:%M:%S"
10045 set perfile_attrs 0
10047 set extdifftool "meld"
10049 set colors {green red blue magenta darkgrey brown orange}
10052 set diffcolors {red "#00a000" blue}
10055 set selectbgcolor gray85
10057 set circlecolors {white blue gray blue blue}
10059 # button for popping up context menus
10060 if {[tk windowingsystem] eq "aqua"} {
10061 set ctxbut <Button-2>
10063 set ctxbut <Button-3>
10066 ## For msgcat loading, first locate the installation location.
10067 if { [info exists ::env(GITK_MSGSDIR)] } {
10068 ## Msgsdir was manually set in the environment.
10069 set gitk_msgsdir $::env(GITK_MSGSDIR)
10071 ## Let's guess the prefix from argv0.
10072 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10073 set gitk_libdir [file join $gitk_prefix share gitk lib]
10074 set gitk_msgsdir [file join $gitk_libdir msgs]
10078 ## Internationalization (i18n) through msgcat and gettext. See
10079 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10080 package require msgcat
10081 namespace import ::msgcat::mc
10082 ## And eventually load the actual message catalog
10083 ::msgcat::mcload $gitk_msgsdir
10085 catch {source ~/.gitk}
10087 font create optionfont -family sans-serif -size -12
10089 parsefont mainfont $mainfont
10090 eval font create mainfont [fontflags mainfont]
10091 eval font create mainfontbold [fontflags mainfont 1]
10093 parsefont textfont $textfont
10094 eval font create textfont [fontflags textfont]
10095 eval font create textfontbold [fontflags textfont 1]
10097 parsefont uifont $uifont
10098 eval font create uifont [fontflags uifont]
10102 # check that we can find a .git directory somewhere...
10103 if {[catch {set gitdir [gitdir]}]} {
10104 show_error {} . [mc "Cannot find a git repository here."]
10107 if {![file isdirectory $gitdir]} {
10108 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10113 set selectheadid {}
10116 set cmdline_files {}
10118 set revtreeargscmd {}
10119 foreach arg $argv {
10120 switch -glob -- $arg {
10123 set cmdline_files [lrange $argv [expr {$i + 1}] end]
10126 "--select-commit=*" {
10127 set selecthead [string range $arg 16 end]
10130 set revtreeargscmd [string range $arg 10 end]
10133 lappend revtreeargs $arg
10139 if {$selecthead eq "HEAD"} {
10143 if {$i >= [llength $argv] && $revtreeargs ne {}} {
10144 # no -- on command line, but some arguments (other than --argscmd)
10146 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10147 set cmdline_files [split $f "\n"]
10148 set n [llength $cmdline_files]
10149 set revtreeargs [lrange $revtreeargs 0 end-$n]
10150 # Unfortunately git rev-parse doesn't produce an error when
10151 # something is both a revision and a filename. To be consistent
10152 # with git log and git rev-list, check revtreeargs for filenames.
10153 foreach arg $revtreeargs {
10154 if {[file exists $arg]} {
10155 show_error {} . [mc "Ambiguous argument '%s': both revision\
10156 and filename" $arg]
10161 # unfortunately we get both stdout and stderr in $err,
10162 # so look for "fatal:".
10163 set i [string first "fatal:" $err]
10165 set err [string range $err [expr {$i + 6}] end]
10167 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10172 set nullid "0000000000000000000000000000000000000000"
10173 set nullid2 "0000000000000000000000000000000000000001"
10174 set nullfile "/dev/null"
10176 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10183 set highlight_paths {}
10185 set searchdirn -forwards
10187 set boldnamerows {}
10188 set diffelide {0 0}
10189 set markingmatches 0
10190 set linkentercount 0
10191 set need_redisplay 0
10198 set selectedhlview [mc "None"]
10199 set highlight_related [mc "None"]
10200 set highlight_files {}
10201 set viewfiles(0) {}
10204 set viewargscmd(0) {}
10206 set selectedline {}
10214 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10217 # wait for the window to become visible
10218 tkwait visibility .
10219 wm title . "[file tail $argv0]: [file tail [pwd]]"
10222 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10223 # create a view for the files/dirs specified on the command line
10227 set viewname(1) [mc "Command line"]
10228 set viewfiles(1) $cmdline_files
10229 set viewargs(1) $revtreeargs
10230 set viewargscmd(1) $revtreeargscmd
10234 .bar.view entryconf [mca "Edit view..."] -state normal
10235 .bar.view entryconf [mca "Delete view"] -state normal
10238 if {[info exists permviews]} {
10239 foreach v $permviews {
10242 set viewname($n) [lindex $v 0]
10243 set viewfiles($n) [lindex $v 1]
10244 set viewargs($n) [lindex $v 2]
10245 set viewargscmd($n) [lindex $v 3]