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]
159 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
160 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
161 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
162 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
163 "--ignore-space-change" - "-U*" - "--unified=*" {
164 # These request or affect diff output, which we don't want.
165 # Some could be used to set our defaults for diff display.
166 lappend diffargs
$arg
168 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
169 "--name-only" - "--name-status" - "--color" - "--color-words" -
170 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
171 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
172 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
173 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
174 "--objects" - "--objects-edge" - "--reverse" {
175 # These cause our parsing of git log's output to fail, or else
176 # they're options we want to set ourselves, so ignore them.
178 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
179 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
180 "--full-history" - "--dense" - "--sparse" -
181 "--follow" - "--left-right" - "--encoding=*" {
182 # These are harmless, and some are even useful
185 "--diff-filter=*" - "--no-merges" - "--unpacked" -
186 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
187 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
188 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
189 "--remove-empty" - "--first-parent" - "--cherry-pick" -
190 "-S*" - "--pickaxe-all" - "--pickaxe-regex" {
191 # These mean that we get a subset of the commits
196 # This appears to be the only one that has a value as a
197 # separate word following it
207 # git rev-parse doesn't understand --merge
208 lappend revargs
--gitk-symmetric-diff-marker MERGE_HEAD...HEAD
211 # Other flag arguments including -<n>
212 if {[string is digit
-strict [string range
$arg 1 end
]]} {
215 # a flag argument that we don't recognize;
216 # that means we can't optimize
222 # Non-flag arguments specify commits or ranges of commits
223 if {[string match
"*...*" $arg]} {
224 lappend revargs
--gitk-symmetric-diff-marker
230 set vdflags
($n) $diffargs
231 set vflags
($n) $glflags
232 set vrevs
($n) $revargs
233 set vfiltered
($n) $filtered
234 set vorigargs
($n) $origargs
238 proc parseviewrevs
{view revs
} {
239 global vposids vnegids
244 if {[catch
{set ids
[eval exec git rev-parse
$revs]} err
]} {
245 # we get stdout followed by stderr in $err
246 # for an unknown rev, git rev-parse echoes it and then errors out
247 set errlines
[split $err "\n"]
249 for {set l
0} {$l < [llength
$errlines]} {incr l
} {
250 set line
[lindex
$errlines $l]
251 if {!([string length
$line] == 40 && [string is xdigit
$line])} {
252 if {[string match
"fatal:*" $line]} {
253 if {[string match
"fatal: ambiguous argument*" $line]
255 if {[llength
$badrev] == 1} {
256 set err
"unknown revision $badrev"
258 set err
"unknown revisions: [join $badrev ", "]"
261 set err
[join [lrange
$errlines $l end
] "\n"]
268 error_popup
"[mc "Error parsing revisions
:"] $err"
275 foreach id
[split $ids "\n"] {
276 if {$id eq
"--gitk-symmetric-diff-marker"} {
278 } elseif
{[string match
"^*" $id]} {
285 lappend neg
[string range
$id 1 end
]
290 lset ret end
[lindex
$ret end
]...
$id
296 set vposids
($view) $pos
297 set vnegids
($view) $neg
301 # Start off a git log process and arrange to read its output
302 proc start_rev_list
{view
} {
303 global startmsecs commitidx viewcomplete curview
305 global viewargs viewargscmd viewfiles vfilelimit
306 global showlocalchanges
307 global viewactive viewinstances vmergeonly
308 global mainheadid viewmainheadid viewmainheadid_orig
309 global vcanopt vflags vrevs vorigargs
311 set startmsecs
[clock clicks
-milliseconds]
312 set commitidx
($view) 0
313 # these are set this way for the error exits
314 set viewcomplete
($view) 1
315 set viewactive
($view) 0
318 set args
$viewargs($view)
319 if {$viewargscmd($view) ne
{}} {
321 set str
[exec sh
-c $viewargscmd($view)]
323 error_popup
"[mc "Error executing
--argscmd command:"] $err"
326 set args
[concat
$args [split $str "\n"]]
328 set vcanopt
($view) [parseviewargs
$view $args]
330 set files
$viewfiles($view)
331 if {$vmergeonly($view)} {
332 set files
[unmerged_files
$files]
335 if {$nr_unmerged == 0} {
336 error_popup
[mc
"No files selected: --merge specified but\
337 no files are unmerged."]
339 error_popup
[mc
"No files selected: --merge specified but\
340 no unmerged files are within file limit."]
345 set vfilelimit
($view) $files
347 if {$vcanopt($view)} {
348 set revs
[parseviewrevs
$view $vrevs($view)]
352 set args
[concat
$vflags($view) $revs]
354 set args
$vorigargs($view)
358 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
359 --boundary $args "--" $files] r
]
361 error_popup
"[mc "Error executing git log
:"] $err"
364 set i
[reg_instance
$fd]
365 set viewinstances
($view) [list
$i]
366 set viewmainheadid
($view) $mainheadid
367 set viewmainheadid_orig
($view) $mainheadid
368 if {$files ne
{} && $mainheadid ne
{}} {
369 get_viewmainhead
$view
371 if {$showlocalchanges && $viewmainheadid($view) ne
{}} {
372 interestedin
$viewmainheadid($view) dodiffindex
374 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
375 if {$tclencoding != {}} {
376 fconfigure
$fd -encoding $tclencoding
378 filerun
$fd [list getcommitlines
$fd $i $view 0]
379 nowbusy
$view [mc
"Reading"]
380 set viewcomplete
($view) 0
381 set viewactive
($view) 1
385 proc stop_instance
{inst
} {
386 global commfd leftover
388 set fd
$commfd($inst)
392 if {$
::tcl_platform
(platform
) eq
{windows
}} {
401 unset leftover
($inst)
404 proc stop_backends
{} {
407 foreach inst
[array names commfd
] {
412 proc stop_rev_list
{view
} {
415 foreach inst
$viewinstances($view) {
418 set viewinstances
($view) {}
421 proc reset_pending_select
{selid
} {
422 global pending_select mainheadid selectheadid
425 set pending_select
$selid
426 } elseif
{$selectheadid ne
{}} {
427 set pending_select
$selectheadid
429 set pending_select
$mainheadid
433 proc getcommits
{selid
} {
434 global canv curview need_redisplay viewactive
437 if {[start_rev_list
$curview]} {
438 reset_pending_select
$selid
439 show_status
[mc
"Reading commits..."]
442 show_status
[mc
"No commits selected"]
446 proc updatecommits
{} {
447 global curview vcanopt vorigargs vfilelimit viewinstances
448 global viewactive viewcomplete tclencoding
449 global startmsecs showneartags showlocalchanges
450 global mainheadid viewmainheadid viewmainheadid_orig pending_select
452 global varcid vposids vnegids vflags vrevs
454 set isworktree
[expr {[exec git rev-parse
--is-inside-work-tree] == "true"}]
457 if {$mainheadid ne
$viewmainheadid_orig($view)} {
458 if {$showlocalchanges} {
461 set viewmainheadid
($view) $mainheadid
462 set viewmainheadid_orig
($view) $mainheadid
463 if {$vfilelimit($view) ne
{}} {
464 get_viewmainhead
$view
467 if {$showlocalchanges} {
470 if {$vcanopt($view)} {
471 set oldpos
$vposids($view)
472 set oldneg
$vnegids($view)
473 set revs
[parseviewrevs
$view $vrevs($view)]
477 # note: getting the delta when negative refs change is hard,
478 # and could require multiple git log invocations, so in that
479 # case we ask git log for all the commits (not just the delta)
480 if {$oldneg eq
$vnegids($view)} {
483 # take out positive refs that we asked for before or
484 # that we have already seen
486 if {[string length
$rev] == 40} {
487 if {[lsearch
-exact $oldpos $rev] < 0
488 && ![info exists varcid
($view,$rev)]} {
493 lappend
$newrevs $rev
496 if {$npos == 0} return
498 set vposids
($view) [lsort
-unique [concat
$oldpos $vposids($view)]]
500 set args
[concat
$vflags($view) $revs --not $oldpos]
502 set args
$vorigargs($view)
505 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
506 --boundary $args "--" $vfilelimit($view)] r
]
508 error_popup
"[mc "Error executing git log
:"] $err"
511 if {$viewactive($view) == 0} {
512 set startmsecs
[clock clicks
-milliseconds]
514 set i
[reg_instance
$fd]
515 lappend viewinstances
($view) $i
516 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
517 if {$tclencoding != {}} {
518 fconfigure
$fd -encoding $tclencoding
520 filerun
$fd [list getcommitlines
$fd $i $view 1]
521 incr viewactive
($view)
522 set viewcomplete
($view) 0
523 reset_pending_select
{}
524 nowbusy
$view [mc
"Reading"]
530 proc reloadcommits
{} {
531 global curview viewcomplete selectedline currentid thickerline
532 global showneartags treediffs commitinterest cached_commitrow
536 if {$selectedline ne
{}} {
540 if {!$viewcomplete($curview)} {
541 stop_rev_list
$curview
545 catch
{unset currentid
}
546 catch
{unset thickerline
}
547 catch
{unset treediffs
}
554 catch
{unset commitinterest
}
555 catch
{unset cached_commitrow
}
556 catch
{unset targetid
}
562 # This makes a string representation of a positive integer which
563 # sorts as a string in numerical order
566 return [format
"%x" $n]
567 } elseif
{$n < 256} {
568 return [format
"x%.2x" $n]
569 } elseif
{$n < 65536} {
570 return [format
"y%.4x" $n]
572 return [format
"z%.8x" $n]
575 # Procedures used in reordering commits from git log (without
576 # --topo-order) into the order for display.
578 proc varcinit
{view
} {
579 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
580 global vtokmod varcmod vrowmod varcix vlastins
582 set varcstart
($view) {{}}
583 set vupptr
($view) {0}
584 set vdownptr
($view) {0}
585 set vleftptr
($view) {0}
586 set vbackptr
($view) {0}
587 set varctok
($view) {{}}
588 set varcrow
($view) {{}}
589 set vtokmod
($view) {}
592 set varcix
($view) {{}}
593 set vlastins
($view) {0}
596 proc resetvarcs
{view
} {
597 global varcid varccommits parents children vseedcount ordertok
599 foreach vid
[array names varcid
$view,*] {
604 # some commits might have children but haven't been seen yet
605 foreach vid
[array names children
$view,*] {
608 foreach va
[array names varccommits
$view,*] {
609 unset varccommits
($va)
611 foreach vd
[array names vseedcount
$view,*] {
612 unset vseedcount
($vd)
614 catch
{unset ordertok
}
617 # returns a list of the commits with no children
619 global vdownptr vleftptr varcstart
622 set a
[lindex
$vdownptr($v) 0]
624 lappend ret
[lindex
$varcstart($v) $a]
625 set a
[lindex
$vleftptr($v) $a]
630 proc newvarc
{view id
} {
631 global varcid varctok parents children vdatemode
632 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
633 global commitdata commitinfo vseedcount varccommits vlastins
635 set a
[llength
$varctok($view)]
637 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
638 if {![info exists commitinfo
($id)]} {
639 parsecommit
$id $commitdata($id) 1
641 set cdate
[lindex
$commitinfo($id) 4]
642 if {![string is integer
-strict $cdate]} {
645 if {![info exists vseedcount
($view,$cdate)]} {
646 set vseedcount
($view,$cdate) -1
648 set c
[incr vseedcount
($view,$cdate)]
649 set cdate
[expr {$cdate ^
0xffffffff}]
650 set tok
"s[strrep $cdate][strrep $c]"
655 if {[llength
$children($vid)] > 0} {
656 set kid
[lindex
$children($vid) end
]
657 set k
$varcid($view,$kid)
658 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
661 set tok
[lindex
$varctok($view) $k]
665 set i
[lsearch
-exact $parents($view,$ki) $id]
666 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
667 append tok
[strrep
$j]
669 set c
[lindex
$vlastins($view) $ka]
670 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
672 set b
[lindex
$vdownptr($view) $ka]
674 set b
[lindex
$vleftptr($view) $c]
676 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
678 set b
[lindex
$vleftptr($view) $c]
681 lset vdownptr
($view) $ka $a
682 lappend vbackptr
($view) 0
684 lset vleftptr
($view) $c $a
685 lappend vbackptr
($view) $c
687 lset vlastins
($view) $ka $a
688 lappend vupptr
($view) $ka
689 lappend vleftptr
($view) $b
691 lset vbackptr
($view) $b $a
693 lappend varctok
($view) $tok
694 lappend varcstart
($view) $id
695 lappend vdownptr
($view) 0
696 lappend varcrow
($view) {}
697 lappend varcix
($view) {}
698 set varccommits
($view,$a) {}
699 lappend vlastins
($view) 0
703 proc splitvarc
{p v
} {
704 global varcid varcstart varccommits varctok vtokmod
705 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
707 set oa
$varcid($v,$p)
708 set otok
[lindex
$varctok($v) $oa]
709 set ac
$varccommits($v,$oa)
710 set i
[lsearch
-exact $varccommits($v,$oa) $p]
712 set na
[llength
$varctok($v)]
713 # "%" sorts before "0"...
714 set tok
"$otok%[strrep $i]"
715 lappend varctok
($v) $tok
716 lappend varcrow
($v) {}
717 lappend varcix
($v) {}
718 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
719 set varccommits
($v,$na) [lrange
$ac $i end
]
720 lappend varcstart
($v) $p
721 foreach id
$varccommits($v,$na) {
722 set varcid
($v,$id) $na
724 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
725 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
726 lset vdownptr
($v) $oa $na
727 lset vlastins
($v) $oa 0
728 lappend vupptr
($v) $oa
729 lappend vleftptr
($v) 0
730 lappend vbackptr
($v) 0
731 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
732 lset vupptr
($v) $b $na
734 if {[string compare
$otok $vtokmod($v)] <= 0} {
739 proc renumbervarc
{a v
} {
740 global parents children varctok varcstart varccommits
741 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
743 set t1
[clock clicks
-milliseconds]
749 if {[info exists isrelated
($a)]} {
751 set id
[lindex
$varccommits($v,$a) end
]
752 foreach p
$parents($v,$id) {
753 if {[info exists varcid
($v,$p)]} {
754 set isrelated
($varcid($v,$p)) 1
759 set b
[lindex
$vdownptr($v) $a]
762 set b
[lindex
$vleftptr($v) $a]
764 set a
[lindex
$vupptr($v) $a]
770 if {![info exists kidchanged
($a)]} continue
771 set id
[lindex
$varcstart($v) $a]
772 if {[llength
$children($v,$id)] > 1} {
773 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
776 set oldtok
[lindex
$varctok($v) $a]
777 if {!$vdatemode($v)} {
783 set kid
[last_real_child
$v,$id]
785 set k
$varcid($v,$kid)
786 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
789 set tok
[lindex
$varctok($v) $k]
793 set i
[lsearch
-exact $parents($v,$ki) $id]
794 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
795 append tok
[strrep
$j]
797 if {$tok eq
$oldtok} {
800 set id
[lindex
$varccommits($v,$a) end
]
801 foreach p
$parents($v,$id) {
802 if {[info exists varcid
($v,$p)]} {
803 set kidchanged
($varcid($v,$p)) 1
808 lset varctok
($v) $a $tok
809 set b
[lindex
$vupptr($v) $a]
811 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
814 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
817 set c
[lindex
$vbackptr($v) $a]
818 set d
[lindex
$vleftptr($v) $a]
820 lset vdownptr
($v) $b $d
822 lset vleftptr
($v) $c $d
825 lset vbackptr
($v) $d $c
827 if {[lindex
$vlastins($v) $b] == $a} {
828 lset vlastins
($v) $b $c
830 lset vupptr
($v) $a $ka
831 set c
[lindex
$vlastins($v) $ka]
833 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
835 set b
[lindex
$vdownptr($v) $ka]
837 set b
[lindex
$vleftptr($v) $c]
840 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
842 set b
[lindex
$vleftptr($v) $c]
845 lset vdownptr
($v) $ka $a
846 lset vbackptr
($v) $a 0
848 lset vleftptr
($v) $c $a
849 lset vbackptr
($v) $a $c
851 lset vleftptr
($v) $a $b
853 lset vbackptr
($v) $b $a
855 lset vlastins
($v) $ka $a
858 foreach id
[array names sortkids
] {
859 if {[llength
$children($v,$id)] > 1} {
860 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
864 set t2
[clock clicks
-milliseconds]
865 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
868 # Fix up the graph after we have found out that in view $v,
869 # $p (a commit that we have already seen) is actually the parent
870 # of the last commit in arc $a.
871 proc fix_reversal
{p a v
} {
872 global varcid varcstart varctok vupptr
874 set pa
$varcid($v,$p)
875 if {$p ne
[lindex
$varcstart($v) $pa]} {
877 set pa
$varcid($v,$p)
879 # seeds always need to be renumbered
880 if {[lindex
$vupptr($v) $pa] == 0 ||
881 [string compare
[lindex
$varctok($v) $a] \
882 [lindex
$varctok($v) $pa]] > 0} {
887 proc insertrow
{id p v
} {
888 global cmitlisted children parents varcid varctok vtokmod
889 global varccommits ordertok commitidx numcommits curview
890 global targetid targetrow
894 set cmitlisted
($vid) 1
895 set children
($vid) {}
896 set parents
($vid) [list
$p]
897 set a
[newvarc
$v $id]
899 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
902 lappend varccommits
($v,$a) $id
904 if {[llength
[lappend children
($vp) $id]] > 1} {
905 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
906 catch
{unset ordertok
}
908 fix_reversal
$p $a $v
910 if {$v == $curview} {
911 set numcommits
$commitidx($v)
913 if {[info exists targetid
]} {
914 if {![comes_before
$targetid $p]} {
921 proc insertfakerow
{id p
} {
922 global varcid varccommits parents children cmitlisted
923 global commitidx varctok vtokmod targetid targetrow curview numcommits
927 set i
[lsearch
-exact $varccommits($v,$a) $p]
929 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
932 set children
($v,$id) {}
933 set parents
($v,$id) [list
$p]
934 set varcid
($v,$id) $a
935 lappend children
($v,$p) $id
936 set cmitlisted
($v,$id) 1
937 set numcommits
[incr commitidx
($v)]
938 # note we deliberately don't update varcstart($v) even if $i == 0
939 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
941 if {[info exists targetid
]} {
942 if {![comes_before
$targetid $p]} {
950 proc removefakerow
{id
} {
951 global varcid varccommits parents children commitidx
952 global varctok vtokmod cmitlisted currentid selectedline
953 global targetid curview numcommits
956 if {[llength
$parents($v,$id)] != 1} {
957 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
960 set p
[lindex
$parents($v,$id) 0]
961 set a
$varcid($v,$id)
962 set i
[lsearch
-exact $varccommits($v,$a) $id]
964 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
968 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
969 unset parents
($v,$id)
970 unset children
($v,$id)
971 unset cmitlisted
($v,$id)
972 set numcommits
[incr commitidx
($v) -1]
973 set j
[lsearch
-exact $children($v,$p) $id]
975 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
978 if {[info exist currentid
] && $id eq
$currentid} {
982 if {[info exists targetid
] && $targetid eq
$id} {
989 proc first_real_child
{vp
} {
990 global children nullid nullid2
992 foreach id
$children($vp) {
993 if {$id ne
$nullid && $id ne
$nullid2} {
1000 proc last_real_child
{vp
} {
1001 global children nullid nullid2
1003 set kids
$children($vp)
1004 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
1005 set id
[lindex
$kids $i]
1006 if {$id ne
$nullid && $id ne
$nullid2} {
1013 proc vtokcmp
{v a b
} {
1014 global varctok varcid
1016 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1017 [lindex
$varctok($v) $varcid($v,$b)]]
1020 # This assumes that if lim is not given, the caller has checked that
1021 # arc a's token is less than $vtokmod($v)
1022 proc modify_arc
{v a
{lim
{}}} {
1023 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1026 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
1029 set r
[lindex
$varcrow($v) $a]
1030 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
1033 set vtokmod
($v) [lindex
$varctok($v) $a]
1035 if {$v == $curview} {
1036 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
1037 set a
[lindex
$vupptr($v) $a]
1043 set lim
[llength
$varccommits($v,$a)]
1045 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
1052 proc update_arcrows
{v
} {
1053 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1054 global varcid vrownum varcorder varcix varccommits
1055 global vupptr vdownptr vleftptr varctok
1056 global displayorder parentlist curview cached_commitrow
1058 if {$vrowmod($v) == $commitidx($v)} return
1059 if {$v == $curview} {
1060 if {[llength
$displayorder] > $vrowmod($v)} {
1061 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
1062 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
1064 catch
{unset cached_commitrow
}
1066 set narctot
[expr {[llength
$varctok($v)] - 1}]
1068 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
1069 # go up the tree until we find something that has a row number,
1070 # or we get to a seed
1071 set a
[lindex
$vupptr($v) $a]
1074 set a
[lindex
$vdownptr($v) 0]
1077 set varcorder
($v) [list
$a]
1078 lset varcix
($v) $a 0
1079 lset varcrow
($v) $a 0
1083 set arcn
[lindex
$varcix($v) $a]
1084 if {[llength
$vrownum($v)] > $arcn + 1} {
1085 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
1086 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
1088 set row
[lindex
$varcrow($v) $a]
1092 incr row
[llength
$varccommits($v,$a)]
1093 # go down if possible
1094 set b
[lindex
$vdownptr($v) $a]
1096 # if not, go left, or go up until we can go left
1098 set b
[lindex
$vleftptr($v) $a]
1100 set a
[lindex
$vupptr($v) $a]
1106 lappend vrownum
($v) $row
1107 lappend varcorder
($v) $a
1108 lset varcix
($v) $a $arcn
1109 lset varcrow
($v) $a $row
1111 set vtokmod
($v) [lindex
$varctok($v) $p]
1113 set vrowmod
($v) $row
1114 if {[info exists currentid
]} {
1115 set selectedline
[rowofcommit
$currentid]
1119 # Test whether view $v contains commit $id
1120 proc commitinview
{id v
} {
1123 return [info exists varcid
($v,$id)]
1126 # Return the row number for commit $id in the current view
1127 proc rowofcommit
{id
} {
1128 global varcid varccommits varcrow curview cached_commitrow
1129 global varctok vtokmod
1132 if {![info exists varcid
($v,$id)]} {
1133 puts
"oops rowofcommit no arc for [shortids $id]"
1136 set a
$varcid($v,$id)
1137 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
1140 if {[info exists cached_commitrow
($id)]} {
1141 return $cached_commitrow($id)
1143 set i
[lsearch
-exact $varccommits($v,$a) $id]
1145 puts
"oops didn't find commit [shortids $id] in arc $a"
1148 incr i
[lindex
$varcrow($v) $a]
1149 set cached_commitrow
($id) $i
1153 # Returns 1 if a is on an earlier row than b, otherwise 0
1154 proc comes_before
{a b
} {
1155 global varcid varctok curview
1158 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
1159 ![info exists varcid
($v,$b)]} {
1162 if {$varcid($v,$a) != $varcid($v,$b)} {
1163 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1164 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
1166 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
1169 proc bsearch
{l elt
} {
1170 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
1175 while {$hi - $lo > 1} {
1176 set mid
[expr {int
(($lo + $hi) / 2)}]
1177 set t
[lindex
$l $mid]
1180 } elseif
{$elt > $t} {
1189 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1190 proc make_disporder
{start end
} {
1191 global vrownum curview commitidx displayorder parentlist
1192 global varccommits varcorder parents vrowmod varcrow
1193 global d_valid_start d_valid_end
1195 if {$end > $vrowmod($curview)} {
1196 update_arcrows
$curview
1198 set ai
[bsearch
$vrownum($curview) $start]
1199 set start
[lindex
$vrownum($curview) $ai]
1200 set narc
[llength
$vrownum($curview)]
1201 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
1202 set a
[lindex
$varcorder($curview) $ai]
1203 set l
[llength
$displayorder]
1204 set al
[llength
$varccommits($curview,$a)]
1205 if {$l < $r + $al} {
1207 set pad
[ntimes
[expr {$r - $l}] {}]
1208 set displayorder
[concat
$displayorder $pad]
1209 set parentlist
[concat
$parentlist $pad]
1210 } elseif
{$l > $r} {
1211 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
1212 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
1214 foreach id
$varccommits($curview,$a) {
1215 lappend displayorder
$id
1216 lappend parentlist
$parents($curview,$id)
1218 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
1220 foreach id
$varccommits($curview,$a) {
1221 lset displayorder
$i $id
1222 lset parentlist
$i $parents($curview,$id)
1230 proc commitonrow
{row
} {
1233 set id
[lindex
$displayorder $row]
1235 make_disporder
$row [expr {$row + 1}]
1236 set id
[lindex
$displayorder $row]
1241 proc closevarcs
{v
} {
1242 global varctok varccommits varcid parents children
1243 global cmitlisted commitidx vtokmod
1245 set missing_parents
0
1247 set narcs
[llength
$varctok($v)]
1248 for {set a
1} {$a < $narcs} {incr a
} {
1249 set id
[lindex
$varccommits($v,$a) end
]
1250 foreach p
$parents($v,$id) {
1251 if {[info exists varcid
($v,$p)]} continue
1252 # add p as a new commit
1253 incr missing_parents
1254 set cmitlisted
($v,$p) 0
1255 set parents
($v,$p) {}
1256 if {[llength
$children($v,$p)] == 1 &&
1257 [llength
$parents($v,$id)] == 1} {
1260 set b
[newvarc
$v $p]
1262 set varcid
($v,$p) $b
1263 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1266 lappend varccommits
($v,$b) $p
1268 set scripts
[check_interest
$p $scripts]
1271 if {$missing_parents > 0} {
1272 foreach s
$scripts {
1278 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1279 # Assumes we already have an arc for $rwid.
1280 proc rewrite_commit
{v id rwid
} {
1281 global children parents varcid varctok vtokmod varccommits
1283 foreach ch
$children($v,$id) {
1284 # make $rwid be $ch's parent in place of $id
1285 set i
[lsearch
-exact $parents($v,$ch) $id]
1287 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1289 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1290 # add $ch to $rwid's children and sort the list if necessary
1291 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1292 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1293 $children($v,$rwid)]
1295 # fix the graph after joining $id to $rwid
1296 set a
$varcid($v,$ch)
1297 fix_reversal
$rwid $a $v
1298 # parentlist is wrong for the last element of arc $a
1299 # even if displayorder is right, hence the 3rd arg here
1300 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1304 # Mechanism for registering a command to be executed when we come
1305 # across a particular commit. To handle the case when only the
1306 # prefix of the commit is known, the commitinterest array is now
1307 # indexed by the first 4 characters of the ID. Each element is a
1308 # list of id, cmd pairs.
1309 proc interestedin
{id cmd
} {
1310 global commitinterest
1312 lappend commitinterest
([string range
$id 0 3]) $id $cmd
1315 proc check_interest
{id scripts
} {
1316 global commitinterest
1318 set prefix
[string range
$id 0 3]
1319 if {[info exists commitinterest
($prefix)]} {
1321 foreach
{i
script} $commitinterest($prefix) {
1322 if {[string match
"$i*" $id]} {
1323 lappend scripts
[string map
[list
"%I" $id "%P" $i] $script]
1325 lappend newlist
$i $script
1328 if {$newlist ne
{}} {
1329 set commitinterest
($prefix) $newlist
1331 unset commitinterest
($prefix)
1337 proc getcommitlines
{fd inst view updating
} {
1338 global cmitlisted leftover
1339 global commitidx commitdata vdatemode
1340 global parents children curview hlview
1341 global idpending ordertok
1342 global varccommits varcid varctok vtokmod vfilelimit
1344 set stuff
[read $fd 500000]
1345 # git log doesn't terminate the last commit with a null...
1346 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1353 global commfd viewcomplete viewactive viewname
1354 global viewinstances
1356 set i
[lsearch
-exact $viewinstances($view) $inst]
1358 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1360 # set it blocking so we wait for the process to terminate
1361 fconfigure
$fd -blocking 1
1362 if {[catch
{close
$fd} err
]} {
1364 if {$view != $curview} {
1365 set fv
" for the \"$viewname($view)\" view"
1367 if {[string range
$err 0 4] == "usage"} {
1368 set err
"Gitk: error reading commits$fv:\
1369 bad arguments to git log."
1370 if {$viewname($view) eq
"Command line"} {
1372 " (Note: arguments to gitk are passed to git log\
1373 to allow selection of commits to be displayed.)"
1376 set err
"Error reading commits$fv: $err"
1380 if {[incr viewactive
($view) -1] <= 0} {
1381 set viewcomplete
($view) 1
1382 # Check if we have seen any ids listed as parents that haven't
1383 # appeared in the list
1387 if {$view == $curview} {
1396 set i
[string first
"\0" $stuff $start]
1398 append leftover
($inst) [string range
$stuff $start end
]
1402 set cmit
$leftover($inst)
1403 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1404 set leftover
($inst) {}
1406 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1408 set start
[expr {$i + 1}]
1409 set j
[string first
"\n" $cmit]
1412 if {$j >= 0 && [string match
"commit *" $cmit]} {
1413 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1414 if {[string match
{[-^
<>]*} $ids]} {
1415 switch
-- [string index
$ids 0] {
1421 set ids
[string range
$ids 1 end
]
1425 if {[string length
$id] != 40} {
1433 if {[string length
$shortcmit] > 80} {
1434 set shortcmit
"[string range $shortcmit 0 80]..."
1436 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1439 set id [lindex $ids 0]
1442 if {!$listed && $updating && ![info exists varcid($vid)] &&
1443 $vfilelimit($view) ne {}} {
1444 # git log doesn't rewrite parents
for unlisted commits
1445 # when doing path limiting, so work around that here
1446 # by working out the rewritten parent with git rev-list
1447 # and if we already know about it, using the rewritten
1448 # parent as a substitute parent for $id's children.
1450 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1451 $id -- $vfilelimit($view)]
1453 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1454 # use $rwid in place of $id
1455 rewrite_commit
$view $id $rwid
1462 if {[info exists varcid
($vid)]} {
1463 if {$cmitlisted($vid) ||
!$listed} continue
1467 set olds
[lrange
$ids 1 end
]
1471 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1472 set cmitlisted
($vid) $listed
1473 set parents
($vid) $olds
1474 if {![info exists children
($vid)]} {
1475 set children
($vid) {}
1476 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1477 set k
[lindex
$children($vid) 0]
1478 if {[llength
$parents($view,$k)] == 1 &&
1479 (!$vdatemode($view) ||
1480 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1481 set a
$varcid($view,$k)
1486 set a
[newvarc
$view $id]
1488 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1491 if {![info exists varcid
($vid)]} {
1493 lappend varccommits
($view,$a) $id
1494 incr commitidx
($view)
1499 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1501 if {[llength
[lappend children
($vp) $id]] > 1 &&
1502 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1503 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1505 catch
{unset ordertok
}
1507 if {[info exists varcid
($view,$p)]} {
1508 fix_reversal
$p $a $view
1514 set scripts
[check_interest
$id $scripts]
1518 global numcommits hlview
1520 if {$view == $curview} {
1521 set numcommits
$commitidx($view)
1524 if {[info exists hlview
] && $view == $hlview} {
1525 # we never actually get here...
1528 foreach s
$scripts {
1535 proc chewcommits
{} {
1536 global curview hlview viewcomplete
1537 global pending_select
1540 if {$viewcomplete($curview)} {
1541 global commitidx varctok
1542 global numcommits startmsecs
1544 if {[info exists pending_select
]} {
1546 reset_pending_select
{}
1548 if {[commitinview
$pending_select $curview]} {
1549 selectline
[rowofcommit
$pending_select] 1
1551 set row
[first_real_row
]
1555 if {$commitidx($curview) > 0} {
1556 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1557 #puts "overall $ms ms for $numcommits commits"
1558 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1560 show_status
[mc
"No commits selected"]
1567 proc do_readcommit
{id
} {
1570 # Invoke git-log to handle automatic encoding conversion
1571 set fd
[open
[concat | git log
--no-color --pretty=raw
-1 $id] r
]
1572 # Read the results using i18n.logoutputencoding
1573 fconfigure
$fd -translation lf
-eofchar {}
1574 if {$tclencoding != {}} {
1575 fconfigure
$fd -encoding $tclencoding
1577 set contents
[read $fd]
1579 # Remove the heading line
1580 regsub
{^commit
[0-9a-f]+\n} $contents {} contents
1585 proc readcommit
{id
} {
1586 if {[catch
{set contents
[do_readcommit
$id]}]} return
1587 parsecommit
$id $contents 1
1590 proc parsecommit
{id contents listed
} {
1591 global commitinfo cdate
1600 set hdrend
[string first
"\n\n" $contents]
1602 # should never happen...
1603 set hdrend
[string length
$contents]
1605 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1606 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1607 foreach line
[split $header "\n"] {
1608 set line
[split $line " "]
1609 set tag
[lindex
$line 0]
1610 if {$tag == "author"} {
1611 set audate
[lindex
$line end-1
]
1612 set auname
[join [lrange
$line 1 end-2
] " "]
1613 } elseif
{$tag == "committer"} {
1614 set comdate
[lindex
$line end-1
]
1615 set comname
[join [lrange
$line 1 end-2
] " "]
1619 # take the first non-blank line of the comment as the headline
1620 set headline
[string trimleft
$comment]
1621 set i
[string first
"\n" $headline]
1623 set headline
[string range
$headline 0 $i]
1625 set headline
[string trimright
$headline]
1626 set i
[string first
"\r" $headline]
1628 set headline
[string trimright
[string range
$headline 0 $i]]
1631 # git log indents the comment by 4 spaces;
1632 # if we got this via git cat-file, add the indentation
1634 foreach line
[split $comment "\n"] {
1635 append newcomment
" "
1636 append newcomment
$line
1637 append newcomment
"\n"
1639 set comment
$newcomment
1641 if {$comdate != {}} {
1642 set cdate
($id) $comdate
1644 set commitinfo
($id) [list
$headline $auname $audate \
1645 $comname $comdate $comment]
1648 proc getcommit
{id
} {
1649 global commitdata commitinfo
1651 if {[info exists commitdata
($id)]} {
1652 parsecommit
$id $commitdata($id) 1
1655 if {![info exists commitinfo
($id)]} {
1656 set commitinfo
($id) [list
[mc
"No commit information available"]]
1662 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1663 # and are present in the current view.
1664 # This is fairly slow...
1665 proc longid
{prefix
} {
1666 global varcid curview
1669 foreach match
[array names varcid
"$curview,$prefix*"] {
1670 lappend ids
[lindex
[split $match ","] 1]
1676 global tagids idtags headids idheads tagobjid
1677 global otherrefids idotherrefs mainhead mainheadid
1678 global selecthead selectheadid
1680 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1683 set refd
[open
[list | git show-ref
-d] r
]
1684 while {[gets
$refd line
] >= 0} {
1685 if {[string index
$line 40] ne
" "} continue
1686 set id
[string range
$line 0 39]
1687 set ref
[string range
$line 41 end
]
1688 if {![string match
"refs/*" $ref]} continue
1689 set name
[string range
$ref 5 end
]
1690 if {[string match
"remotes/*" $name]} {
1691 if {![string match
"*/HEAD" $name]} {
1692 set headids
($name) $id
1693 lappend idheads
($id) $name
1695 } elseif
{[string match
"heads/*" $name]} {
1696 set name
[string range
$name 6 end
]
1697 set headids
($name) $id
1698 lappend idheads
($id) $name
1699 } elseif
{[string match
"tags/*" $name]} {
1700 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1701 # which is what we want since the former is the commit ID
1702 set name
[string range
$name 5 end
]
1703 if {[string match
"*^{}" $name]} {
1704 set name
[string range
$name 0 end-3
]
1706 set tagobjid
($name) $id
1708 set tagids
($name) $id
1709 lappend idtags
($id) $name
1711 set otherrefids
($name) $id
1712 lappend idotherrefs
($id) $name
1719 set mainheadid
[exec git rev-parse HEAD
]
1720 set thehead
[exec git symbolic-ref HEAD
]
1721 if {[string match
"refs/heads/*" $thehead]} {
1722 set mainhead
[string range
$thehead 11 end
]
1726 if {$selecthead ne
{}} {
1728 set selectheadid
[exec git rev-parse
--verify $selecthead]
1733 # skip over fake commits
1734 proc first_real_row
{} {
1735 global nullid nullid2 numcommits
1737 for {set row
0} {$row < $numcommits} {incr row
} {
1738 set id
[commitonrow
$row]
1739 if {$id ne
$nullid && $id ne
$nullid2} {
1746 # update things for a head moved to a child of its previous location
1747 proc movehead
{id name
} {
1748 global headids idheads
1750 removehead
$headids($name) $name
1751 set headids
($name) $id
1752 lappend idheads
($id) $name
1755 # update things when a head has been removed
1756 proc removehead
{id name
} {
1757 global headids idheads
1759 if {$idheads($id) eq
$name} {
1762 set i
[lsearch
-exact $idheads($id) $name]
1764 set idheads
($id) [lreplace
$idheads($id) $i $i]
1767 unset headids
($name)
1770 proc make_transient
{window origin
} {
1773 # In MacOS Tk 8.4 transient appears to work by setting
1774 # overrideredirect, which is utterly useless, since the
1775 # windows get no border, and are not even kept above
1777 if {!$have_tk85 && [tk windowingsystem
] eq
{aqua
}} return
1779 wm transient
$window $origin
1781 # Windows fails to place transient windows normally, so
1782 # schedule a callback to center them on the parent.
1783 if {[tk windowingsystem
] eq
{win32
}} {
1784 after idle
[list tk
::PlaceWindow
$window widget
$origin]
1788 proc show_error
{w top msg
} {
1789 message
$w.m
-text $msg -justify center
-aspect 400
1790 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1791 button
$w.ok
-text [mc OK
] -command "destroy $top"
1792 pack
$w.ok
-side bottom
-fill x
1793 bind $top <Visibility
> "grab $top; focus $top"
1794 bind $top <Key-Return
> "destroy $top"
1795 bind $top <Key-space
> "destroy $top"
1796 bind $top <Key-Escape
> "destroy $top"
1800 proc error_popup
{msg
{owner .
}} {
1803 make_transient
$w $owner
1804 show_error
$w $w $msg
1807 proc confirm_popup
{msg
{owner .
}} {
1812 make_transient
$w $owner
1813 message
$w.m
-text $msg -justify center
-aspect 400
1814 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1815 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1816 pack
$w.ok
-side left
-fill x
1817 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1818 pack
$w.cancel
-side right
-fill x
1819 bind $w <Visibility
> "grab $w; focus $w"
1820 bind $w <Key-Return
> "set confirm_ok 1; destroy $w"
1821 bind $w <Key-space
> "set confirm_ok 1; destroy $w"
1822 bind $w <Key-Escape
> "destroy $w"
1827 proc setoptions
{} {
1828 option add
*Panedwindow.showHandle
1 startupFile
1829 option add
*Panedwindow.sashRelief raised startupFile
1830 option add
*Button.font uifont startupFile
1831 option add
*Checkbutton.font uifont startupFile
1832 option add
*Radiobutton.font uifont startupFile
1833 if {[tk windowingsystem
] ne
"aqua"} {
1834 option add
*Menu.font uifont startupFile
1836 option add
*Menubutton.font uifont startupFile
1837 option add
*Label.font uifont startupFile
1838 option add
*Message.font uifont startupFile
1839 option add
*Entry.font uifont startupFile
1842 # Make a menu and submenus.
1843 # m is the window name for the menu, items is the list of menu items to add.
1844 # Each item is a list {mc label type description options...}
1845 # mc is ignored; it's so we can put mc there to alert xgettext
1846 # label is the string that appears in the menu
1847 # type is cascade, command or radiobutton (should add checkbutton)
1848 # description depends on type; it's the sublist for cascade, the
1849 # command to invoke for command, or {variable value} for radiobutton
1850 proc makemenu
{m items
} {
1852 if {[tk windowingsystem
] eq
{aqua
}} {
1858 set name
[mc
[lindex
$i 1]]
1859 set type [lindex
$i 2]
1860 set thing
[lindex
$i 3]
1861 set params
[list
$type]
1863 set u
[string first
"&" [string map
{&& x
} $name]]
1864 lappend params
-label [string map
{&& & & {}} $name]
1866 lappend params
-underline $u
1871 set submenu
[string tolower
[string map
{& ""} [lindex
$i 1]]]
1872 lappend params
-menu $m.
$submenu
1875 lappend params
-command $thing
1878 lappend params
-variable [lindex
$thing 0] \
1879 -value [lindex
$thing 1]
1882 set tail [lrange
$i 4 end
]
1883 regsub
-all {\yMeta1\y
} $tail $Meta1 tail
1884 eval $m add
$params $tail
1885 if {$type eq
"cascade"} {
1886 makemenu
$m.
$submenu $thing
1891 # translate string and remove ampersands
1893 return [string map
{&& & & {}} [mc
$str]]
1896 proc makewindow
{} {
1897 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1899 global findtype findtypemenu findloc findstring fstring geometry
1900 global entries sha1entry sha1string sha1but
1901 global diffcontextstring diffcontext
1903 global maincursor textcursor curtextcursor
1904 global rowctxmenu fakerowmenu mergemax wrapcomment
1905 global highlight_files gdttype
1906 global searchstring sstring
1907 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1908 global headctxmenu progresscanv progressitem progresscoords statusw
1909 global fprogitem fprogcoord lastprogupdate progupdatepending
1910 global rprogitem rprogcoord rownumsel numcommits
1913 # The "mc" arguments here are purely so that xgettext
1914 # sees the following string as needing to be translated
1917 {mc
"Update" command updatecommits
-accelerator F5
}
1918 {mc
"Reload" command reloadcommits
-accelerator Meta1-F5
}
1919 {mc
"Reread references" command rereadrefs
}
1920 {mc
"List references" command showrefs
-accelerator F2
}
1922 {mc
"Start git gui" command {exec git gui
&}}
1924 {mc
"Quit" command doquit
-accelerator Meta1-Q
}
1928 {mc
"Preferences" command doprefs
}
1932 {mc
"New view..." command {newview
0} -accelerator Shift-F4
}
1933 {mc
"Edit view..." command editview
-state disabled
-accelerator F4
}
1934 {mc
"Delete view" command delview
-state disabled
}
1936 {mc
"All files" radiobutton
{selectedview
0} -command {showview
0}}
1938 if {[tk windowingsystem
] ne
"aqua"} {
1941 {mc
"About gitk" command about
}
1942 {mc
"Key bindings" command keys
}
1944 set bar
[list
$file $edit $view $help]
1946 proc
::tk
::mac
::ShowPreferences
{} {doprefs
}
1947 proc
::tk
::mac
::Quit
{} {doquit
}
1948 lset
file end
[lreplace
[lindex
$file end
] end-1 end
]
1950 xx
"Apple" cascade
{
1951 {mc
"About gitk" command about
}
1956 {mc
"Key bindings" command keys
}
1958 set bar
[list
$apple $file $view $help]
1961 . configure
-menu .bar
1963 # the gui has upper and lower half, parts of a paned window.
1964 panedwindow .ctop
-orient vertical
1966 # possibly use assumed geometry
1967 if {![info exists geometry
(pwsash0
)]} {
1968 set geometry
(topheight
) [expr {15 * $linespc}]
1969 set geometry
(topwidth
) [expr {80 * $charspc}]
1970 set geometry
(botheight
) [expr {15 * $linespc}]
1971 set geometry
(botwidth
) [expr {50 * $charspc}]
1972 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1973 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1976 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1977 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1979 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1981 # create three canvases
1982 set cscroll .tf.histframe.csb
1983 set canv .tf.histframe.pwclist.canv
1985 -selectbackground $selectbgcolor \
1986 -background $bgcolor -bd 0 \
1987 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1988 .tf.histframe.pwclist add
$canv
1989 set canv2 .tf.histframe.pwclist.canv2
1991 -selectbackground $selectbgcolor \
1992 -background $bgcolor -bd 0 -yscrollincr $linespc
1993 .tf.histframe.pwclist add
$canv2
1994 set canv3 .tf.histframe.pwclist.canv3
1996 -selectbackground $selectbgcolor \
1997 -background $bgcolor -bd 0 -yscrollincr $linespc
1998 .tf.histframe.pwclist add
$canv3
1999 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
2000 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
2002 # a scroll bar to rule them
2003 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
2004 pack
$cscroll -side right
-fill y
2005 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
2006 lappend bglist
$canv $canv2 $canv3
2007 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
2009 # we have two button bars at bottom of top frame. Bar 1
2011 frame .tf.lbar
-height 15
2013 set sha1entry .tf.bar.sha1
2014 set entries
$sha1entry
2015 set sha1but .tf.bar.sha1label
2016 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
2017 -command gotocommit
-width 8
2018 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
2019 pack .tf.bar.sha1label
-side left
2020 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
2021 trace add variable sha1string
write sha1change
2022 pack
$sha1entry -side left
-pady 2
2024 image create bitmap bm-left
-data {
2025 #define left_width 16
2026 #define left_height 16
2027 static unsigned char left_bits
[] = {
2028 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2029 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2030 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2032 image create bitmap bm-right
-data {
2033 #define right_width 16
2034 #define right_height 16
2035 static unsigned char right_bits
[] = {
2036 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2037 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2038 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2040 button .tf.bar.leftbut
-image bm-left
-command goback \
2041 -state disabled
-width 26
2042 pack .tf.bar.leftbut
-side left
-fill y
2043 button .tf.bar.rightbut
-image bm-right
-command goforw \
2044 -state disabled
-width 26
2045 pack .tf.bar.rightbut
-side left
-fill y
2047 label .tf.bar.rowlabel
-text [mc
"Row"]
2049 label .tf.bar.rownum
-width 7 -font textfont
-textvariable rownumsel \
2050 -relief sunken
-anchor e
2051 label .tf.bar.rowlabel2
-text "/"
2052 label .tf.bar.numcommits
-width 7 -font textfont
-textvariable numcommits \
2053 -relief sunken
-anchor e
2054 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2057 trace add variable selectedline
write selectedline_change
2059 # Status label and progress bar
2060 set statusw .tf.bar.status
2061 label
$statusw -width 15 -relief sunken
2062 pack
$statusw -side left
-padx 5
2063 set h
[expr {[font metrics uifont
-linespace] + 2}]
2064 set progresscanv .tf.bar.progress
2065 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
2066 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
2067 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
2068 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
2069 pack
$progresscanv -side right
-expand 1 -fill x
2070 set progresscoords
{0 0}
2073 bind $progresscanv <Configure
> adjustprogress
2074 set lastprogupdate
[clock clicks
-milliseconds]
2075 set progupdatepending
0
2077 # build up the bottom bar of upper window
2078 label .tf.lbar.flabel
-text "[mc "Find
"] "
2079 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
2080 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
2081 label .tf.lbar.flab2
-text " [mc "commit
"] "
2082 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2084 set gdttype
[mc
"containing:"]
2085 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
2086 [mc
"containing:"] \
2087 [mc
"touching paths:"] \
2088 [mc
"adding/removing string:"]]
2089 trace add variable gdttype
write gdttype_change
2090 pack .tf.lbar.gdttype
-side left
-fill y
2093 set fstring .tf.lbar.findstring
2094 lappend entries
$fstring
2095 entry
$fstring -width 30 -font textfont
-textvariable findstring
2096 trace add variable findstring
write find_change
2097 set findtype
[mc
"Exact"]
2098 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
2099 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
2100 trace add variable findtype
write findcom_change
2101 set findloc
[mc
"All fields"]
2102 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
2103 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
2104 trace add variable findloc
write find_change
2105 pack .tf.lbar.findloc
-side right
2106 pack .tf.lbar.findtype
-side right
2107 pack
$fstring -side left
-expand 1 -fill x
2109 # Finish putting the upper half of the viewer together
2110 pack .tf.lbar
-in .tf
-side bottom
-fill x
2111 pack .tf.bar
-in .tf
-side bottom
-fill x
2112 pack .tf.histframe
-fill both
-side top
-expand 1
2114 .ctop paneconfigure .tf
-height $geometry(topheight
)
2115 .ctop paneconfigure .tf
-width $geometry(topwidth
)
2117 # now build up the bottom
2118 panedwindow .pwbottom
-orient horizontal
2120 # lower left, a text box over search bar, scroll bar to the right
2121 # if we know window height, then that will set the lower text height, otherwise
2122 # we set lower text height which will drive window height
2123 if {[info exists geometry
(main
)]} {
2124 frame .bleft
-width $geometry(botwidth
)
2126 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
2132 button .bleft.top.search
-text [mc
"Search"] -command dosearch
2133 pack .bleft.top.search
-side left
-padx 5
2134 set sstring .bleft.top.sstring
2135 entry
$sstring -width 20 -font textfont
-textvariable searchstring
2136 lappend entries
$sstring
2137 trace add variable searchstring
write incrsearch
2138 pack
$sstring -side left
-expand 1 -fill x
2139 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
2140 -command changediffdisp
-variable diffelide
-value {0 0}
2141 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
2142 -command changediffdisp
-variable diffelide
-value {0 1}
2143 radiobutton .bleft.mid.new
-text [mc
"New version"] \
2144 -command changediffdisp
-variable diffelide
-value {1 0}
2145 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
2146 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
2147 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
2148 -from 1 -increment 1 -to 10000000 \
2149 -validate all
-validatecommand "diffcontextvalidate %P" \
2150 -textvariable diffcontextstring
2151 .bleft.mid.diffcontext
set $diffcontext
2152 trace add variable diffcontextstring
write diffcontextchange
2153 lappend entries .bleft.mid.diffcontext
2154 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
2155 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
2156 -command changeignorespace
-variable ignorespace
2157 pack .bleft.mid.ignspace
-side left
-padx 5
2158 set ctext .bleft.bottom.ctext
2159 text
$ctext -background $bgcolor -foreground $fgcolor \
2160 -state disabled
-font textfont \
2161 -yscrollcommand scrolltext
-wrap none \
2162 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2164 $ctext conf
-tabstyle wordprocessor
2166 scrollbar .bleft.bottom.sb
-command "$ctext yview"
2167 scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h \
2169 pack .bleft.top
-side top
-fill x
2170 pack .bleft.mid
-side top
-fill x
2171 grid
$ctext .bleft.bottom.sb
-sticky nsew
2172 grid .bleft.bottom.sbhorizontal
-sticky ew
2173 grid columnconfigure .bleft.bottom
0 -weight 1
2174 grid rowconfigure .bleft.bottom
0 -weight 1
2175 grid rowconfigure .bleft.bottom
1 -weight 0
2176 pack .bleft.bottom
-side top
-fill both
-expand 1
2177 lappend bglist
$ctext
2178 lappend fglist
$ctext
2180 $ctext tag conf comment
-wrap $wrapcomment
2181 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
2182 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
2183 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
2184 $ctext tag conf dresult
-fore [lindex
$diffcolors 1]
2185 $ctext tag conf m0
-fore red
2186 $ctext tag conf m1
-fore blue
2187 $ctext tag conf m2
-fore green
2188 $ctext tag conf m3
-fore purple
2189 $ctext tag conf
m4 -fore brown
2190 $ctext tag conf m5
-fore "#009090"
2191 $ctext tag conf m6
-fore magenta
2192 $ctext tag conf m7
-fore "#808000"
2193 $ctext tag conf m8
-fore "#009000"
2194 $ctext tag conf m9
-fore "#ff0080"
2195 $ctext tag conf m10
-fore cyan
2196 $ctext tag conf m11
-fore "#b07070"
2197 $ctext tag conf m12
-fore "#70b0f0"
2198 $ctext tag conf m13
-fore "#70f0b0"
2199 $ctext tag conf m14
-fore "#f0b070"
2200 $ctext tag conf m15
-fore "#ff70b0"
2201 $ctext tag conf mmax
-fore darkgrey
2203 $ctext tag conf mresult
-font textfontbold
2204 $ctext tag conf msep
-font textfontbold
2205 $ctext tag conf found
-back yellow
2207 .pwbottom add .bleft
2208 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
2213 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
2214 -command reselectline
-variable cmitmode
-value "patch"
2215 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
2216 -command reselectline
-variable cmitmode
-value "tree"
2217 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
2218 pack .bright.mode
-side top
-fill x
2219 set cflist .bright.cfiles
2220 set indent
[font measure mainfont
"nn"]
2222 -selectbackground $selectbgcolor \
2223 -background $bgcolor -foreground $fgcolor \
2225 -tabs [list
$indent [expr {2 * $indent}]] \
2226 -yscrollcommand ".bright.sb set" \
2227 -cursor [. cget
-cursor] \
2228 -spacing1 1 -spacing3 1
2229 lappend bglist
$cflist
2230 lappend fglist
$cflist
2231 scrollbar .bright.sb
-command "$cflist yview"
2232 pack .bright.sb
-side right
-fill y
2233 pack
$cflist -side left
-fill both
-expand 1
2234 $cflist tag configure highlight \
2235 -background [$cflist cget
-selectbackground]
2236 $cflist tag configure bold
-font mainfontbold
2238 .pwbottom add .bright
2241 # restore window width & height if known
2242 if {[info exists geometry
(main
)]} {
2243 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
2244 if {$w > [winfo screenwidth .
]} {
2245 set w
[winfo screenwidth .
]
2247 if {$h > [winfo screenheight .
]} {
2248 set h
[winfo screenheight .
]
2250 wm geometry .
"${w}x$h"
2254 if {[info exists geometry
(state
)] && $geometry(state
) eq
"zoomed"} {
2255 wm state .
$geometry(state
)
2258 if {[tk windowingsystem
] eq
{aqua
}} {
2266 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2267 pack .ctop
-fill both
-expand 1
2268 bindall
<1> {selcanvline
%W
%x
%y
}
2269 #bindall <B1-Motion> {selcanvline %W %x %y}
2270 if {[tk windowingsystem
] == "win32"} {
2271 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2272 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2274 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2275 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2276 if {[tk windowingsystem
] eq
"aqua"} {
2277 bindall
<MouseWheel
> {
2278 set delta
[expr {- (%D
)}]
2279 allcanvs yview scroll
$delta units
2281 bindall
<Shift-MouseWheel
> {
2282 set delta
[expr {- (%D
)}]
2283 $canv xview scroll
$delta units
2287 bindall
<$
::BM
> "canvscan mark %W %x %y"
2288 bindall
<B$
::BM-Motion
> "canvscan dragto %W %x %y"
2289 bindkey
<Home
> selfirstline
2290 bindkey
<End
> sellastline
2291 bind .
<Key-Up
> "selnextline -1"
2292 bind .
<Key-Down
> "selnextline 1"
2293 bind .
<Shift-Key-Up
> "dofind -1 0"
2294 bind .
<Shift-Key-Down
> "dofind 1 0"
2295 bindkey
<Key-Right
> "goforw"
2296 bindkey
<Key-Left
> "goback"
2297 bind .
<Key-Prior
> "selnextpage -1"
2298 bind .
<Key-Next
> "selnextpage 1"
2299 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2300 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2301 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2302 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2303 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2304 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2305 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2306 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2307 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2308 bindkey p
"selnextline -1"
2309 bindkey n
"selnextline 1"
2312 bindkey i
"selnextline -1"
2313 bindkey k
"selnextline 1"
2317 bindkey d
"$ctext yview scroll 18 units"
2318 bindkey u
"$ctext yview scroll -18 units"
2319 bindkey
/ {focus
$fstring}
2320 bindkey
<Key-KP_Divide
> {focus
$fstring}
2321 bindkey
<Key-Return
> {dofind
1 1}
2322 bindkey ?
{dofind
-1 1}
2324 bind .
<F5
> updatecommits
2325 bind .
<$M1B-F5> reloadcommits
2326 bind .
<F2
> showrefs
2327 bind .
<Shift-F4
> {newview
0}
2328 catch
{ bind .
<Shift-Key-XF86_Switch_VT_4
> {newview
0} }
2329 bind .
<F4
> edit_or_newview
2330 bind .
<$M1B-q> doquit
2331 bind .
<$M1B-f> {dofind
1 1}
2332 bind .
<$M1B-g> {dofind
1 0}
2333 bind .
<$M1B-r> dosearchback
2334 bind .
<$M1B-s> dosearch
2335 bind .
<$M1B-equal> {incrfont
1}
2336 bind .
<$M1B-plus> {incrfont
1}
2337 bind .
<$M1B-KP_Add> {incrfont
1}
2338 bind .
<$M1B-minus> {incrfont
-1}
2339 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2340 wm protocol . WM_DELETE_WINDOW doquit
2341 bind .
<Destroy
> {stop_backends
}
2342 bind .
<Button-1
> "click %W"
2343 bind $fstring <Key-Return
> {dofind
1 1}
2344 bind $sha1entry <Key-Return
> {gotocommit
; break}
2345 bind $sha1entry <<PasteSelection>> clearsha1
2346 bind $cflist <1> {sel_flist %W %x %y; break}
2347 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2348 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2350 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2351 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2353 set maincursor [. cget -cursor]
2354 set textcursor [$ctext cget -cursor]
2355 set curtextcursor $textcursor
2357 set rowctxmenu .rowctxmenu
2358 makemenu $rowctxmenu {
2359 {mc "Diff this -> selected" command {diffvssel 0}}
2360 {mc "Diff selected -> this" command {diffvssel 1}}
2361 {mc "Make patch" command mkpatch}
2362 {mc "Create tag" command mktag}
2363 {mc "Write commit to file" command writecommit}
2364 {mc "Create new branch" command mkbranch}
2365 {mc "Cherry-pick this commit" command cherrypick}
2366 {mc "Reset HEAD branch to here" command resethead}
2367 {mc "Mark this commit" command markhere}
2368 {mc "Return to mark" command gotomark}
2369 {mc "Find descendant of this and mark" command find_common_desc}
2370 {mc "Compare with marked commit" command compare_commits}
2372 $rowctxmenu configure -tearoff 0
2374 set fakerowmenu .fakerowmenu
2375 makemenu $fakerowmenu {
2376 {mc "Diff this -> selected" command {diffvssel 0}}
2377 {mc "Diff selected -> this" command {diffvssel 1}}
2378 {mc "Make patch" command mkpatch}
2380 $fakerowmenu configure -tearoff 0
2382 set headctxmenu .headctxmenu
2383 makemenu $headctxmenu {
2384 {mc "Check out this branch" command cobranch}
2385 {mc "Remove this branch" command rmbranch}
2387 $headctxmenu configure -tearoff 0
2390 set flist_menu .flistctxmenu
2391 makemenu $flist_menu {
2392 {mc "Highlight this too" command {flist_hl 0}}
2393 {mc "Highlight this only" command {flist_hl 1}}
2394 {mc "External diff" command {external_diff}}
2395 {mc "Blame parent commit" command {external_blame 1}}
2397 $flist_menu configure -tearoff 0
2400 set diff_menu .diffctxmenu
2401 makemenu $diff_menu {
2402 {mc "Show origin of this line" command show_line_source}
2403 {mc "Run git gui blame on this line" command {external_blame_diff}}
2405 $diff_menu configure -tearoff 0
2408 # Windows sends all mouse wheel events to the current focused window, not
2409 # the one where the mouse hovers, so bind those events here and redirect
2410 # to the correct window
2411 proc windows_mousewheel_redirector {W X Y D} {
2412 global canv canv2 canv3
2413 set w [winfo containing -displayof $W $X $Y]
2415 set u [expr {$D < 0 ? 5 : -5}]
2416 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2417 allcanvs yview scroll $u units
2420 $w yview scroll $u units
2426 # Update row number label when selectedline changes
2427 proc selectedline_change {n1 n2 op} {
2428 global selectedline rownumsel
2430 if {$selectedline eq {}} {
2433 set rownumsel [expr {$selectedline + 1}]
2437 # mouse-2 makes all windows scan vertically, but only the one
2438 # the cursor is in scans horizontally
2439 proc canvscan {op w x y} {
2440 global canv canv2 canv3
2441 foreach c [list $canv $canv2 $canv3] {
2450 proc scrollcanv {cscroll f0 f1} {
2451 $cscroll set $f0 $f1
2456 # when we make a key binding for the toplevel, make sure
2457 # it doesn't get triggered when that key is pressed in the
2458 # find string entry widget.
2459 proc bindkey {ev script} {
2462 set escript [bind Entry $ev]
2463 if {$escript == {}} {
2464 set escript [bind Entry <Key>]
2466 foreach e $entries {
2467 bind $e $ev "$escript; break"
2471 # set the focus back to the toplevel for any click outside
2474 global ctext entries
2475 foreach e [concat $entries $ctext] {
2476 if {$w == $e} return
2481 # Adjust the progress bar for a change in requested extent or canvas size
2482 proc adjustprogress {} {
2483 global progresscanv progressitem progresscoords
2484 global fprogitem fprogcoord lastprogupdate progupdatepending
2485 global rprogitem rprogcoord
2487 set w [expr {[winfo width $progresscanv] - 4}]
2488 set x0 [expr {$w * [lindex $progresscoords 0]}]
2489 set x1 [expr {$w * [lindex $progresscoords 1]}]
2490 set h [winfo height $progresscanv]
2491 $progresscanv coords $progressitem $x0 0 $x1 $h
2492 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2493 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2494 set now [clock clicks -milliseconds]
2495 if {$now >= $lastprogupdate + 100} {
2496 set progupdatepending 0
2498 } elseif {!$progupdatepending} {
2499 set progupdatepending 1
2500 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2504 proc doprogupdate {} {
2505 global lastprogupdate progupdatepending
2507 if {$progupdatepending} {
2508 set progupdatepending 0
2509 set lastprogupdate [clock clicks -milliseconds]
2514 proc savestuff {w} {
2515 global canv canv2 canv3 mainfont textfont uifont tabstop
2516 global stuffsaved findmergefiles maxgraphpct
2517 global maxwidth showneartags showlocalchanges
2518 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2519 global cmitmode wrapcomment datetimeformat limitdiffs
2520 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2521 global autoselect extdifftool perfile_attrs markbgcolor
2523 if {$stuffsaved} return
2524 if {![winfo viewable .]} return
2526 set f [open "~/.gitk-new" w]
2527 if {$::tcl_platform(platform) eq {windows}} {
2528 file attributes "~/.gitk-new" -hidden true
2530 puts $f [list set mainfont $mainfont]
2531 puts $f [list set textfont $textfont]
2532 puts $f [list set uifont $uifont]
2533 puts $f [list set tabstop $tabstop]
2534 puts $f [list set findmergefiles $findmergefiles]
2535 puts $f [list set maxgraphpct $maxgraphpct]
2536 puts $f [list set maxwidth $maxwidth]
2537 puts $f [list set cmitmode $cmitmode]
2538 puts $f [list set wrapcomment $wrapcomment]
2539 puts $f [list set autoselect $autoselect]
2540 puts $f [list set showneartags $showneartags]
2541 puts $f [list set showlocalchanges $showlocalchanges]
2542 puts $f [list set datetimeformat $datetimeformat]
2543 puts $f [list set limitdiffs $limitdiffs]
2544 puts $f [list set bgcolor $bgcolor]
2545 puts $f [list set fgcolor $fgcolor]
2546 puts $f [list set colors $colors]
2547 puts $f [list set diffcolors $diffcolors]
2548 puts $f [list set markbgcolor $markbgcolor]
2549 puts $f [list set diffcontext $diffcontext]
2550 puts $f [list set selectbgcolor $selectbgcolor]
2551 puts $f [list set extdifftool $extdifftool]
2552 puts $f [list set perfile_attrs $perfile_attrs]
2554 puts $f "set geometry(main) [wm geometry .]"
2555 puts $f "set geometry(state) [wm state .]"
2556 puts $f "set geometry(topwidth) [winfo width .tf]"
2557 puts $f "set geometry(topheight) [winfo height .tf]"
2558 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2559 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2560 puts $f "set geometry(botwidth) [winfo width .bleft]"
2561 puts $f "set geometry(botheight) [winfo height .bleft]"
2563 puts -nonewline $f "set permviews {"
2564 for {set v 0} {$v < $nextviewnum} {incr v} {
2565 if {$viewperm($v)} {
2566 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2571 file rename -force "~/.gitk-new" "~/.gitk"
2576 proc resizeclistpanes {win w} {
2578 if {[info exists oldwidth($win)]} {
2579 set s0 [$win sash coord 0]
2580 set s1 [$win sash coord 1]
2582 set sash0 [expr {int($w/2 - 2)}]
2583 set sash1 [expr {int($w*5/6 - 2)}]
2585 set factor [expr {1.0 * $w / $oldwidth($win)}]
2586 set sash0 [expr {int($factor * [lindex $s0 0])}]
2587 set sash1 [expr {int($factor * [lindex $s1 0])}]
2591 if {$sash1 < $sash0 + 20} {
2592 set sash1 [expr {$sash0 + 20}]
2594 if {$sash1 > $w - 10} {
2595 set sash1 [expr {$w - 10}]
2596 if {$sash0 > $sash1 - 20} {
2597 set sash0 [expr {$sash1 - 20}]
2601 $win sash place 0 $sash0 [lindex $s0 1]
2602 $win sash place 1 $sash1 [lindex $s1 1]
2604 set oldwidth($win) $w
2607 proc resizecdetpanes {win w} {
2609 if {[info exists oldwidth($win)]} {
2610 set s0 [$win sash coord 0]
2612 set sash0 [expr {int($w*3/4 - 2)}]
2614 set factor [expr {1.0 * $w / $oldwidth($win)}]
2615 set sash0 [expr {int($factor * [lindex $s0 0])}]
2619 if {$sash0 > $w - 15} {
2620 set sash0 [expr {$w - 15}]
2623 $win sash place 0 $sash0 [lindex $s0 1]
2625 set oldwidth($win) $w
2628 proc allcanvs args {
2629 global canv canv2 canv3
2635 proc bindall {event action} {
2636 global canv canv2 canv3
2637 bind $canv $event $action
2638 bind $canv2 $event $action
2639 bind $canv3 $event $action
2645 if {[winfo exists $w]} {
2650 wm title $w [mc "About gitk"]
2652 message $w.m -text [mc "
2653 Gitk - a commit viewer for git
2655 Copyright © 2005-2008 Paul Mackerras
2657 Use and redistribute under the terms of the GNU General Public License"] \
2658 -justify center -aspect 400 -border 2 -bg white -relief groove
2659 pack $w.m -side top -fill x -padx 2 -pady 2
2660 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2661 pack $w.ok -side bottom
2662 bind $w <Visibility> "focus $w.ok"
2663 bind $w <Key-Escape> "destroy $w"
2664 bind $w <Key-Return> "destroy $w"
2669 if {[winfo exists $w]} {
2673 if {[tk windowingsystem] eq {aqua}} {
2679 wm title $w [mc "Gitk key bindings"]
2681 message $w.m -text "
2682 [mc "Gitk key bindings:"]
2684 [mc "<%s-Q> Quit" $M1T]
2685 [mc "<Home> Move to first commit"]
2686 [mc "<End> Move to last commit"]
2687 [mc "<Up>, p, i Move up one commit"]
2688 [mc "<Down>, n, k Move down one commit"]
2689 [mc "<Left>, z, j Go back in history list"]
2690 [mc "<Right>, x, l Go forward in history list"]
2691 [mc "<PageUp> Move up one page in commit list"]
2692 [mc "<PageDown> Move down one page in commit list"]
2693 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2694 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2695 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2696 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2697 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2698 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2699 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2700 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2701 [mc "<Delete>, b Scroll diff view up one page"]
2702 [mc "<Backspace> Scroll diff view up one page"]
2703 [mc "<Space> Scroll diff view down one page"]
2704 [mc "u Scroll diff view up 18 lines"]
2705 [mc "d Scroll diff view down 18 lines"]
2706 [mc "<%s-F> Find" $M1T]
2707 [mc "<%s-G> Move to next find hit" $M1T]
2708 [mc "<Return> Move to next find hit"]
2709 [mc "/ Focus the search box"]
2710 [mc "? Move to previous find hit"]
2711 [mc "f Scroll diff view to next file"]
2712 [mc "<%s-S> Search for next hit in diff view" $M1T]
2713 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2714 [mc "<%s-KP+> Increase font size" $M1T]
2715 [mc "<%s-plus> Increase font size" $M1T]
2716 [mc "<%s-KP-> Decrease font size" $M1T]
2717 [mc "<%s-minus> Decrease font size" $M1T]
2720 -justify left -bg white -border 2 -relief groove
2721 pack $w.m -side top -fill both -padx 2 -pady 2
2722 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2723 bind $w <Key-Escape> [list destroy $w]
2724 pack $w.ok -side bottom
2725 bind $w <Visibility> "focus $w.ok"
2726 bind $w <Key-Escape> "destroy $w"
2727 bind $w <Key-Return> "destroy $w"
2730 # Procedures for manipulating the file list window at the
2731 # bottom right of the overall window.
2733 proc treeview {w l openlevs} {
2734 global treecontents treediropen treeheight treeparent treeindex
2744 set treecontents() {}
2745 $w conf -state normal
2747 while {[string range $f 0 $prefixend] ne $prefix} {
2748 if {$lev <= $openlevs} {
2749 $w mark set e:$treeindex($prefix) "end -1c"
2750 $w mark gravity e:$treeindex($prefix) left
2752 set treeheight($prefix) $ht
2753 incr ht [lindex $htstack end]
2754 set htstack [lreplace $htstack end end]
2755 set prefixend [lindex $prefendstack end]
2756 set prefendstack [lreplace $prefendstack end end]
2757 set prefix [string range $prefix 0 $prefixend]
2760 set tail [string range $f [expr {$prefixend+1}] end]
2761 while {[set slash [string first "/" $tail]] >= 0} {
2764 lappend prefendstack $prefixend
2765 incr prefixend [expr {$slash + 1}]
2766 set d [string range $tail 0 $slash]
2767 lappend treecontents($prefix) $d
2768 set oldprefix $prefix
2770 set treecontents($prefix) {}
2771 set treeindex($prefix) [incr ix]
2772 set treeparent($prefix) $oldprefix
2773 set tail [string range $tail [expr {$slash+1}] end]
2774 if {$lev <= $openlevs} {
2776 set treediropen($prefix) [expr {$lev < $openlevs}]
2777 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2778 $w mark set d:$ix "end -1c"
2779 $w mark gravity d:$ix left
2781 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2783 $w image create end -align center -image $bm -padx 1 \
2785 $w insert end $d [highlight_tag $prefix]
2786 $w mark set s:$ix "end -1c"
2787 $w mark gravity s:$ix left
2792 if {$lev <= $openlevs} {
2795 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2797 $w insert end $tail [highlight_tag $f]
2799 lappend treecontents($prefix) $tail
2802 while {$htstack ne {}} {
2803 set treeheight($prefix) $ht
2804 incr ht [lindex $htstack end]
2805 set htstack [lreplace $htstack end end]
2806 set prefixend [lindex $prefendstack end]
2807 set prefendstack [lreplace $prefendstack end end]
2808 set prefix [string range $prefix 0 $prefixend]
2810 $w conf -state disabled
2813 proc linetoelt {l} {
2814 global treeheight treecontents
2819 foreach e $treecontents($prefix) {
2824 if {[string index $e end] eq "/"} {
2825 set n $treeheight($prefix$e)
2837 proc highlight_tree {y prefix} {
2838 global treeheight treecontents cflist
2840 foreach e $treecontents($prefix) {
2842 if {[highlight_tag $path] ne {}} {
2843 $cflist tag add bold $y.0 "$y.0 lineend"
2846 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2847 set y [highlight_tree $y $path]
2853 proc treeclosedir {w dir} {
2854 global treediropen treeheight treeparent treeindex
2856 set ix $treeindex($dir)
2857 $w conf -state normal
2858 $w delete s:$ix e:$ix
2859 set treediropen($dir) 0
2860 $w image configure a:$ix -image tri-rt
2861 $w conf -state disabled
2862 set n [expr {1 - $treeheight($dir)}]
2863 while {$dir ne {}} {
2864 incr treeheight($dir) $n
2865 set dir $treeparent($dir)
2869 proc treeopendir {w dir} {
2870 global treediropen treeheight treeparent treecontents treeindex
2872 set ix $treeindex($dir)
2873 $w conf -state normal
2874 $w image configure a:$ix -image tri-dn
2875 $w mark set e:$ix s:$ix
2876 $w mark gravity e:$ix right
2879 set n [llength $treecontents($dir)]
2880 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2883 incr treeheight($x) $n
2885 foreach e $treecontents($dir) {
2887 if {[string index $e end] eq "/"} {
2888 set iy $treeindex($de)
2889 $w mark set d:$iy e:$ix
2890 $w mark gravity d:$iy left
2891 $w insert e:$ix $str
2892 set treediropen($de) 0
2893 $w image create e:$ix -align center -image tri-rt -padx 1 \
2895 $w insert e:$ix $e [highlight_tag $de]
2896 $w mark set s:$iy e:$ix
2897 $w mark gravity s:$iy left
2898 set treeheight($de) 1
2900 $w insert e:$ix $str
2901 $w insert e:$ix $e [highlight_tag $de]
2904 $w mark gravity e:$ix right
2905 $w conf -state disabled
2906 set treediropen($dir) 1
2907 set top [lindex [split [$w index @0,0] .] 0]
2908 set ht [$w cget -height]
2909 set l [lindex [split [$w index s:$ix] .] 0]
2912 } elseif {$l + $n + 1 > $top + $ht} {
2913 set top [expr {$l + $n + 2 - $ht}]
2921 proc treeclick {w x y} {
2922 global treediropen cmitmode ctext cflist cflist_top
2924 if {$cmitmode ne "tree"} return
2925 if {![info exists cflist_top]} return
2926 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2927 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2928 $cflist tag add highlight $l.0 "$l.0 lineend"
2934 set e [linetoelt $l]
2935 if {[string index $e end] ne "/"} {
2937 } elseif {$treediropen($e)} {
2944 proc setfilelist {id} {
2945 global treefilelist cflist jump_to_here
2947 treeview $cflist $treefilelist($id) 0
2948 if {$jump_to_here ne {}} {
2949 set f [lindex $jump_to_here 0]
2950 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
2956 image create bitmap tri-rt -background black -foreground blue -data {
2957 #define tri-rt_width 13
2958 #define tri-rt_height 13
2959 static unsigned char tri-rt_bits[] = {
2960 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2961 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2964 #define tri-rt-mask_width 13
2965 #define tri-rt-mask_height 13
2966 static unsigned char tri-rt-mask_bits[] = {
2967 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2968 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2971 image create bitmap tri-dn -background black -foreground blue -data {
2972 #define tri-dn_width 13
2973 #define tri-dn_height 13
2974 static unsigned char tri-dn_bits[] = {
2975 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2976 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2979 #define tri-dn-mask_width 13
2980 #define tri-dn-mask_height 13
2981 static unsigned char tri-dn-mask_bits[] = {
2982 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2983 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2987 image create bitmap reficon-T -background black -foreground yellow -data {
2988 #define tagicon_width 13
2989 #define tagicon_height 9
2990 static unsigned char tagicon_bits[] = {
2991 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2992 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2994 #define tagicon-mask_width 13
2995 #define tagicon-mask_height 9
2996 static unsigned char tagicon-mask_bits[] = {
2997 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2998 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3001 #define headicon_width 13
3002 #define headicon_height 9
3003 static unsigned char headicon_bits[] = {
3004 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3005 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3008 #define headicon-mask_width 13
3009 #define headicon-mask_height 9
3010 static unsigned char headicon-mask_bits[] = {
3011 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3012 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3014 image create bitmap reficon-H -background black -foreground green \
3015 -data $rectdata -maskdata $rectmask
3016 image create bitmap reficon-o -background black -foreground "#ddddff" \
3017 -data $rectdata -maskdata $rectmask
3019 proc init_flist {first} {
3020 global cflist cflist_top difffilestart
3022 $cflist conf -state normal
3023 $cflist delete 0.0 end
3025 $cflist insert end $first
3027 $cflist tag add highlight 1.0 "1.0 lineend"
3029 catch {unset cflist_top}
3031 $cflist conf -state disabled
3032 set difffilestart {}
3035 proc highlight_tag {f} {
3036 global highlight_paths
3038 foreach p $highlight_paths {
3039 if {[string match $p $f]} {
3046 proc highlight_filelist {} {
3047 global cmitmode cflist
3049 $cflist conf -state normal
3050 if {$cmitmode ne "tree"} {
3051 set end [lindex [split [$cflist index end] .] 0]
3052 for {set l 2} {$l < $end} {incr l} {
3053 set line [$cflist get $l.0 "$l.0 lineend"]
3054 if {[highlight_tag $line] ne {}} {
3055 $cflist tag add bold $l.0 "$l.0 lineend"
3061 $cflist conf -state disabled
3064 proc unhighlight_filelist {} {
3067 $cflist conf -state normal
3068 $cflist tag remove bold 1.0 end
3069 $cflist conf -state disabled
3072 proc add_flist {fl} {
3075 $cflist conf -state normal
3077 $cflist insert end "\n"
3078 $cflist insert end $f [highlight_tag $f]
3080 $cflist conf -state disabled
3083 proc sel_flist {w x y} {
3084 global ctext difffilestart cflist cflist_top cmitmode
3086 if {$cmitmode eq "tree"} return
3087 if {![info exists cflist_top]} return
3088 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3089 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3090 $cflist tag add highlight $l.0 "$l.0 lineend"
3095 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3099 proc pop_flist_menu {w X Y x y} {
3100 global ctext cflist cmitmode flist_menu flist_menu_file
3101 global treediffs diffids
3104 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3106 if {$cmitmode eq "tree"} {
3107 set e [linetoelt $l]
3108 if {[string index $e end] eq "/"} return
3110 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3112 set flist_menu_file $e
3113 set xdiffstate "normal"
3114 if {$cmitmode eq "tree"} {
3115 set xdiffstate "disabled"
3117 # Disable "External diff" item in tree mode
3118 $flist_menu entryconf 2 -state $xdiffstate
3119 tk_popup $flist_menu $X $Y
3122 proc find_ctext_fileinfo {line} {
3123 global ctext_file_names ctext_file_lines
3125 set ok [bsearch $ctext_file_lines $line]
3126 set tline [lindex $ctext_file_lines $ok]
3128 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3131 return [list [lindex $ctext_file_names $ok] $tline]
3135 proc pop_diff_menu {w X Y x y} {
3136 global ctext diff_menu flist_menu_file
3137 global diff_menu_txtpos diff_menu_line
3138 global diff_menu_filebase
3140 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3141 set diff_menu_line [lindex $diff_menu_txtpos 0]
3142 # don't pop up the menu on hunk-separator or file-separator lines
3143 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3147 set f [find_ctext_fileinfo $diff_menu_line]
3148 if {$f eq {}} return
3149 set flist_menu_file [lindex $f 0]
3150 set diff_menu_filebase [lindex $f 1]
3151 tk_popup $diff_menu $X $Y
3154 proc flist_hl {only} {
3155 global flist_menu_file findstring gdttype
3157 set x [shellquote $flist_menu_file]
3158 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3161 append findstring " " $x
3163 set gdttype [mc "touching paths:"]
3166 proc save_file_from_commit {filename output what} {
3169 if {[catch {exec git show $filename -- > $output} err]} {
3170 if {[string match "fatal: bad revision *" $err]} {
3173 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3179 proc external_diff_get_one_file {diffid filename diffdir} {
3180 global nullid nullid2 nullfile
3183 if {$diffid == $nullid} {
3184 set difffile [file join [file dirname $gitdir] $filename]
3185 if {[file exists $difffile]} {
3190 if {$diffid == $nullid2} {
3191 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3192 return [save_file_from_commit :$filename $difffile index]
3194 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3195 return [save_file_from_commit $diffid:$filename $difffile \
3199 proc external_diff {} {
3200 global gitktmpdir nullid nullid2
3201 global flist_menu_file
3204 global gitdir extdifftool
3206 if {[llength $diffids] == 1} {
3207 # no reference commit given
3208 set diffidto [lindex $diffids 0]
3209 if {$diffidto eq $nullid} {
3210 # diffing working copy with index
3211 set diffidfrom $nullid2
3212 } elseif {$diffidto eq $nullid2} {
3213 # diffing index with HEAD
3214 set diffidfrom "HEAD"
3216 # use first parent commit
3217 global parentlist selectedline
3218 set diffidfrom [lindex $parentlist $selectedline 0]
3221 set diffidfrom [lindex $diffids 0]
3222 set diffidto [lindex $diffids 1]
3225 # make sure that several diffs wont collide
3226 if {![info exists gitktmpdir]} {
3227 set gitktmpdir [file join [file dirname $gitdir] \
3228 [format ".gitk-tmp.%s" [pid]]]
3229 if {[catch {file mkdir $gitktmpdir} err]} {
3230 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3237 set diffdir [file join $gitktmpdir $diffnum]
3238 if {[catch {file mkdir $diffdir} err]} {
3239 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3243 # gather files to diff
3244 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3245 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3247 if {$difffromfile ne {} && $difftofile ne {}} {
3248 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3249 if {[catch {set fl [open |$cmd r]} err]} {
3250 file delete -force $diffdir
3251 error_popup "$extdifftool: [mc "command failed:"] $err"
3253 fconfigure $fl -blocking 0
3254 filerun $fl [list delete_at_eof $fl $diffdir]
3259 proc find_hunk_blamespec {base line} {
3262 # Find and parse the hunk header
3263 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3264 if {$s_lix eq {}} return
3266 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3267 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3268 s_line old_specs osz osz1 new_line nsz]} {
3272 # base lines for the parents
3273 set base_lines [list $new_line]
3274 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3275 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3276 old_spec old_line osz]} {
3279 lappend base_lines $old_line
3282 # Now scan the lines to determine offset within the hunk
3283 set max_parent [expr {[llength $base_lines]-2}]
3285 set s_lno [lindex [split $s_lix "."] 0]
3287 # Determine if the line is removed
3288 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3289 if {[string match {[-+ ]*} $chunk]} {
3290 set removed_idx [string first "-" $chunk]
3291 # Choose a parent index
3292 if {$removed_idx >= 0} {
3293 set parent $removed_idx
3295 set unchanged_idx [string first " " $chunk]
3296 if {$unchanged_idx >= 0} {
3297 set parent $unchanged_idx
3299 # blame the current commit
3303 # then count other lines that belong to it
3304 for {set i $line} {[incr i -1] > $s_lno} {} {
3305 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3306 # Determine if the line is removed
3307 set removed_idx [string first "-" $chunk]
3309 set code [string index $chunk $parent]
3310 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3314 if {$removed_idx < 0} {
3324 incr dline [lindex $base_lines $parent]
3325 return [list $parent $dline]
3328 proc external_blame_diff {} {
3329 global currentid cmitmode
3330 global diff_menu_txtpos diff_menu_line
3331 global diff_menu_filebase flist_menu_file
3333 if {$cmitmode eq "tree"} {
3335 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3337 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3339 set parent_idx [lindex $hinfo 0]
3340 set line [lindex $hinfo 1]
3347 external_blame $parent_idx $line
3350 # Find the SHA1 ID of the blob for file $fname in the index
3352 proc index_sha1 {fname} {
3353 set f [open [list | git ls-files -s $fname] r]
3354 while {[gets $f line] >= 0} {
3355 set info [lindex [split $line "\t"] 0]
3356 set stage [lindex $info 2]
3357 if {$stage eq "0" || $stage eq "2"} {
3359 return [lindex $info 1]
3366 # Turn an absolute path into one relative to the current directory
3367 proc make_relative {f} {
3368 set elts [file split $f]
3369 set here [file split [pwd]]
3374 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3381 set elts [concat $res [lrange $elts $ei end]]
3382 return [eval file join $elts]
3385 proc external_blame {parent_idx {line {}}} {
3386 global flist_menu_file gitdir
3387 global nullid nullid2
3388 global parentlist selectedline currentid
3390 if {$parent_idx > 0} {
3391 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3393 set base_commit $currentid
3396 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3397 error_popup [mc "No such commit"]
3401 set cmdline [list git gui blame]
3402 if {$line ne {} && $line > 1} {
3403 lappend cmdline "--line=$line"
3405 set f [file join [file dirname $gitdir] $flist_menu_file]
3406 # Unfortunately it seems git gui blame doesn't like
3407 # being given an absolute path...
3408 set f [make_relative $f]
3409 lappend cmdline $base_commit $f
3410 if {[catch {eval exec $cmdline &} err]} {
3411 error_popup "[mc "git gui blame: command failed:"] $err"
3415 proc show_line_source {} {
3416 global cmitmode currentid parents curview blamestuff blameinst
3417 global diff_menu_line diff_menu_filebase flist_menu_file
3418 global nullid nullid2 gitdir
3421 if {$cmitmode eq "tree"} {
3423 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3425 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3426 if {$h eq {}} return
3427 set pi [lindex $h 0]
3429 mark_ctext_line $diff_menu_line
3433 if {$currentid eq $nullid} {
3435 # must be a merge in progress...
3437 # get the last line from .git/MERGE_HEAD
3438 set f [open [file join $gitdir MERGE_HEAD] r]
3439 set id [lindex [split [read $f] "\n"] end-1]
3442 error_popup [mc "Couldn't read merge head: %s" $err]
3445 } elseif {$parents($curview,$currentid) eq $nullid2} {
3446 # need to do the blame from the index
3448 set from_index [index_sha1 $flist_menu_file]
3450 error_popup [mc "Error reading index: %s" $err]
3454 set id $parents($curview,$currentid)
3457 set id [lindex $parents($curview,$currentid) $pi]
3459 set line [lindex $h 1]
3462 if {$from_index ne {}} {
3463 lappend blameargs | git cat-file blob $from_index
3465 lappend blameargs | git blame -p -L$line,+1
3466 if {$from_index ne {}} {
3467 lappend blameargs --contents -
3469 lappend blameargs $id
3471 lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
3473 set f [open $blameargs r]
3475 error_popup [mc "Couldn't start git blame: %s" $err]
3478 nowbusy blaming [mc "Searching"]
3479 fconfigure $f -blocking 0
3480 set i [reg_instance $f]
3481 set blamestuff($i) {}
3483 filerun $f [list read_line_source $f $i]
3486 proc stopblaming {} {
3489 if {[info exists blameinst]} {
3490 stop_instance $blameinst
3496 proc read_line_source {fd inst} {
3497 global blamestuff curview commfd blameinst nullid nullid2
3499 while {[gets $fd line] >= 0} {
3500 lappend blamestuff($inst) $line
3508 fconfigure $fd -blocking 1
3509 if {[catch {close $fd} err]} {
3510 error_popup [mc "Error running git blame: %s" $err]
3515 set line [split [lindex $blamestuff($inst) 0] " "]
3516 set id [lindex $line 0]
3517 set lnum [lindex $line 1]
3518 if {[string length $id] == 40 && [string is xdigit $id] &&
3519 [string is digit -strict $lnum]} {
3520 # look for "filename" line
3521 foreach l $blamestuff($inst) {
3522 if {[string match "filename *" $l]} {
3523 set fname [string range $l 9 end]
3529 # all looks good, select it
3530 if {$id eq $nullid} {
3531 # blame uses all-zeroes to mean not committed,
3532 # which would mean a change in the index
3535 if {[commitinview $id $curview]} {
3536 selectline [rowofcommit $id] 1 [list $fname $lnum]
3538 error_popup [mc "That line comes from commit %s, \
3539 which is not in this view" [shortids $id]]
3542 puts "oops couldn't parse git blame output"
3547 # delete $dir when we see eof on $f (presumably because the child has exited)
3548 proc delete_at_eof {f dir} {
3549 while {[gets $f line] >= 0} {}
3551 if {[catch {close $f} err]} {
3552 error_popup "[mc "External diff viewer failed:"] $err"
3554 file delete -force $dir
3560 # Functions for adding and removing shell-type quoting
3562 proc shellquote {str} {
3563 if {![string match "*\['\"\\ \t]*" $str]} {
3566 if {![string match "*\['\"\\]*" $str]} {
3569 if {![string match "*'*" $str]} {
3572 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3575 proc shellarglist {l} {
3581 append str [shellquote $a]
3586 proc shelldequote {str} {
3591 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3592 append ret [string range $str $used end]
3593 set used [string length $str]
3596 set first [lindex $first 0]
3597 set ch [string index $str $first]
3598 if {$first > $used} {
3599 append ret [string range $str $used [expr {$first - 1}]]
3602 if {$ch eq " " || $ch eq "\t"} break
3605 set first [string first "'" $str $used]
3607 error "unmatched single-quote"
3609 append ret [string range $str $used [expr {$first - 1}]]
3614 if {$used >= [string length $str]} {
3615 error "trailing backslash"
3617 append ret [string index $str $used]
3622 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3623 error "unmatched double-quote"
3625 set first [lindex $first 0]
3626 set ch [string index $str $first]
3627 if {$first > $used} {
3628 append ret [string range $str $used [expr {$first - 1}]]
3631 if {$ch eq "\""} break
3633 append ret [string index $str $used]
3637 return [list $used $ret]
3640 proc shellsplit {str} {
3643 set str [string trimleft $str]
3644 if {$str eq {}} break
3645 set dq [shelldequote $str]
3646 set n [lindex $dq 0]
3647 set word [lindex $dq 1]
3648 set str [string range $str $n end]
3654 # Code to implement multiple views
3656 proc newview {ishighlight} {
3657 global nextviewnum newviewname newishighlight
3658 global revtreeargs viewargscmd newviewopts curview
3660 set newishighlight $ishighlight
3662 if {[winfo exists $top]} {
3666 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3667 set newviewopts($nextviewnum,perm) 0
3668 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3669 decode_view_opts $nextviewnum $revtreeargs
3670 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3673 set known_view_options {
3674 {perm b . {} {mc "Remember this view"}}
3675 {args t50= + {} {mc "Commits to include (arguments to git log):"}}
3676 {all b * "--all" {mc "Use all refs"}}
3677 {dorder b . {"--date-order" "-d"} {mc "Strictly sort by date"}}
3678 {lright b . "--left-right" {mc "Mark branch sides"}}
3679 {since t15 + {"--since=*" "--after=*"} {mc "Since date:"}}
3680 {until t15 . {"--until=*" "--before=*"} {mc "Until date:"}}
3681 {limit t10 + "--max-count=*" {mc "Max count:"}}
3682 {skip t10 . "--skip=*" {mc "Skip:"}}
3683 {first b . "--first-parent" {mc "Limit to first parent"}}
3684 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3687 proc encode_view_opts {n} {
3688 global known_view_options newviewopts
3691 foreach opt $known_view_options {
3692 set patterns [lindex $opt 3]
3693 if {$patterns eq {}} continue
3694 set pattern [lindex $patterns 0]
3696 set val $newviewopts($n,[lindex $opt 0])
3698 if {[lindex $opt 1] eq "b"} {
3700 lappend rargs $pattern
3703 set val [string trim $val]
3705 set pfix [string range $pattern 0 end-1]
3706 lappend rargs $pfix$val
3710 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3713 proc decode_view_opts {n view_args} {
3714 global known_view_options newviewopts
3716 foreach opt $known_view_options {
3717 if {[lindex $opt 1] eq "b"} {
3722 set newviewopts($n,[lindex $opt 0]) $val
3725 foreach arg $view_args {
3726 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3727 && ![info exists found(limit)]} {
3728 set newviewopts($n,limit) $cnt
3733 foreach opt $known_view_options {
3734 set id [lindex $opt 0]
3735 if {[info exists found($id)]} continue
3736 foreach pattern [lindex $opt 3] {
3737 if {![string match $pattern $arg]} continue
3738 if {[lindex $opt 1] ne "b"} {
3739 set size [string length $pattern]
3740 set val [string range $arg [expr {$size-1}] end]
3744 set newviewopts($n,$id) $val
3748 if {[info exists val]} break
3750 if {[info exists val]} continue
3753 set newviewopts($n,args) [shellarglist $oargs]
3756 proc edit_or_newview {} {
3768 global viewname viewperm newviewname newviewopts
3769 global viewargs viewargscmd
3771 set top .gitkvedit-$curview
3772 if {[winfo exists $top]} {
3776 set newviewname($curview) $viewname($curview)
3777 set newviewopts($curview,perm) $viewperm($curview)
3778 set newviewopts($curview,cmd) $viewargscmd($curview)
3779 decode_view_opts $curview $viewargs($curview)
3780 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
3783 proc vieweditor {top n title} {
3784 global newviewname newviewopts viewfiles bgcolor
3785 global known_view_options
3788 wm title $top $title
3789 make_transient $top .
3793 label $top.nl -text [mc "Name"]
3794 entry $top.name -width 20 -textvariable newviewname($n)
3795 pack $top.nfr -in $top -fill x -pady 5 -padx 3
3796 pack $top.nl -in $top.nfr -side left -padx {0 30}
3797 pack $top.name -in $top.nfr -side left
3803 foreach opt $known_view_options {
3804 set id [lindex $opt 0]
3805 set type [lindex $opt 1]
3806 set flags [lindex $opt 2]
3807 set title [eval [lindex $opt 4]]
3810 if {$flags eq "+" || $flags eq "*"} {
3811 set cframe $top.fr$cnt
3814 pack $cframe -in $top -fill x -pady 3 -padx 3
3815 set cexpand [expr {$flags eq "*"}]
3821 checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
3822 pack $cframe.c_$id -in $cframe -side left \
3823 -padx [list $lxpad 0] -expand $cexpand -anchor w
3824 } elseif {[regexp {^t(\d+)$} $type type sz]} {
3825 message $cframe.l_$id -aspect 1500 -text $title
3826 entry $cframe.e_$id -width $sz -background $bgcolor \
3827 -textvariable newviewopts($n,$id)
3828 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
3829 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
3830 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
3831 message $cframe.l_$id -aspect 1500 -text $title
3832 entry $cframe.e_$id -width $sz -background $bgcolor \
3833 -textvariable newviewopts($n,$id)
3834 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
3835 pack $cframe.e_$id -in $cframe -side top -fill x
3840 message $top.l -aspect 1500 \
3841 -text [mc "Enter files and directories to include, one per line:"]
3842 pack $top.l -in $top -side top -pady [list 7 0] -anchor w -padx 3
3843 text $top.t -width 40 -height 5 -background $bgcolor -font uifont
3844 if {[info exists viewfiles($n)]} {
3845 foreach f $viewfiles($n) {
3846 $top.t insert end $f
3847 $top.t insert end "\n"
3849 $top.t delete {end - 1c} end
3850 $top.t mark set insert 0.0
3852 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
3854 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3855 button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
3856 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3857 bind $top <Control-Return> [list newviewok $top $n]
3858 bind $top <F5> [list newviewok $top $n 1]
3859 bind $top <Escape> [list destroy $top]
3860 grid $top.buts.ok $top.buts.apply $top.buts.can
3861 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3862 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3863 grid columnconfigure $top.buts 2 -weight 1 -uniform a
3864 pack $top.buts -in $top -side top -fill x
3868 proc doviewmenu {m first cmd op argv} {
3869 set nmenu [$m index end]
3870 for {set i $first} {$i <= $nmenu} {incr i} {
3871 if {[$m entrycget $i -command] eq $cmd} {
3872 eval $m $op $i $argv
3878 proc allviewmenus {n op args} {
3881 doviewmenu .bar.view 5 [list showview $n] $op $args
3882 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3885 proc newviewok {top n {apply 0}} {
3886 global nextviewnum newviewperm newviewname newishighlight
3887 global viewname viewfiles viewperm selectedview curview
3888 global viewargs viewargscmd newviewopts viewhlmenu
3891 set newargs [encode_view_opts $n]
3893 error_popup "[mc "Error in commit selection arguments:"] $err" $top
3897 foreach f [split [$top.t get 0.0 end] "\n"] {
3898 set ft [string trim $f]
3903 if {![info exists viewfiles($n)]} {
3904 # creating a new view
3906 set viewname($n) $newviewname($n)
3907 set viewperm($n) $newviewopts($n,perm)
3908 set viewfiles($n) $files
3909 set viewargs($n) $newargs
3910 set viewargscmd($n) $newviewopts($n,cmd)
3912 if {!$newishighlight} {
3915 run addvhighlight $n
3918 # editing an existing view
3919 set viewperm($n) $newviewopts($n,perm)
3920 if {$newviewname($n) ne $viewname($n)} {
3921 set viewname($n) $newviewname($n)
3922 doviewmenu .bar.view 5 [list showview $n] \
3923 entryconf [list -label $viewname($n)]
3924 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3925 # entryconf [list -label $viewname($n) -value $viewname($n)]
3927 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3928 $newviewopts($n,cmd) ne $viewargscmd($n)} {
3929 set viewfiles($n) $files
3930 set viewargs($n) $newargs
3931 set viewargscmd($n) $newviewopts($n,cmd)
3932 if {$curview == $n} {
3938 catch {destroy $top}
3942 global curview viewperm hlview selectedhlview
3944 if {$curview == 0} return
3945 if {[info exists hlview] && $hlview == $curview} {
3946 set selectedhlview [mc "None"]
3949 allviewmenus $curview delete
3950 set viewperm($curview) 0
3954 proc addviewmenu {n} {
3955 global viewname viewhlmenu
3957 .bar.view add radiobutton -label $viewname($n) \
3958 -command [list showview $n] -variable selectedview -value $n
3959 #$viewhlmenu add radiobutton -label $viewname($n) \
3960 # -command [list addvhighlight $n] -variable selectedhlview
3964 global curview cached_commitrow ordertok
3965 global displayorder parentlist rowidlist rowisopt rowfinal
3966 global colormap rowtextx nextcolor canvxmax
3967 global numcommits viewcomplete
3968 global selectedline currentid canv canvy0
3970 global pending_select mainheadid
3973 global hlview selectedhlview commitinterest
3975 if {$n == $curview} return
3977 set ymax [lindex [$canv cget -scrollregion] 3]
3978 set span [$canv yview]
3979 set ytop [expr {[lindex $span 0] * $ymax}]
3980 set ybot [expr {[lindex $span 1] * $ymax}]
3981 set yscreen [expr {($ybot - $ytop) / 2}]
3982 if {$selectedline ne {}} {
3983 set selid $currentid
3984 set y [yc $selectedline]
3985 if {$ytop < $y && $y < $ybot} {
3986 set yscreen [expr {$y - $ytop}]
3988 } elseif {[info exists pending_select]} {
3989 set selid $pending_select
3990 unset pending_select
3994 catch {unset treediffs}
3996 if {[info exists hlview] && $hlview == $n} {
3998 set selectedhlview [mc "None"]
4000 catch {unset commitinterest}
4001 catch {unset cached_commitrow}
4002 catch {unset ordertok}
4006 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4007 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4010 if {![info exists viewcomplete($n)]} {
4020 set numcommits $commitidx($n)
4022 catch {unset colormap}
4023 catch {unset rowtextx}
4025 set canvxmax [$canv cget -width]
4031 if {$selid ne {} && [commitinview $selid $n]} {
4032 set row [rowofcommit $selid]
4033 # try to get the selected row in the same position on the screen
4034 set ymax [lindex [$canv cget -scrollregion] 3]
4035 set ytop [expr {[yc $row] - $yscreen}]
4039 set yf [expr {$ytop * 1.0 / $ymax}]
4041 allcanvs yview moveto $yf
4045 } elseif {!$viewcomplete($n)} {
4046 reset_pending_select $selid
4048 reset_pending_select {}
4050 if {[commitinview $pending_select $curview]} {
4051 selectline [rowofcommit $pending_select] 1
4053 set row [first_real_row]
4054 if {$row < $numcommits} {
4059 if {!$viewcomplete($n)} {
4060 if {$numcommits == 0} {
4061 show_status [mc "Reading commits..."]
4063 } elseif {$numcommits == 0} {
4064 show_status [mc "No commits selected"]
4068 # Stuff relating to the highlighting facility
4070 proc ishighlighted {id} {
4071 global vhighlights fhighlights nhighlights rhighlights
4073 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4074 return $nhighlights($id)
4076 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4077 return $vhighlights($id)
4079 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4080 return $fhighlights($id)
4082 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4083 return $rhighlights($id)
4088 proc bolden {id font} {
4089 global canv linehtag currentid boldids need_redisplay markedid
4091 # need_redisplay = 1 means the display is stale and about to be redrawn
4092 if {$need_redisplay} return
4094 $canv itemconf $linehtag($id) -font $font
4095 if {[info exists currentid] && $id eq $currentid} {
4097 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4098 -outline {{}} -tags secsel \
4099 -fill [$canv cget -selectbackground]]
4102 if {[info exists markedid] && $id eq $markedid} {
4107 proc bolden_name {id font} {
4108 global canv2 linentag currentid boldnameids need_redisplay
4110 if {$need_redisplay} return
4111 lappend boldnameids $id
4112 $canv2 itemconf $linentag($id) -font $font
4113 if {[info exists currentid] && $id eq $currentid} {
4114 $canv2 delete secsel
4115 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4116 -outline {{}} -tags secsel \
4117 -fill [$canv2 cget -selectbackground]]
4126 foreach id $boldids {
4127 if {![ishighlighted $id]} {
4130 lappend stillbold $id
4133 set boldids $stillbold
4136 proc addvhighlight {n} {
4137 global hlview viewcomplete curview vhl_done commitidx
4139 if {[info exists hlview]} {
4143 if {$n != $curview && ![info exists viewcomplete($n)]} {
4146 set vhl_done $commitidx($hlview)
4147 if {$vhl_done > 0} {
4152 proc delvhighlight {} {
4153 global hlview vhighlights
4155 if {![info exists hlview]} return
4157 catch {unset vhighlights}
4161 proc vhighlightmore {} {
4162 global hlview vhl_done commitidx vhighlights curview
4164 set max $commitidx($hlview)
4165 set vr [visiblerows]
4166 set r0 [lindex $vr 0]
4167 set r1 [lindex $vr 1]
4168 for {set i $vhl_done} {$i < $max} {incr i} {
4169 set id [commitonrow $i $hlview]
4170 if {[commitinview $id $curview]} {
4171 set row [rowofcommit $id]
4172 if {$r0 <= $row && $row <= $r1} {
4173 if {![highlighted $row]} {
4174 bolden $id mainfontbold
4176 set vhighlights($id) 1
4184 proc askvhighlight {row id} {
4185 global hlview vhighlights iddrawn
4187 if {[commitinview $id $hlview]} {
4188 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4189 bolden $id mainfontbold
4191 set vhighlights($id) 1
4193 set vhighlights($id) 0
4197 proc hfiles_change {} {
4198 global highlight_files filehighlight fhighlights fh_serial
4199 global highlight_paths
4201 if {[info exists filehighlight]} {
4202 # delete previous highlights
4203 catch {close $filehighlight}
4205 catch {unset fhighlights}
4207 unhighlight_filelist
4209 set highlight_paths {}
4210 after cancel do_file_hl $fh_serial
4212 if {$highlight_files ne {}} {
4213 after 300 do_file_hl $fh_serial
4217 proc gdttype_change {name ix op} {
4218 global gdttype highlight_files findstring findpattern
4221 if {$findstring ne {}} {
4222 if {$gdttype eq [mc "containing:"]} {
4223 if {$highlight_files ne {}} {
4224 set highlight_files {}
4229 if {$findpattern ne {}} {
4233 set highlight_files $findstring
4238 # enable/disable findtype/findloc menus too
4241 proc find_change {name ix op} {
4242 global gdttype findstring highlight_files
4245 if {$gdttype eq [mc "containing:"]} {
4248 if {$highlight_files ne $findstring} {
4249 set highlight_files $findstring
4256 proc findcom_change args {
4257 global nhighlights boldnameids
4258 global findpattern findtype findstring gdttype
4261 # delete previous highlights, if any
4262 foreach id $boldnameids {
4263 bolden_name $id mainfont
4266 catch {unset nhighlights}
4269 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4271 } elseif {$findtype eq [mc "Regexp"]} {
4272 set findpattern $findstring
4274 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4276 set findpattern "*$e*"
4280 proc makepatterns {l} {
4283 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4284 if {[string index $ee end] eq "/"} {
4294 proc do_file_hl {serial} {
4295 global highlight_files filehighlight highlight_paths gdttype fhl_list
4297 if {$gdttype eq [mc "touching paths:"]} {
4298 if {[catch {set paths [shellsplit $highlight_files]}]} return
4299 set highlight_paths [makepatterns $paths]
4301 set gdtargs [concat -- $paths]
4302 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4303 set gdtargs [list "-S$highlight_files"]
4305 # must be "containing:", i.e. we're searching commit info
4308 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4309 set filehighlight [open $cmd r+]
4310 fconfigure $filehighlight -blocking 0
4311 filerun $filehighlight readfhighlight
4317 proc flushhighlights {} {
4318 global filehighlight fhl_list
4320 if {[info exists filehighlight]} {
4322 puts $filehighlight ""
4323 flush $filehighlight
4327 proc askfilehighlight {row id} {
4328 global filehighlight fhighlights fhl_list
4330 lappend fhl_list $id
4331 set fhighlights($id) -1
4332 puts $filehighlight $id
4335 proc readfhighlight {} {
4336 global filehighlight fhighlights curview iddrawn
4337 global fhl_list find_dirn
4339 if {![info exists filehighlight]} {
4343 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4344 set line [string trim $line]
4345 set i [lsearch -exact $fhl_list $line]
4346 if {$i < 0} continue
4347 for {set j 0} {$j < $i} {incr j} {
4348 set id [lindex $fhl_list $j]
4349 set fhighlights($id) 0
4351 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4352 if {$line eq {}} continue
4353 if {![commitinview $line $curview]} continue
4354 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4355 bolden $line mainfontbold
4357 set fhighlights($line) 1
4359 if {[eof $filehighlight]} {
4361 puts "oops, git diff-tree died"
4362 catch {close $filehighlight}
4366 if {[info exists find_dirn]} {
4372 proc doesmatch {f} {
4373 global findtype findpattern
4375 if {$findtype eq [mc "Regexp"]} {
4376 return [regexp $findpattern $f]
4377 } elseif {$findtype eq [mc "IgnCase"]} {
4378 return [string match -nocase $findpattern $f]
4380 return [string match $findpattern $f]
4384 proc askfindhighlight {row id} {
4385 global nhighlights commitinfo iddrawn
4387 global markingmatches
4389 if {![info exists commitinfo($id)]} {
4392 set info $commitinfo($id)
4394 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4395 foreach f $info ty $fldtypes {
4396 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4398 if {$ty eq [mc "Author"]} {
4405 if {$isbold && [info exists iddrawn($id)]} {
4406 if {![ishighlighted $id]} {
4407 bolden $id mainfontbold
4409 bolden_name $id mainfontbold
4412 if {$markingmatches} {
4413 markrowmatches $row $id
4416 set nhighlights($id) $isbold
4419 proc markrowmatches {row id} {
4420 global canv canv2 linehtag linentag commitinfo findloc
4422 set headline [lindex $commitinfo($id) 0]
4423 set author [lindex $commitinfo($id) 1]
4424 $canv delete match$row
4425 $canv2 delete match$row
4426 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4427 set m [findmatches $headline]
4429 markmatches $canv $row $headline $linehtag($id) $m \
4430 [$canv itemcget $linehtag($id) -font] $row
4433 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4434 set m [findmatches $author]
4436 markmatches $canv2 $row $author $linentag($id) $m \
4437 [$canv2 itemcget $linentag($id) -font] $row
4442 proc vrel_change {name ix op} {
4443 global highlight_related
4446 if {$highlight_related ne [mc "None"]} {
4451 # prepare for testing whether commits are descendents or ancestors of a
4452 proc rhighlight_sel {a} {
4453 global descendent desc_todo ancestor anc_todo
4454 global highlight_related
4456 catch {unset descendent}
4457 set desc_todo [list $a]
4458 catch {unset ancestor}
4459 set anc_todo [list $a]
4460 if {$highlight_related ne [mc "None"]} {
4466 proc rhighlight_none {} {
4469 catch {unset rhighlights}
4473 proc is_descendent {a} {
4474 global curview children descendent desc_todo
4477 set la [rowofcommit $a]
4481 for {set i 0} {$i < [llength $todo]} {incr i} {
4482 set do [lindex $todo $i]
4483 if {[rowofcommit $do] < $la} {
4484 lappend leftover $do
4487 foreach nk $children($v,$do) {
4488 if {![info exists descendent($nk)]} {
4489 set descendent($nk) 1
4497 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4501 set descendent($a) 0
4502 set desc_todo $leftover
4505 proc is_ancestor {a} {
4506 global curview parents ancestor anc_todo
4509 set la [rowofcommit $a]
4513 for {set i 0} {$i < [llength $todo]} {incr i} {
4514 set do [lindex $todo $i]
4515 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4516 lappend leftover $do
4519 foreach np $parents($v,$do) {
4520 if {![info exists ancestor($np)]} {
4529 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4534 set anc_todo $leftover
4537 proc askrelhighlight {row id} {
4538 global descendent highlight_related iddrawn rhighlights
4539 global selectedline ancestor
4541 if {$selectedline eq {}} return
4543 if {$highlight_related eq [mc "Descendant"] ||
4544 $highlight_related eq [mc "Not descendant"]} {
4545 if {![info exists descendent($id)]} {
4548 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4551 } elseif {$highlight_related eq [mc "Ancestor"] ||
4552 $highlight_related eq [mc "Not ancestor"]} {
4553 if {![info exists ancestor($id)]} {
4556 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4560 if {[info exists iddrawn($id)]} {
4561 if {$isbold && ![ishighlighted $id]} {
4562 bolden $id mainfontbold
4565 set rhighlights($id) $isbold
4568 # Graph layout functions
4570 proc shortids {ids} {
4573 if {[llength $id] > 1} {
4574 lappend res [shortids $id]
4575 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4576 lappend res [string range $id 0 7]
4587 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4588 if {($n & $mask) != 0} {
4589 set ret [concat $ret $o]
4591 set o [concat $o $o]
4596 proc ordertoken {id} {
4597 global ordertok curview varcid varcstart varctok curview parents children
4598 global nullid nullid2
4600 if {[info exists ordertok($id)]} {
4601 return $ordertok($id)
4606 if {[info exists varcid($curview,$id)]} {
4607 set a $varcid($curview,$id)
4608 set p [lindex $varcstart($curview) $a]
4610 set p [lindex $children($curview,$id) 0]
4612 if {[info exists ordertok($p)]} {
4613 set tok $ordertok($p)
4616 set id [first_real_child $curview,$p]
4619 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4622 if {[llength $parents($curview,$id)] == 1} {
4623 lappend todo [list $p {}]
4625 set j [lsearch -exact $parents($curview,$id) $p]
4627 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4629 lappend todo [list $p [strrep $j]]
4632 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4633 set p [lindex $todo $i 0]
4634 append tok [lindex $todo $i 1]
4635 set ordertok($p) $tok
4637 set ordertok($origid) $tok
4641 # Work out where id should go in idlist so that order-token
4642 # values increase from left to right
4643 proc idcol {idlist id {i 0}} {
4644 set t [ordertoken $id]
4648 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4649 if {$i > [llength $idlist]} {
4650 set i [llength $idlist]
4652 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4655 if {$t > [ordertoken [lindex $idlist $i]]} {
4656 while {[incr i] < [llength $idlist] &&
4657 $t >= [ordertoken [lindex $idlist $i]]} {}
4663 proc initlayout {} {
4664 global rowidlist rowisopt rowfinal displayorder parentlist
4665 global numcommits canvxmax canv
4667 global colormap rowtextx
4676 set canvxmax [$canv cget -width]
4677 catch {unset colormap}
4678 catch {unset rowtextx}
4682 proc setcanvscroll {} {
4683 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4684 global lastscrollset lastscrollrows
4686 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4687 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4688 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4689 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4690 set lastscrollset [clock clicks -milliseconds]
4691 set lastscrollrows $numcommits
4694 proc visiblerows {} {
4695 global canv numcommits linespc
4697 set ymax [lindex [$canv cget -scrollregion] 3]
4698 if {$ymax eq {} || $ymax == 0} return
4700 set y0 [expr {int([lindex $f 0] * $ymax)}]
4701 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4705 set y1 [expr {int([lindex $f 1] * $ymax)}]
4706 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4707 if {$r1 >= $numcommits} {
4708 set r1 [expr {$numcommits - 1}]
4710 return [list $r0 $r1]
4713 proc layoutmore {} {
4714 global commitidx viewcomplete curview
4715 global numcommits pending_select curview
4716 global lastscrollset lastscrollrows
4718 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4719 [clock clicks -milliseconds] - $lastscrollset > 500} {
4722 if {[info exists pending_select] &&
4723 [commitinview $pending_select $curview]} {
4725 selectline [rowofcommit $pending_select] 1
4730 # With path limiting, we mightn't get the actual HEAD commit,
4731 # so ask git rev-list what is the first ancestor of HEAD that
4732 # touches a file in the path limit.
4733 proc get_viewmainhead {view} {
4734 global viewmainheadid vfilelimit viewinstances mainheadid
4737 set rfd [open [concat | git rev-list -1 $mainheadid \
4738 -- $vfilelimit($view)] r]
4739 set j [reg_instance $rfd]
4740 lappend viewinstances($view) $j
4741 fconfigure $rfd -blocking 0
4742 filerun $rfd [list getviewhead $rfd $j $view]
4743 set viewmainheadid($curview) {}
4747 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4748 proc getviewhead {fd inst view} {
4749 global viewmainheadid commfd curview viewinstances showlocalchanges
4752 if {[gets $fd line] < 0} {
4756 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4759 set viewmainheadid($view) $id
4762 set i [lsearch -exact $viewinstances($view) $inst]
4764 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4766 if {$showlocalchanges && $id ne {} && $view == $curview} {
4772 proc doshowlocalchanges {} {
4773 global curview viewmainheadid
4775 if {$viewmainheadid($curview) eq {}} return
4776 if {[commitinview $viewmainheadid($curview) $curview]} {
4779 interestedin $viewmainheadid($curview) dodiffindex
4783 proc dohidelocalchanges {} {
4784 global nullid nullid2 lserial curview
4786 if {[commitinview $nullid $curview]} {
4787 removefakerow $nullid
4789 if {[commitinview $nullid2 $curview]} {
4790 removefakerow $nullid2
4795 # spawn off a process to do git diff-index --cached HEAD
4796 proc dodiffindex {} {
4797 global lserial showlocalchanges vfilelimit curview
4800 if {!$showlocalchanges || !$isworktree} return
4802 set cmd "|git diff-index --cached HEAD"
4803 if {$vfilelimit($curview) ne {}} {
4804 set cmd [concat $cmd -- $vfilelimit($curview)]
4806 set fd [open $cmd r]
4807 fconfigure $fd -blocking 0
4808 set i [reg_instance $fd]
4809 filerun $fd [list readdiffindex $fd $lserial $i]
4812 proc readdiffindex {fd serial inst} {
4813 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
4817 if {[gets $fd line] < 0} {
4823 # we only need to see one line and we don't really care what it says...
4826 if {$serial != $lserial} {
4830 # now see if there are any local changes not checked in to the index
4831 set cmd "|git diff-files"
4832 if {$vfilelimit($curview) ne {}} {
4833 set cmd [concat $cmd -- $vfilelimit($curview)]
4835 set fd [open $cmd r]
4836 fconfigure $fd -blocking 0
4837 set i [reg_instance $fd]
4838 filerun $fd [list readdifffiles $fd $serial $i]
4840 if {$isdiff && ![commitinview $nullid2 $curview]} {
4841 # add the line for the changes in the index to the graph
4842 set hl [mc "Local changes checked in to index but not committed"]
4843 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4844 set commitdata($nullid2) "\n $hl\n"
4845 if {[commitinview $nullid $curview]} {
4846 removefakerow $nullid
4848 insertfakerow $nullid2 $viewmainheadid($curview)
4849 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4850 if {[commitinview $nullid $curview]} {
4851 removefakerow $nullid
4853 removefakerow $nullid2
4858 proc readdifffiles {fd serial inst} {
4859 global viewmainheadid nullid nullid2 curview
4860 global commitinfo commitdata lserial
4863 if {[gets $fd line] < 0} {
4869 # we only need to see one line and we don't really care what it says...
4872 if {$serial != $lserial} {
4876 if {$isdiff && ![commitinview $nullid $curview]} {
4877 # add the line for the local diff to the graph
4878 set hl [mc "Local uncommitted changes, not checked in to index"]
4879 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4880 set commitdata($nullid) "\n $hl\n"
4881 if {[commitinview $nullid2 $curview]} {
4884 set p $viewmainheadid($curview)
4886 insertfakerow $nullid $p
4887 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4888 removefakerow $nullid
4893 proc nextuse {id row} {
4894 global curview children
4896 if {[info exists children($curview,$id)]} {
4897 foreach kid $children($curview,$id) {
4898 if {![commitinview $kid $curview]} {
4901 if {[rowofcommit $kid] > $row} {
4902 return [rowofcommit $kid]
4906 if {[commitinview $id $curview]} {
4907 return [rowofcommit $id]
4912 proc prevuse {id row} {
4913 global curview children
4916 if {[info exists children($curview,$id)]} {
4917 foreach kid $children($curview,$id) {
4918 if {![commitinview $kid $curview]} break
4919 if {[rowofcommit $kid] < $row} {
4920 set ret [rowofcommit $kid]
4927 proc make_idlist {row} {
4928 global displayorder parentlist uparrowlen downarrowlen mingaplen
4929 global commitidx curview children
4931 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4935 set ra [expr {$row - $downarrowlen}]
4939 set rb [expr {$row + $uparrowlen}]
4940 if {$rb > $commitidx($curview)} {
4941 set rb $commitidx($curview)
4943 make_disporder $r [expr {$rb + 1}]
4945 for {} {$r < $ra} {incr r} {
4946 set nextid [lindex $displayorder [expr {$r + 1}]]
4947 foreach p [lindex $parentlist $r] {
4948 if {$p eq $nextid} continue
4949 set rn [nextuse $p $r]
4951 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4952 lappend ids [list [ordertoken $p] $p]
4956 for {} {$r < $row} {incr r} {
4957 set nextid [lindex $displayorder [expr {$r + 1}]]
4958 foreach p [lindex $parentlist $r] {
4959 if {$p eq $nextid} continue
4960 set rn [nextuse $p $r]
4961 if {$rn < 0 || $rn >= $row} {
4962 lappend ids [list [ordertoken $p] $p]
4966 set id [lindex $displayorder $row]
4967 lappend ids [list [ordertoken $id] $id]
4969 foreach p [lindex $parentlist $r] {
4970 set firstkid [lindex $children($curview,$p) 0]
4971 if {[rowofcommit $firstkid] < $row} {
4972 lappend ids [list [ordertoken $p] $p]
4976 set id [lindex $displayorder $r]
4978 set firstkid [lindex $children($curview,$id) 0]
4979 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4980 lappend ids [list [ordertoken $id] $id]
4985 foreach idx [lsort -unique $ids] {
4986 lappend idlist [lindex $idx 1]
4991 proc rowsequal {a b} {
4992 while {[set i [lsearch -exact $a {}]] >= 0} {
4993 set a [lreplace $a $i $i]
4995 while {[set i [lsearch -exact $b {}]] >= 0} {
4996 set b [lreplace $b $i $i]
4998 return [expr {$a eq $b}]
5001 proc makeupline {id row rend col} {
5002 global rowidlist uparrowlen downarrowlen mingaplen
5004 for {set r $rend} {1} {set r $rstart} {
5005 set rstart [prevuse $id $r]
5006 if {$rstart < 0} return
5007 if {$rstart < $row} break
5009 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5010 set rstart [expr {$rend - $uparrowlen - 1}]
5012 for {set r $rstart} {[incr r] <= $row} {} {
5013 set idlist [lindex $rowidlist $r]
5014 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5015 set col [idcol $idlist $id $col]
5016 lset rowidlist $r [linsert $idlist $col $id]
5022 proc layoutrows {row endrow} {
5023 global rowidlist rowisopt rowfinal displayorder
5024 global uparrowlen downarrowlen maxwidth mingaplen
5025 global children parentlist
5026 global commitidx viewcomplete curview
5028 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5031 set rm1 [expr {$row - 1}]
5032 foreach id [lindex $rowidlist $rm1] {
5037 set final [lindex $rowfinal $rm1]
5039 for {} {$row < $endrow} {incr row} {
5040 set rm1 [expr {$row - 1}]
5041 if {$rm1 < 0 || $idlist eq {}} {
5042 set idlist [make_idlist $row]
5045 set id [lindex $displayorder $rm1]
5046 set col [lsearch -exact $idlist $id]
5047 set idlist [lreplace $idlist $col $col]
5048 foreach p [lindex $parentlist $rm1] {
5049 if {[lsearch -exact $idlist $p] < 0} {
5050 set col [idcol $idlist $p $col]
5051 set idlist [linsert $idlist $col $p]
5052 # if not the first child, we have to insert a line going up
5053 if {$id ne [lindex $children($curview,$p) 0]} {
5054 makeupline $p $rm1 $row $col
5058 set id [lindex $displayorder $row]
5059 if {$row > $downarrowlen} {
5060 set termrow [expr {$row - $downarrowlen - 1}]
5061 foreach p [lindex $parentlist $termrow] {
5062 set i [lsearch -exact $idlist $p]
5063 if {$i < 0} continue
5064 set nr [nextuse $p $termrow]
5065 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5066 set idlist [lreplace $idlist $i $i]
5070 set col [lsearch -exact $idlist $id]
5072 set col [idcol $idlist $id]
5073 set idlist [linsert $idlist $col $id]
5074 if {$children($curview,$id) ne {}} {
5075 makeupline $id $rm1 $row $col
5078 set r [expr {$row + $uparrowlen - 1}]
5079 if {$r < $commitidx($curview)} {
5081 foreach p [lindex $parentlist $r] {
5082 if {[lsearch -exact $idlist $p] >= 0} continue
5083 set fk [lindex $children($curview,$p) 0]
5084 if {[rowofcommit $fk] < $row} {
5085 set x [idcol $idlist $p $x]
5086 set idlist [linsert $idlist $x $p]
5089 if {[incr r] < $commitidx($curview)} {
5090 set p [lindex $displayorder $r]
5091 if {[lsearch -exact $idlist $p] < 0} {
5092 set fk [lindex $children($curview,$p) 0]
5093 if {$fk ne {} && [rowofcommit $fk] < $row} {
5094 set x [idcol $idlist $p $x]
5095 set idlist [linsert $idlist $x $p]
5101 if {$final && !$viewcomplete($curview) &&
5102 $row + $uparrowlen + $mingaplen + $downarrowlen
5103 >= $commitidx($curview)} {
5106 set l [llength $rowidlist]
5108 lappend rowidlist $idlist
5110 lappend rowfinal $final
5111 } elseif {$row < $l} {
5112 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5113 lset rowidlist $row $idlist
5116 lset rowfinal $row $final
5118 set pad [ntimes [expr {$row - $l}] {}]
5119 set rowidlist [concat $rowidlist $pad]
5120 lappend rowidlist $idlist
5121 set rowfinal [concat $rowfinal $pad]
5122 lappend rowfinal $final
5123 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5129 proc changedrow {row} {
5130 global displayorder iddrawn rowisopt need_redisplay
5132 set l [llength $rowisopt]
5134 lset rowisopt $row 0
5135 if {$row + 1 < $l} {
5136 lset rowisopt [expr {$row + 1}] 0
5137 if {$row + 2 < $l} {
5138 lset rowisopt [expr {$row + 2}] 0
5142 set id [lindex $displayorder $row]
5143 if {[info exists iddrawn($id)]} {
5144 set need_redisplay 1
5148 proc insert_pad {row col npad} {
5151 set pad [ntimes $npad {}]
5152 set idlist [lindex $rowidlist $row]
5153 set bef [lrange $idlist 0 [expr {$col - 1}]]
5154 set aft [lrange $idlist $col end]
5155 set i [lsearch -exact $aft {}]
5157 set aft [lreplace $aft $i $i]
5159 lset rowidlist $row [concat $bef $pad $aft]
5163 proc optimize_rows {row col endrow} {
5164 global rowidlist rowisopt displayorder curview children
5169 for {} {$row < $endrow} {incr row; set col 0} {
5170 if {[lindex $rowisopt $row]} continue
5172 set y0 [expr {$row - 1}]
5173 set ym [expr {$row - 2}]
5174 set idlist [lindex $rowidlist $row]
5175 set previdlist [lindex $rowidlist $y0]
5176 if {$idlist eq {} || $previdlist eq {}} continue
5178 set pprevidlist [lindex $rowidlist $ym]
5179 if {$pprevidlist eq {}} continue
5185 for {} {$col < [llength $idlist]} {incr col} {
5186 set id [lindex $idlist $col]
5187 if {[lindex $previdlist $col] eq $id} continue
5192 set x0 [lsearch -exact $previdlist $id]
5193 if {$x0 < 0} continue
5194 set z [expr {$x0 - $col}]
5198 set xm [lsearch -exact $pprevidlist $id]
5200 set z0 [expr {$xm - $x0}]
5204 # if row y0 is the first child of $id then it's not an arrow
5205 if {[lindex $children($curview,$id) 0] ne
5206 [lindex $displayorder $y0]} {
5210 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5211 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5214 # Looking at lines from this row to the previous row,
5215 # make them go straight up if they end in an arrow on
5216 # the previous row; otherwise make them go straight up
5218 if {$z < -1 || ($z < 0 && $isarrow)} {
5219 # Line currently goes left too much;
5220 # insert pads in the previous row, then optimize it
5221 set npad [expr {-1 - $z + $isarrow}]
5222 insert_pad $y0 $x0 $npad
5224 optimize_rows $y0 $x0 $row
5226 set previdlist [lindex $rowidlist $y0]
5227 set x0 [lsearch -exact $previdlist $id]
5228 set z [expr {$x0 - $col}]
5230 set pprevidlist [lindex $rowidlist $ym]
5231 set xm [lsearch -exact $pprevidlist $id]
5232 set z0 [expr {$xm - $x0}]
5234 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5235 # Line currently goes right too much;
5236 # insert pads in this line
5237 set npad [expr {$z - 1 + $isarrow}]
5238 insert_pad $row $col $npad
5239 set idlist [lindex $rowidlist $row]
5241 set z [expr {$x0 - $col}]
5244 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5245 # this line links to its first child on row $row-2
5246 set id [lindex $displayorder $ym]
5247 set xc [lsearch -exact $pprevidlist $id]
5249 set z0 [expr {$xc - $x0}]
5252 # avoid lines jigging left then immediately right
5253 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5254 insert_pad $y0 $x0 1
5256 optimize_rows $y0 $x0 $row
5257 set previdlist [lindex $rowidlist $y0]
5261 # Find the first column that doesn't have a line going right
5262 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5263 set id [lindex $idlist $col]
5264 if {$id eq {}} break
5265 set x0 [lsearch -exact $previdlist $id]
5267 # check if this is the link to the first child
5268 set kid [lindex $displayorder $y0]
5269 if {[lindex $children($curview,$id) 0] eq $kid} {
5270 # it is, work out offset to child
5271 set x0 [lsearch -exact $previdlist $kid]
5274 if {$x0 <= $col} break
5276 # Insert a pad at that column as long as it has a line and
5277 # isn't the last column
5278 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5279 set idlist [linsert $idlist $col {}]
5280 lset rowidlist $row $idlist
5288 global canvx0 linespc
5289 return [expr {$canvx0 + $col * $linespc}]
5293 global canvy0 linespc
5294 return [expr {$canvy0 + $row * $linespc}]
5297 proc linewidth {id} {
5298 global thickerline lthickness
5301 if {[info exists thickerline] && $id eq $thickerline} {
5302 set wid [expr {2 * $lthickness}]
5307 proc rowranges {id} {
5308 global curview children uparrowlen downarrowlen
5311 set kids $children($curview,$id)
5317 foreach child $kids {
5318 if {![commitinview $child $curview]} break
5319 set row [rowofcommit $child]
5320 if {![info exists prev]} {
5321 lappend ret [expr {$row + 1}]
5323 if {$row <= $prevrow} {
5324 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5326 # see if the line extends the whole way from prevrow to row
5327 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5328 [lsearch -exact [lindex $rowidlist \
5329 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5330 # it doesn't, see where it ends
5331 set r [expr {$prevrow + $downarrowlen}]
5332 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5333 while {[incr r -1] > $prevrow &&
5334 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5336 while {[incr r] <= $row &&
5337 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5341 # see where it starts up again
5342 set r [expr {$row - $uparrowlen}]
5343 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5344 while {[incr r] < $row &&
5345 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5347 while {[incr r -1] >= $prevrow &&
5348 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5354 if {$child eq $id} {
5363 proc drawlineseg {id row endrow arrowlow} {
5364 global rowidlist displayorder iddrawn linesegs
5365 global canv colormap linespc curview maxlinelen parentlist
5367 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5368 set le [expr {$row + 1}]
5371 set c [lsearch -exact [lindex $rowidlist $le] $id]
5377 set x [lindex $displayorder $le]
5382 if {[info exists iddrawn($x)] || $le == $endrow} {
5383 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5399 if {[info exists linesegs($id)]} {
5400 set lines $linesegs($id)
5402 set r0 [lindex $li 0]
5404 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5414 set li [lindex $lines [expr {$i-1}]]
5415 set r1 [lindex $li 1]
5416 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5421 set x [lindex $cols [expr {$le - $row}]]
5422 set xp [lindex $cols [expr {$le - 1 - $row}]]
5423 set dir [expr {$xp - $x}]
5425 set ith [lindex $lines $i 2]
5426 set coords [$canv coords $ith]
5427 set ah [$canv itemcget $ith -arrow]
5428 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5429 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5430 if {$x2 ne {} && $x - $x2 == $dir} {
5431 set coords [lrange $coords 0 end-2]
5434 set coords [list [xc $le $x] [yc $le]]
5437 set itl [lindex $lines [expr {$i-1}] 2]
5438 set al [$canv itemcget $itl -arrow]
5439 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5440 } elseif {$arrowlow} {
5441 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5442 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5446 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5447 for {set y $le} {[incr y -1] > $row} {} {
5449 set xp [lindex $cols [expr {$y - 1 - $row}]]
5450 set ndir [expr {$xp - $x}]
5451 if {$dir != $ndir || $xp < 0} {
5452 lappend coords [xc $y $x] [yc $y]
5458 # join parent line to first child
5459 set ch [lindex $displayorder $row]
5460 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5462 puts "oops: drawlineseg: child $ch not on row $row"
5463 } elseif {$xc != $x} {
5464 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5465 set d [expr {int(0.5 * $linespc)}]
5468 set x2 [expr {$x1 - $d}]
5470 set x2 [expr {$x1 + $d}]
5473 set y1 [expr {$y2 + $d}]
5474 lappend coords $x1 $y1 $x2 $y2
5475 } elseif {$xc < $x - 1} {
5476 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5477 } elseif {$xc > $x + 1} {
5478 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5482 lappend coords [xc $row $x] [yc $row]
5484 set xn [xc $row $xp]
5486 lappend coords $xn $yn
5490 set t [$canv create line $coords -width [linewidth $id] \
5491 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5494 set lines [linsert $lines $i [list $row $le $t]]
5496 $canv coords $ith $coords
5497 if {$arrow ne $ah} {
5498 $canv itemconf $ith -arrow $arrow
5500 lset lines $i 0 $row
5503 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5504 set ndir [expr {$xo - $xp}]
5505 set clow [$canv coords $itl]
5506 if {$dir == $ndir} {
5507 set clow [lrange $clow 2 end]
5509 set coords [concat $coords $clow]
5511 lset lines [expr {$i-1}] 1 $le
5513 # coalesce two pieces
5515 set b [lindex $lines [expr {$i-1}] 0]
5516 set e [lindex $lines $i 1]
5517 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5519 $canv coords $itl $coords
5520 if {$arrow ne $al} {
5521 $canv itemconf $itl -arrow $arrow
5525 set linesegs($id) $lines
5529 proc drawparentlinks {id row} {
5530 global rowidlist canv colormap curview parentlist
5531 global idpos linespc
5533 set rowids [lindex $rowidlist $row]
5534 set col [lsearch -exact $rowids $id]
5535 if {$col < 0} return
5536 set olds [lindex $parentlist $row]
5537 set row2 [expr {$row + 1}]
5538 set x [xc $row $col]
5541 set d [expr {int(0.5 * $linespc)}]
5542 set ymid [expr {$y + $d}]
5543 set ids [lindex $rowidlist $row2]
5544 # rmx = right-most X coord used
5547 set i [lsearch -exact $ids $p]
5549 puts "oops, parent $p of $id not in list"
5552 set x2 [xc $row2 $i]
5556 set j [lsearch -exact $rowids $p]
5558 # drawlineseg will do this one for us
5562 # should handle duplicated parents here...
5563 set coords [list $x $y]
5565 # if attaching to a vertical segment, draw a smaller
5566 # slant for visual distinctness
5569 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5571 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5573 } elseif {$i < $col && $i < $j} {
5574 # segment slants towards us already
5575 lappend coords [xc $row $j] $y
5577 if {$i < $col - 1} {
5578 lappend coords [expr {$x2 + $linespc}] $y
5579 } elseif {$i > $col + 1} {
5580 lappend coords [expr {$x2 - $linespc}] $y
5582 lappend coords $x2 $y2
5585 lappend coords $x2 $y2
5587 set t [$canv create line $coords -width [linewidth $p] \
5588 -fill $colormap($p) -tags lines.$p]
5592 if {$rmx > [lindex $idpos($id) 1]} {
5593 lset idpos($id) 1 $rmx
5598 proc drawlines {id} {
5601 $canv itemconf lines.$id -width [linewidth $id]
5604 proc drawcmittext {id row col} {
5605 global linespc canv canv2 canv3 fgcolor curview
5606 global cmitlisted commitinfo rowidlist parentlist
5607 global rowtextx idpos idtags idheads idotherrefs
5608 global linehtag linentag linedtag selectedline
5609 global canvxmax boldids boldnameids fgcolor markedid
5610 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5612 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5613 set listed $cmitlisted($curview,$id)
5614 if {$id eq $nullid} {
5616 } elseif {$id eq $nullid2} {
5618 } elseif {$id eq $mainheadid} {
5621 set ofill [lindex $circlecolors $listed]
5623 set x [xc $row $col]
5625 set orad [expr {$linespc / 3}]
5627 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5628 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5629 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5630 } elseif {$listed == 3} {
5631 # triangle pointing left for left-side commits
5632 set t [$canv create polygon \
5633 [expr {$x - $orad}] $y \
5634 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5635 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5636 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5638 # triangle pointing right for right-side commits
5639 set t [$canv create polygon \
5640 [expr {$x + $orad - 1}] $y \
5641 [expr {$x - $orad}] [expr {$y - $orad}] \
5642 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5643 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5645 set circleitem($row) $t
5647 $canv bind $t <1> {selcanvline {} %x %y}
5648 set rmx [llength [lindex $rowidlist $row]]
5649 set olds [lindex $parentlist $row]
5651 set nextids [lindex $rowidlist [expr {$row + 1}]]
5653 set i [lsearch -exact $nextids $p]
5659 set xt [xc $row $rmx]
5660 set rowtextx($row) $xt
5661 set idpos($id) [list $x $xt $y]
5662 if {[info exists idtags($id)] || [info exists idheads($id)]
5663 || [info exists idotherrefs($id)]} {
5664 set xt [drawtags $id $x $xt $y]
5666 set headline [lindex $commitinfo($id) 0]
5667 set name [lindex $commitinfo($id) 1]
5668 set date [lindex $commitinfo($id) 2]
5669 set date [formatdate $date]
5672 set isbold [ishighlighted $id]
5675 set font mainfontbold
5677 lappend boldnameids $id
5678 set nfont mainfontbold
5681 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5682 -text $headline -font $font -tags text]
5683 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5684 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5685 -text $name -font $nfont -tags text]
5686 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5687 -text $date -font mainfont -tags text]
5688 if {$selectedline == $row} {
5691 if {[info exists markedid] && $markedid eq $id} {
5694 set xr [expr {$xt + [font measure $font $headline]}]
5695 if {$xr > $canvxmax} {
5701 proc drawcmitrow {row} {
5702 global displayorder rowidlist nrows_drawn
5703 global iddrawn markingmatches
5704 global commitinfo numcommits
5705 global filehighlight fhighlights findpattern nhighlights
5706 global hlview vhighlights
5707 global highlight_related rhighlights
5709 if {$row >= $numcommits} return
5711 set id [lindex $displayorder $row]
5712 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5713 askvhighlight $row $id
5715 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5716 askfilehighlight $row $id
5718 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5719 askfindhighlight $row $id
5721 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5722 askrelhighlight $row $id
5724 if {![info exists iddrawn($id)]} {
5725 set col [lsearch -exact [lindex $rowidlist $row] $id]
5727 puts "oops, row $row id $id not in list"
5730 if {![info exists commitinfo($id)]} {
5734 drawcmittext $id $row $col
5738 if {$markingmatches} {
5739 markrowmatches $row $id
5743 proc drawcommits {row {endrow {}}} {
5744 global numcommits iddrawn displayorder curview need_redisplay
5745 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5750 if {$endrow eq {}} {
5753 if {$endrow >= $numcommits} {
5754 set endrow [expr {$numcommits - 1}]
5757 set rl1 [expr {$row - $downarrowlen - 3}]
5761 set ro1 [expr {$row - 3}]
5765 set r2 [expr {$endrow + $uparrowlen + 3}]
5766 if {$r2 > $numcommits} {
5769 for {set r $rl1} {$r < $r2} {incr r} {
5770 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5774 set rl1 [expr {$r + 1}]
5780 optimize_rows $ro1 0 $r2
5781 if {$need_redisplay || $nrows_drawn > 2000} {
5785 # make the lines join to already-drawn rows either side
5786 set r [expr {$row - 1}]
5787 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5790 set er [expr {$endrow + 1}]
5791 if {$er >= $numcommits ||
5792 ![info exists iddrawn([lindex $displayorder $er])]} {
5795 for {} {$r <= $er} {incr r} {
5796 set id [lindex $displayorder $r]
5797 set wasdrawn [info exists iddrawn($id)]
5799 if {$r == $er} break
5800 set nextid [lindex $displayorder [expr {$r + 1}]]
5801 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5802 drawparentlinks $id $r
5804 set rowids [lindex $rowidlist $r]
5805 foreach lid $rowids {
5806 if {$lid eq {}} continue
5807 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5809 # see if this is the first child of any of its parents
5810 foreach p [lindex $parentlist $r] {
5811 if {[lsearch -exact $rowids $p] < 0} {
5812 # make this line extend up to the child
5813 set lineend($p) [drawlineseg $p $r $er 0]
5817 set lineend($lid) [drawlineseg $lid $r $er 1]
5823 proc undolayout {row} {
5824 global uparrowlen mingaplen downarrowlen
5825 global rowidlist rowisopt rowfinal need_redisplay
5827 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5831 if {[llength $rowidlist] > $r} {
5833 set rowidlist [lrange $rowidlist 0 $r]
5834 set rowfinal [lrange $rowfinal 0 $r]
5835 set rowisopt [lrange $rowisopt 0 $r]
5836 set need_redisplay 1
5841 proc drawvisible {} {
5842 global canv linespc curview vrowmod selectedline targetrow targetid
5843 global need_redisplay cscroll numcommits
5845 set fs [$canv yview]
5846 set ymax [lindex [$canv cget -scrollregion] 3]
5847 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5848 set f0 [lindex $fs 0]
5849 set f1 [lindex $fs 1]
5850 set y0 [expr {int($f0 * $ymax)}]
5851 set y1 [expr {int($f1 * $ymax)}]
5853 if {[info exists targetid]} {
5854 if {[commitinview $targetid $curview]} {
5855 set r [rowofcommit $targetid]
5856 if {$r != $targetrow} {
5857 # Fix up the scrollregion and change the scrolling position
5858 # now that our target row has moved.
5859 set diff [expr {($r - $targetrow) * $linespc}]
5862 set ymax [lindex [$canv cget -scrollregion] 3]
5865 set f0 [expr {$y0 / $ymax}]
5866 set f1 [expr {$y1 / $ymax}]
5867 allcanvs yview moveto $f0
5868 $cscroll set $f0 $f1
5869 set need_redisplay 1
5876 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5877 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5878 if {$endrow >= $vrowmod($curview)} {
5879 update_arcrows $curview
5881 if {$selectedline ne {} &&
5882 $row <= $selectedline && $selectedline <= $endrow} {
5883 set targetrow $selectedline
5884 } elseif {[info exists targetid]} {
5885 set targetrow [expr {int(($row + $endrow) / 2)}]
5887 if {[info exists targetrow]} {
5888 if {$targetrow >= $numcommits} {
5889 set targetrow [expr {$numcommits - 1}]
5891 set targetid [commitonrow $targetrow]
5893 drawcommits $row $endrow
5896 proc clear_display {} {
5897 global iddrawn linesegs need_redisplay nrows_drawn
5898 global vhighlights fhighlights nhighlights rhighlights
5899 global linehtag linentag linedtag boldids boldnameids
5902 catch {unset iddrawn}
5903 catch {unset linesegs}
5904 catch {unset linehtag}
5905 catch {unset linentag}
5906 catch {unset linedtag}
5909 catch {unset vhighlights}
5910 catch {unset fhighlights}
5911 catch {unset nhighlights}
5912 catch {unset rhighlights}
5913 set need_redisplay 0
5917 proc findcrossings {id} {
5918 global rowidlist parentlist numcommits displayorder
5922 foreach {s e} [rowranges $id] {
5923 if {$e >= $numcommits} {
5924 set e [expr {$numcommits - 1}]
5926 if {$e <= $s} continue
5927 for {set row $e} {[incr row -1] >= $s} {} {
5928 set x [lsearch -exact [lindex $rowidlist $row] $id]
5930 set olds [lindex $parentlist $row]
5931 set kid [lindex $displayorder $row]
5932 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5933 if {$kidx < 0} continue
5934 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5936 set px [lsearch -exact $nextrow $p]
5937 if {$px < 0} continue
5938 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5939 if {[lsearch -exact $ccross $p] >= 0} continue
5940 if {$x == $px + ($kidx < $px? -1: 1)} {
5942 } elseif {[lsearch -exact $cross $p] < 0} {
5949 return [concat $ccross {{}} $cross]
5952 proc assigncolor {id} {
5953 global colormap colors nextcolor
5954 global parents children children curview
5956 if {[info exists colormap($id)]} return
5957 set ncolors [llength $colors]
5958 if {[info exists children($curview,$id)]} {
5959 set kids $children($curview,$id)
5963 if {[llength $kids] == 1} {
5964 set child [lindex $kids 0]
5965 if {[info exists colormap($child)]
5966 && [llength $parents($curview,$child)] == 1} {
5967 set colormap($id) $colormap($child)
5973 foreach x [findcrossings $id] {
5975 # delimiter between corner crossings and other crossings
5976 if {[llength $badcolors] >= $ncolors - 1} break
5977 set origbad $badcolors
5979 if {[info exists colormap($x)]
5980 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5981 lappend badcolors $colormap($x)
5984 if {[llength $badcolors] >= $ncolors} {
5985 set badcolors $origbad
5987 set origbad $badcolors
5988 if {[llength $badcolors] < $ncolors - 1} {
5989 foreach child $kids {
5990 if {[info exists colormap($child)]
5991 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5992 lappend badcolors $colormap($child)
5994 foreach p $parents($curview,$child) {
5995 if {[info exists colormap($p)]
5996 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5997 lappend badcolors $colormap($p)
6001 if {[llength $badcolors] >= $ncolors} {
6002 set badcolors $origbad
6005 for {set i 0} {$i <= $ncolors} {incr i} {
6006 set c [lindex $colors $nextcolor]
6007 if {[incr nextcolor] >= $ncolors} {
6010 if {[lsearch -exact $badcolors $c]} break
6012 set colormap($id) $c
6015 proc bindline {t id} {
6018 $canv bind $t <Enter> "lineenter %x %y $id"
6019 $canv bind $t <Motion> "linemotion %x %y $id"
6020 $canv bind $t <Leave> "lineleave $id"
6021 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6024 proc drawtags {id x xt y1} {
6025 global idtags idheads idotherrefs mainhead
6026 global linespc lthickness
6027 global canv rowtextx curview fgcolor bgcolor ctxbut
6032 if {[info exists idtags($id)]} {
6033 set marks $idtags($id)
6034 set ntags [llength $marks]
6036 if {[info exists idheads($id)]} {
6037 set marks [concat $marks $idheads($id)]
6038 set nheads [llength $idheads($id)]
6040 if {[info exists idotherrefs($id)]} {
6041 set marks [concat $marks $idotherrefs($id)]
6047 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6048 set yt [expr {$y1 - 0.5 * $linespc}]
6049 set yb [expr {$yt + $linespc - 1}]
6053 foreach tag $marks {
6055 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6056 set wid [font measure mainfontbold $tag]
6058 set wid [font measure mainfont $tag]
6062 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6064 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6065 -width $lthickness -fill black -tags tag.$id]
6067 foreach tag $marks x $xvals wid $wvals {
6068 set xl [expr {$x + $delta}]
6069 set xr [expr {$x + $delta + $wid + $lthickness}]
6071 if {[incr ntags -1] >= 0} {
6073 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6074 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6075 -width 1 -outline black -fill yellow -tags tag.$id]
6076 $canv bind $t <1> [list showtag $tag 1]
6077 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6079 # draw a head or other ref
6080 if {[incr nheads -1] >= 0} {
6082 if {$tag eq $mainhead} {
6083 set font mainfontbold
6088 set xl [expr {$xl - $delta/2}]
6089 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6090 -width 1 -outline black -fill $col -tags tag.$id
6091 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6092 set rwid [font measure mainfont $remoteprefix]
6093 set xi [expr {$x + 1}]
6094 set yti [expr {$yt + 1}]
6095 set xri [expr {$x + $rwid}]
6096 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6097 -width 0 -fill "#ffddaa" -tags tag.$id
6100 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6101 -font $font -tags [list tag.$id text]]
6103 $canv bind $t <1> [list showtag $tag 1]
6104 } elseif {$nheads >= 0} {
6105 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
6111 proc xcoord {i level ln} {
6112 global canvx0 xspc1 xspc2
6114 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6115 if {$i > 0 && $i == $level} {
6116 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6117 } elseif {$i > $level} {
6118 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6123 proc show_status {msg} {
6127 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6128 -tags text -fill $fgcolor
6131 # Don't change the text pane cursor if it is currently the hand cursor,
6132 # showing that we are over a sha1 ID link.
6133 proc settextcursor {c} {
6134 global ctext curtextcursor
6136 if {[$ctext cget -cursor] == $curtextcursor} {
6137 $ctext config -cursor $c
6139 set curtextcursor $c
6142 proc nowbusy {what {name {}}} {
6143 global isbusy busyname statusw
6145 if {[array names isbusy] eq {}} {
6146 . config -cursor watch
6150 set busyname($what) $name
6152 $statusw conf -text $name
6156 proc notbusy {what} {
6157 global isbusy maincursor textcursor busyname statusw
6161 if {$busyname($what) ne {} &&
6162 [$statusw cget -text] eq $busyname($what)} {
6163 $statusw conf -text {}
6166 if {[array names isbusy] eq {}} {
6167 . config -cursor $maincursor
6168 settextcursor $textcursor
6172 proc findmatches {f} {
6173 global findtype findstring
6174 if {$findtype == [mc "Regexp"]} {
6175 set matches [regexp -indices -all -inline $findstring $f]
6178 if {$findtype == [mc "IgnCase"]} {
6179 set f [string tolower $f]
6180 set fs [string tolower $fs]
6184 set l [string length $fs]
6185 while {[set j [string first $fs $f $i]] >= 0} {
6186 lappend matches [list $j [expr {$j+$l-1}]]
6187 set i [expr {$j + $l}]
6193 proc dofind {{dirn 1} {wrap 1}} {
6194 global findstring findstartline findcurline selectedline numcommits
6195 global gdttype filehighlight fh_serial find_dirn findallowwrap
6197 if {[info exists find_dirn]} {
6198 if {$find_dirn == $dirn} return
6202 if {$findstring eq {} || $numcommits == 0} return
6203 if {$selectedline eq {}} {
6204 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6206 set findstartline $selectedline
6208 set findcurline $findstartline
6209 nowbusy finding [mc "Searching"]
6210 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6211 after cancel do_file_hl $fh_serial
6212 do_file_hl $fh_serial
6215 set findallowwrap $wrap
6219 proc stopfinding {} {
6220 global find_dirn findcurline fprogcoord
6222 if {[info exists find_dirn]} {
6233 global commitdata commitinfo numcommits findpattern findloc
6234 global findstartline findcurline findallowwrap
6235 global find_dirn gdttype fhighlights fprogcoord
6236 global curview varcorder vrownum varccommits vrowmod
6238 if {![info exists find_dirn]} {
6241 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6244 if {$find_dirn > 0} {
6246 if {$l >= $numcommits} {
6249 if {$l <= $findstartline} {
6250 set lim [expr {$findstartline + 1}]
6253 set moretodo $findallowwrap
6260 if {$l >= $findstartline} {
6261 set lim [expr {$findstartline - 1}]
6264 set moretodo $findallowwrap
6267 set n [expr {($lim - $l) * $find_dirn}]
6272 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6273 update_arcrows $curview
6277 set ai [bsearch $vrownum($curview) $l]
6278 set a [lindex $varcorder($curview) $ai]
6279 set arow [lindex $vrownum($curview) $ai]
6280 set ids [lindex $varccommits($curview,$a)]
6281 set arowend [expr {$arow + [llength $ids]}]
6282 if {$gdttype eq [mc "containing:"]} {
6283 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6284 if {$l < $arow || $l >= $arowend} {
6286 set a [lindex $varcorder($curview) $ai]
6287 set arow [lindex $vrownum($curview) $ai]
6288 set ids [lindex $varccommits($curview,$a)]
6289 set arowend [expr {$arow + [llength $ids]}]
6291 set id [lindex $ids [expr {$l - $arow}]]
6292 # shouldn't happen unless git log doesn't give all the commits...
6293 if {![info exists commitdata($id)] ||
6294 ![doesmatch $commitdata($id)]} {
6297 if {![info exists commitinfo($id)]} {
6300 set info $commitinfo($id)
6301 foreach f $info ty $fldtypes {
6302 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6311 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6312 if {$l < $arow || $l >= $arowend} {
6314 set a [lindex $varcorder($curview) $ai]
6315 set arow [lindex $vrownum($curview) $ai]
6316 set ids [lindex $varccommits($curview,$a)]
6317 set arowend [expr {$arow + [llength $ids]}]
6319 set id [lindex $ids [expr {$l - $arow}]]
6320 if {![info exists fhighlights($id)]} {
6321 # this sets fhighlights($id) to -1
6322 askfilehighlight $l $id
6324 if {$fhighlights($id) > 0} {
6328 if {$fhighlights($id) < 0} {
6331 set findcurline [expr {$l - $find_dirn}]
6336 if {$found || ($domore && !$moretodo)} {
6352 set findcurline [expr {$l - $find_dirn}]
6354 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6358 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6363 proc findselectline {l} {
6364 global findloc commentend ctext findcurline markingmatches gdttype
6366 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6369 if {$markingmatches &&
6370 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6371 # highlight the matches in the comments
6372 set f [$ctext get 1.0 $commentend]
6373 set matches [findmatches $f]
6374 foreach match $matches {
6375 set start [lindex $match 0]
6376 set end [expr {[lindex $match 1] + 1}]
6377 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6383 # mark the bits of a headline or author that match a find string
6384 proc markmatches {canv l str tag matches font row} {
6387 set bbox [$canv bbox $tag]
6388 set x0 [lindex $bbox 0]
6389 set y0 [lindex $bbox 1]
6390 set y1 [lindex $bbox 3]
6391 foreach match $matches {
6392 set start [lindex $match 0]
6393 set end [lindex $match 1]
6394 if {$start > $end} continue
6395 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6396 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6397 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6398 [expr {$x0+$xlen+2}] $y1 \
6399 -outline {} -tags [list match$l matches] -fill yellow]
6401 if {$row == $selectedline} {
6402 $canv raise $t secsel
6407 proc unmarkmatches {} {
6408 global markingmatches
6410 allcanvs delete matches
6411 set markingmatches 0
6415 proc selcanvline {w x y} {
6416 global canv canvy0 ctext linespc
6418 set ymax [lindex [$canv cget -scrollregion] 3]
6419 if {$ymax == {}} return
6420 set yfrac [lindex [$canv yview] 0]
6421 set y [expr {$y + $yfrac * $ymax}]
6422 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6427 set xmax [lindex [$canv cget -scrollregion] 2]
6428 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6429 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6435 proc commit_descriptor {p} {
6437 if {![info exists commitinfo($p)]} {
6441 if {[llength $commitinfo($p)] > 1} {
6442 set l [lindex $commitinfo($p) 0]
6447 # append some text to the ctext widget, and make any SHA1 ID
6448 # that we know about be a clickable link.
6449 proc appendwithlinks {text tags} {
6450 global ctext linknum curview
6452 set start [$ctext index "end - 1c"]
6453 $ctext insert end $text $tags
6454 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6458 set linkid [string range $text $s $e]
6460 $ctext tag delete link$linknum
6461 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6462 setlink $linkid link$linknum
6467 proc setlink {id lk} {
6468 global curview ctext pendinglinks
6471 if {[string length $id] < 40} {
6472 set matches [longid $id]
6473 if {[llength $matches] > 0} {
6474 if {[llength $matches] > 1} return
6476 set id [lindex $matches 0]
6479 set known [commitinview $id $curview]
6482 $ctext tag conf $lk -foreground blue -underline 1
6483 $ctext tag bind $lk <1> [list selbyid $id]
6484 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6485 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6487 lappend pendinglinks($id) $lk
6488 interestedin $id {makelink %P}
6492 proc makelink {id} {
6495 if {![info exists pendinglinks($id)]} return
6496 foreach lk $pendinglinks($id) {
6499 unset pendinglinks($id)
6502 proc linkcursor {w inc} {
6503 global linkentercount curtextcursor
6505 if {[incr linkentercount $inc] > 0} {
6506 $w configure -cursor hand2
6508 $w configure -cursor $curtextcursor
6509 if {$linkentercount < 0} {
6510 set linkentercount 0
6515 proc viewnextline {dir} {
6519 set ymax [lindex [$canv cget -scrollregion] 3]
6520 set wnow [$canv yview]
6521 set wtop [expr {[lindex $wnow 0] * $ymax}]
6522 set newtop [expr {$wtop + $dir * $linespc}]
6525 } elseif {$newtop > $ymax} {
6528 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6531 # add a list of tag or branch names at position pos
6532 # returns the number of names inserted
6533 proc appendrefs {pos ids var} {
6534 global ctext linknum curview $var maxrefs
6536 if {[catch {$ctext index $pos}]} {
6539 $ctext conf -state normal
6540 $ctext delete $pos "$pos lineend"
6543 foreach tag [set $var\($id\)] {
6544 lappend tags [list $tag $id]
6547 if {[llength $tags] > $maxrefs} {
6548 $ctext insert $pos "[mc "many"] ([llength $tags])"
6550 set tags [lsort -index 0 -decreasing $tags]
6553 set id [lindex $ti 1]
6556 $ctext tag delete $lk
6557 $ctext insert $pos $sep
6558 $ctext insert $pos [lindex $ti 0] $lk
6563 $ctext conf -state disabled
6564 return [llength $tags]
6567 # called when we have finished computing the nearby tags
6568 proc dispneartags {delay} {
6569 global selectedline currentid showneartags tagphase
6571 if {$selectedline eq {} || !$showneartags} return
6572 after cancel dispnexttag
6574 after 200 dispnexttag
6577 after idle dispnexttag
6582 proc dispnexttag {} {
6583 global selectedline currentid showneartags tagphase ctext
6585 if {$selectedline eq {} || !$showneartags} return
6586 switch -- $tagphase {
6588 set dtags [desctags $currentid]
6590 appendrefs precedes $dtags idtags
6594 set atags [anctags $currentid]
6596 appendrefs follows $atags idtags
6600 set dheads [descheads $currentid]
6601 if {$dheads ne {}} {
6602 if {[appendrefs branch $dheads idheads] > 1
6603 && [$ctext get "branch -3c"] eq "h"} {
6604 # turn "Branch" into "Branches"
6605 $ctext conf -state normal
6606 $ctext insert "branch -2c" "es"
6607 $ctext conf -state disabled
6612 if {[incr tagphase] <= 2} {
6613 after idle dispnexttag
6617 proc make_secsel {id} {
6618 global linehtag linentag linedtag canv canv2 canv3
6620 if {![info exists linehtag($id)]} return
6622 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6623 -tags secsel -fill [$canv cget -selectbackground]]
6625 $canv2 delete secsel
6626 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6627 -tags secsel -fill [$canv2 cget -selectbackground]]
6629 $canv3 delete secsel
6630 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6631 -tags secsel -fill [$canv3 cget -selectbackground]]
6635 proc make_idmark {id} {
6636 global linehtag canv fgcolor
6638 if {![info exists linehtag($id)]} return
6640 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6641 -tags markid -outline $fgcolor]
6645 proc selectline {l isnew {desired_loc {}}} {
6646 global canv ctext commitinfo selectedline
6647 global canvy0 linespc parents children curview
6648 global currentid sha1entry
6649 global commentend idtags linknum
6650 global mergemax numcommits pending_select
6651 global cmitmode showneartags allcommits
6652 global targetrow targetid lastscrollrows
6653 global autoselect jump_to_here
6655 catch {unset pending_select}
6660 if {$l < 0 || $l >= $numcommits} return
6661 set id [commitonrow $l]
6666 if {$lastscrollrows < $numcommits} {
6670 set y [expr {$canvy0 + $l * $linespc}]
6671 set ymax [lindex [$canv cget -scrollregion] 3]
6672 set ytop [expr {$y - $linespc - 1}]
6673 set ybot [expr {$y + $linespc + 1}]
6674 set wnow [$canv yview]
6675 set wtop [expr {[lindex $wnow 0] * $ymax}]
6676 set wbot [expr {[lindex $wnow 1] * $ymax}]
6677 set wh [expr {$wbot - $wtop}]
6679 if {$ytop < $wtop} {
6680 if {$ybot < $wtop} {
6681 set newtop [expr {$y - $wh / 2.0}]
6684 if {$newtop > $wtop - $linespc} {
6685 set newtop [expr {$wtop - $linespc}]
6688 } elseif {$ybot > $wbot} {
6689 if {$ytop > $wbot} {
6690 set newtop [expr {$y - $wh / 2.0}]
6692 set newtop [expr {$ybot - $wh}]
6693 if {$newtop < $wtop + $linespc} {
6694 set newtop [expr {$wtop + $linespc}]
6698 if {$newtop != $wtop} {
6702 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6709 addtohistory [list selbyid $id]
6712 $sha1entry delete 0 end
6713 $sha1entry insert 0 $id
6715 $sha1entry selection from 0
6716 $sha1entry selection to end
6720 $ctext conf -state normal
6723 if {![info exists commitinfo($id)]} {
6726 set info $commitinfo($id)
6727 set date [formatdate [lindex $info 2]]
6728 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6729 set date [formatdate [lindex $info 4]]
6730 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6731 if {[info exists idtags($id)]} {
6732 $ctext insert end [mc "Tags:"]
6733 foreach tag $idtags($id) {
6734 $ctext insert end " $tag"
6736 $ctext insert end "\n"
6740 set olds $parents($curview,$id)
6741 if {[llength $olds] > 1} {
6744 if {$np >= $mergemax} {
6749 $ctext insert end "[mc "Parent"]: " $tag
6750 appendwithlinks [commit_descriptor $p] {}
6755 append headers "[mc "Parent"]: [commit_descriptor $p]"
6759 foreach c $children($curview,$id) {
6760 append headers "[mc "Child"]: [commit_descriptor $c]"
6763 # make anything that looks like a SHA1 ID be a clickable link
6764 appendwithlinks $headers {}
6765 if {$showneartags} {
6766 if {![info exists allcommits]} {
6769 $ctext insert end "[mc "Branch"]: "
6770 $ctext mark set branch "end -1c"
6771 $ctext mark gravity branch left
6772 $ctext insert end "\n[mc "Follows"]: "
6773 $ctext mark set follows "end -1c"
6774 $ctext mark gravity follows left
6775 $ctext insert end "\n[mc "Precedes"]: "
6776 $ctext mark set precedes "end -1c"
6777 $ctext mark gravity precedes left
6778 $ctext insert end "\n"
6781 $ctext insert end "\n"
6782 set comment [lindex $info 5]
6783 if {[string first "\r" $comment] >= 0} {
6784 set comment [string map {"\r" "\n "} $comment]
6786 appendwithlinks $comment {comment}
6788 $ctext tag remove found 1.0 end
6789 $ctext conf -state disabled
6790 set commentend [$ctext index "end - 1c"]
6792 set jump_to_here $desired_loc
6793 init_flist [mc "Comments"]
6794 if {$cmitmode eq "tree"} {
6796 } elseif {[llength $olds] <= 1} {
6803 proc selfirstline {} {
6808 proc sellastline {} {
6811 set l [expr {$numcommits - 1}]
6815 proc selnextline {dir} {
6818 if {$selectedline eq {}} return
6819 set l [expr {$selectedline + $dir}]
6824 proc selnextpage {dir} {
6825 global canv linespc selectedline numcommits
6827 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6831 allcanvs yview scroll [expr {$dir * $lpp}] units
6833 if {$selectedline eq {}} return
6834 set l [expr {$selectedline + $dir * $lpp}]
6837 } elseif {$l >= $numcommits} {
6838 set l [expr $numcommits - 1]
6844 proc unselectline {} {
6845 global selectedline currentid
6848 catch {unset currentid}
6849 allcanvs delete secsel
6853 proc reselectline {} {
6856 if {$selectedline ne {}} {
6857 selectline $selectedline 0
6861 proc addtohistory {cmd} {
6862 global history historyindex curview
6864 set elt [list $curview $cmd]
6865 if {$historyindex > 0
6866 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6870 if {$historyindex < [llength $history]} {
6871 set history [lreplace $history $historyindex end $elt]
6873 lappend history $elt
6876 if {$historyindex > 1} {
6877 .tf.bar.leftbut conf -state normal
6879 .tf.bar.leftbut conf -state disabled
6881 .tf.bar.rightbut conf -state disabled
6887 set view [lindex $elt 0]
6888 set cmd [lindex $elt 1]
6889 if {$curview != $view} {
6896 global history historyindex
6899 if {$historyindex > 1} {
6900 incr historyindex -1
6901 godo [lindex $history [expr {$historyindex - 1}]]
6902 .tf.bar.rightbut conf -state normal
6904 if {$historyindex <= 1} {
6905 .tf.bar.leftbut conf -state disabled
6910 global history historyindex
6913 if {$historyindex < [llength $history]} {
6914 set cmd [lindex $history $historyindex]
6917 .tf.bar.leftbut conf -state normal
6919 if {$historyindex >= [llength $history]} {
6920 .tf.bar.rightbut conf -state disabled
6925 global treefilelist treeidlist diffids diffmergeid treepending
6926 global nullid nullid2
6929 catch {unset diffmergeid}
6930 if {![info exists treefilelist($id)]} {
6931 if {![info exists treepending]} {
6932 if {$id eq $nullid} {
6933 set cmd [list | git ls-files]
6934 } elseif {$id eq $nullid2} {
6935 set cmd [list | git ls-files --stage -t]
6937 set cmd [list | git ls-tree -r $id]
6939 if {[catch {set gtf [open $cmd r]}]} {
6943 set treefilelist($id) {}
6944 set treeidlist($id) {}
6945 fconfigure $gtf -blocking 0 -encoding binary
6946 filerun $gtf [list gettreeline $gtf $id]
6953 proc gettreeline {gtf id} {
6954 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6957 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6958 if {$diffids eq $nullid} {
6961 set i [string first "\t" $line]
6962 if {$i < 0} continue
6963 set fname [string range $line [expr {$i+1}] end]
6964 set line [string range $line 0 [expr {$i-1}]]
6965 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6966 set sha1 [lindex $line 2]
6967 lappend treeidlist($id) $sha1
6969 if {[string index $fname 0] eq "\""} {
6970 set fname [lindex $fname 0]
6972 set fname [encoding convertfrom $fname]
6973 lappend treefilelist($id) $fname
6976 return [expr {$nl >= 1000? 2: 1}]
6980 if {$cmitmode ne "tree"} {
6981 if {![info exists diffmergeid]} {
6982 gettreediffs $diffids
6984 } elseif {$id ne $diffids} {
6993 global treefilelist treeidlist diffids nullid nullid2
6994 global ctext_file_names ctext_file_lines
6995 global ctext commentend
6997 set i [lsearch -exact $treefilelist($diffids) $f]
6999 puts "oops, $f not in list for id $diffids"
7002 if {$diffids eq $nullid} {
7003 if {[catch {set bf [open $f r]} err]} {
7004 puts "oops, can't read $f: $err"
7008 set blob [lindex $treeidlist($diffids) $i]
7009 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7010 puts "oops, error reading blob $blob: $err"
7014 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7015 filerun $bf [list getblobline $bf $diffids]
7016 $ctext config -state normal
7017 clear_ctext $commentend
7018 lappend ctext_file_names $f
7019 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7020 $ctext insert end "\n"
7021 $ctext insert end "$f\n" filesep
7022 $ctext config -state disabled
7023 $ctext yview $commentend
7027 proc getblobline {bf id} {
7028 global diffids cmitmode ctext
7030 if {$id ne $diffids || $cmitmode ne "tree"} {
7034 $ctext config -state normal
7036 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7037 $ctext insert end "$line\n"
7040 global jump_to_here ctext_file_names commentend
7042 # delete last newline
7043 $ctext delete "end - 2c" "end - 1c"
7045 if {$jump_to_here ne {} &&
7046 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7047 set lnum [expr {[lindex $jump_to_here 1] +
7048 [lindex [split $commentend .] 0]}]
7049 mark_ctext_line $lnum
7053 $ctext config -state disabled
7054 return [expr {$nl >= 1000? 2: 1}]
7057 proc mark_ctext_line {lnum} {
7058 global ctext markbgcolor
7060 $ctext tag delete omark
7061 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7062 $ctext tag conf omark -background $markbgcolor
7066 proc mergediff {id} {
7068 global diffids treediffs
7069 global parents curview
7073 set treediffs($id) {}
7074 set np [llength $parents($curview,$id)]
7079 proc startdiff {ids} {
7080 global treediffs diffids treepending diffmergeid nullid nullid2
7084 catch {unset diffmergeid}
7085 if {![info exists treediffs($ids)] ||
7086 [lsearch -exact $ids $nullid] >= 0 ||
7087 [lsearch -exact $ids $nullid2] >= 0} {
7088 if {![info exists treepending]} {
7096 proc path_filter {filter name} {
7098 set l [string length $p]
7099 if {[string index $p end] eq "/"} {
7100 if {[string compare -length $l $p $name] == 0} {
7104 if {[string compare -length $l $p $name] == 0 &&
7105 ([string length $name] == $l ||
7106 [string index $name $l] eq "/")} {
7114 proc addtocflist {ids} {
7117 add_flist $treediffs($ids)
7121 proc diffcmd {ids flags} {
7122 global nullid nullid2
7124 set i [lsearch -exact $ids $nullid]
7125 set j [lsearch -exact $ids $nullid2]
7127 if {[llength $ids] > 1 && $j < 0} {
7128 # comparing working directory with some specific revision
7129 set cmd [concat | git diff-index $flags]
7131 lappend cmd -R [lindex $ids 1]
7133 lappend cmd [lindex $ids 0]
7136 # comparing working directory with index
7137 set cmd [concat | git diff-files $flags]
7142 } elseif {$j >= 0} {
7143 set cmd [concat | git diff-index --cached $flags]
7144 if {[llength $ids] > 1} {
7145 # comparing index with specific revision
7147 lappend cmd -R [lindex $ids 1]
7149 lappend cmd [lindex $ids 0]
7152 # comparing index with HEAD
7156 set cmd [concat | git diff-tree -r $flags $ids]
7161 proc gettreediffs {ids} {
7162 global treediff treepending
7164 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7166 set treepending $ids
7168 fconfigure $gdtf -blocking 0 -encoding binary
7169 filerun $gdtf [list gettreediffline $gdtf $ids]
7172 proc gettreediffline {gdtf ids} {
7173 global treediff treediffs treepending diffids diffmergeid
7174 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7179 if {$perfile_attrs} {
7180 # cache_gitattr is slow, and even slower on win32 where we
7181 # have to invoke it for only about 30 paths at a time
7183 if {[tk windowingsystem] == "win32"} {
7187 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7188 set i [string first "\t" $line]
7190 set file [string range $line [expr {$i+1}] end]
7191 if {[string index $file 0] eq "\""} {
7192 set file [lindex $file 0]
7194 set file [encoding convertfrom $file]
7195 if {$file ne [lindex $treediff end]} {
7196 lappend treediff $file
7197 lappend sublist $file
7201 if {$perfile_attrs} {
7202 cache_gitattr encoding $sublist
7205 return [expr {$nr >= $max? 2: 1}]
7208 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7210 foreach f $treediff {
7211 if {[path_filter $vfilelimit($curview) $f]} {
7215 set treediffs($ids) $flist
7217 set treediffs($ids) $treediff
7220 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7222 } elseif {$ids != $diffids} {
7223 if {![info exists diffmergeid]} {
7224 gettreediffs $diffids
7232 # empty string or positive integer
7233 proc diffcontextvalidate {v} {
7234 return [regexp {^(|[1-9][0-9]*)$} $v]
7237 proc diffcontextchange {n1 n2 op} {
7238 global diffcontextstring diffcontext
7240 if {[string is integer -strict $diffcontextstring]} {
7241 if {$diffcontextstring > 0} {
7242 set diffcontext $diffcontextstring
7248 proc changeignorespace {} {
7252 proc getblobdiffs {ids} {
7253 global blobdifffd diffids env
7254 global diffinhdr treediffs
7257 global limitdiffs vfilelimit curview
7258 global diffencoding targetline diffnparents
7260 set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
7264 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7265 set cmd [concat $cmd -- $vfilelimit($curview)]
7267 if {[catch {set bdf [open $cmd r]} err]} {
7268 error_popup [mc "Error getting diffs: %s" $err]
7274 set diffencoding [get_path_encoding {}]
7275 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7276 set blobdifffd($ids) $bdf
7277 filerun $bdf [list getblobdiffline $bdf $diffids]
7280 proc setinlist {var i val} {
7283 while {[llength [set $var]] < $i} {
7286 if {[llength [set $var]] == $i} {
7293 proc makediffhdr {fname ids} {
7294 global ctext curdiffstart treediffs diffencoding
7295 global ctext_file_names jump_to_here targetline diffline
7297 set fname [encoding convertfrom $fname]
7298 set diffencoding [get_path_encoding $fname]
7299 set i [lsearch -exact $treediffs($ids) $fname]
7301 setinlist difffilestart $i $curdiffstart
7303 lset ctext_file_names end $fname
7304 set l [expr {(78 - [string length $fname]) / 2}]
7305 set pad [string range "----------------------------------------" 1 $l]
7306 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7308 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7309 set targetline [lindex $jump_to_here 1]
7314 proc getblobdiffline {bdf ids} {
7315 global diffids blobdifffd ctext curdiffstart
7316 global diffnexthead diffnextnote difffilestart
7317 global ctext_file_names ctext_file_lines
7318 global diffinhdr treediffs mergemax diffnparents
7319 global diffencoding jump_to_here targetline diffline
7322 $ctext conf -state normal
7323 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7324 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7328 if {![string compare -length 5 "diff " $line]} {
7329 if {![regexp {^diff (--cc|--git) } $line m type]} {
7330 set line [encoding convertfrom $line]
7331 $ctext insert end "$line\n" hunksep
7334 # start of a new file
7336 $ctext insert end "\n"
7337 set curdiffstart [$ctext index "end - 1c"]
7338 lappend ctext_file_names ""
7339 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7340 $ctext insert end "\n" filesep
7342 if {$type eq "--cc"} {
7343 # start of a new file in a merge diff
7344 set fname [string range $line 10 end]
7345 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7346 lappend treediffs($ids) $fname
7347 add_flist [list $fname]
7351 set line [string range $line 11 end]
7352 # If the name hasn't changed the length will be odd,
7353 # the middle char will be a space, and the two bits either
7354 # side will be a/name and b/name, or "a/name" and "b/name".
7355 # If the name has changed we'll get "rename from" and
7356 # "rename to" or "copy from" and "copy to" lines following
7357 # this, and we'll use them to get the filenames.
7358 # This complexity is necessary because spaces in the
7359 # filename(s) don't get escaped.
7360 set l [string length $line]
7361 set i [expr {$l / 2}]
7362 if {!(($l & 1) && [string index $line $i] eq " " &&
7363 [string range $line 2 [expr {$i - 1}]] eq \
7364 [string range $line [expr {$i + 3}] end])} {
7367 # unescape if quoted and chop off the a/ from the front
7368 if {[string index $line 0] eq "\""} {
7369 set fname [string range [lindex $line 0] 2 end]
7371 set fname [string range $line 2 [expr {$i - 1}]]
7374 makediffhdr $fname $ids
7376 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7377 set fname [encoding convertfrom [string range $line 16 end]]
7378 $ctext insert end "\n"
7379 set curdiffstart [$ctext index "end - 1c"]
7380 lappend ctext_file_names $fname
7381 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7382 $ctext insert end "$line\n" filesep
7383 set i [lsearch -exact $treediffs($ids) $fname]
7385 setinlist difffilestart $i $curdiffstart
7388 } elseif {![string compare -length 2 "@@" $line]} {
7389 regexp {^@@+} $line ats
7390 set line [encoding convertfrom $diffencoding $line]
7391 $ctext insert end "$line\n" hunksep
7392 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7395 set diffnparents [expr {[string length $ats] - 1}]
7398 } elseif {$diffinhdr} {
7399 if {![string compare -length 12 "rename from " $line]} {
7400 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7401 if {[string index $fname 0] eq "\""} {
7402 set fname [lindex $fname 0]
7404 set fname [encoding convertfrom $fname]
7405 set i [lsearch -exact $treediffs($ids) $fname]
7407 setinlist difffilestart $i $curdiffstart
7409 } elseif {![string compare -length 10 $line "rename to "] ||
7410 ![string compare -length 8 $line "copy to "]} {
7411 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7412 if {[string index $fname 0] eq "\""} {
7413 set fname [lindex $fname 0]
7415 makediffhdr $fname $ids
7416 } elseif {[string compare -length 3 $line "---"] == 0} {
7419 } elseif {[string compare -length 3 $line "+++"] == 0} {
7423 $ctext insert end "$line\n" filesep
7426 set line [string map {\x1A ^Z} \
7427 [encoding convertfrom $diffencoding $line]]
7428 # parse the prefix - one ' ', '-' or '+' for each parent
7429 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7430 set tag [expr {$diffnparents > 1? "m": "d"}]
7431 if {[string trim $prefix " -+"] eq {}} {
7432 # prefix only has " ", "-" and "+" in it: normal diff line
7433 set num [string first "-" $prefix]
7435 # removed line, first parent with line is $num
7436 if {$num >= $mergemax} {
7439 $ctext insert end "$line\n" $tag$num
7442 if {[string first "+" $prefix] >= 0} {
7444 lappend tags ${tag}result
7445 if {$diffnparents > 1} {
7446 set num [string first " " $prefix]
7448 if {$num >= $mergemax} {
7455 if {$targetline ne {}} {
7456 if {$diffline == $targetline} {
7457 set seehere [$ctext index "end - 1 chars"]
7463 $ctext insert end "$line\n" $tags
7466 # "\ No newline at end of file",
7467 # or something else we don't recognize
7468 $ctext insert end "$line\n" hunksep
7472 if {[info exists seehere]} {
7473 mark_ctext_line [lindex [split $seehere .] 0]
7475 $ctext conf -state disabled
7480 return [expr {$nr >= 1000? 2: 1}]
7483 proc changediffdisp {} {
7484 global ctext diffelide
7486 $ctext tag conf d0 -elide [lindex $diffelide 0]
7487 $ctext tag conf dresult -elide [lindex $diffelide 1]
7490 proc highlightfile {loc cline} {
7491 global ctext cflist cflist_top
7494 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7495 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7496 $cflist see $cline.0
7497 set cflist_top $cline
7501 global difffilestart ctext cmitmode
7503 if {$cmitmode eq "tree"} return
7506 set here [$ctext index @0,0]
7507 foreach loc $difffilestart {
7508 if {[$ctext compare $loc >= $here]} {
7509 highlightfile $prev $prevline
7515 highlightfile $prev $prevline
7519 global difffilestart ctext cmitmode
7521 if {$cmitmode eq "tree"} return
7522 set here [$ctext index @0,0]
7524 foreach loc $difffilestart {
7526 if {[$ctext compare $loc > $here]} {
7527 highlightfile $loc $line
7533 proc clear_ctext {{first 1.0}} {
7534 global ctext smarktop smarkbot
7535 global ctext_file_names ctext_file_lines
7538 set l [lindex [split $first .] 0]
7539 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7542 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7545 $ctext delete $first end
7546 if {$first eq "1.0"} {
7547 catch {unset pendinglinks}
7549 set ctext_file_names {}
7550 set ctext_file_lines {}
7553 proc settabs {{firstab {}}} {
7554 global firsttabstop tabstop ctext have_tk85
7556 if {$firstab ne {} && $have_tk85} {
7557 set firsttabstop $firstab
7559 set w [font measure textfont "0"]
7560 if {$firsttabstop != 0} {
7561 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7562 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7563 } elseif {$have_tk85 || $tabstop != 8} {
7564 $ctext conf -tabs [expr {$tabstop * $w}]
7566 $ctext conf -tabs {}
7570 proc incrsearch {name ix op} {
7571 global ctext searchstring searchdirn
7573 $ctext tag remove found 1.0 end
7574 if {[catch {$ctext index anchor}]} {
7575 # no anchor set, use start of selection, or of visible area
7576 set sel [$ctext tag ranges sel]
7578 $ctext mark set anchor [lindex $sel 0]
7579 } elseif {$searchdirn eq "-forwards"} {
7580 $ctext mark set anchor @0,0
7582 $ctext mark set anchor @0,[winfo height $ctext]
7585 if {$searchstring ne {}} {
7586 set here [$ctext search $searchdirn -- $searchstring anchor]
7595 global sstring ctext searchstring searchdirn
7598 $sstring icursor end
7599 set searchdirn -forwards
7600 if {$searchstring ne {}} {
7601 set sel [$ctext tag ranges sel]
7603 set start "[lindex $sel 0] + 1c"
7604 } elseif {[catch {set start [$ctext index anchor]}]} {
7607 set match [$ctext search -count mlen -- $searchstring $start]
7608 $ctext tag remove sel 1.0 end
7614 set mend "$match + $mlen c"
7615 $ctext tag add sel $match $mend
7616 $ctext mark unset anchor
7620 proc dosearchback {} {
7621 global sstring ctext searchstring searchdirn
7624 $sstring icursor end
7625 set searchdirn -backwards
7626 if {$searchstring ne {}} {
7627 set sel [$ctext tag ranges sel]
7629 set start [lindex $sel 0]
7630 } elseif {[catch {set start [$ctext index anchor]}]} {
7631 set start @0,[winfo height $ctext]
7633 set match [$ctext search -backwards -count ml -- $searchstring $start]
7634 $ctext tag remove sel 1.0 end
7640 set mend "$match + $ml c"
7641 $ctext tag add sel $match $mend
7642 $ctext mark unset anchor
7646 proc searchmark {first last} {
7647 global ctext searchstring
7651 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7652 if {$match eq {}} break
7653 set mend "$match + $mlen c"
7654 $ctext tag add found $match $mend
7658 proc searchmarkvisible {doall} {
7659 global ctext smarktop smarkbot
7661 set topline [lindex [split [$ctext index @0,0] .] 0]
7662 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7663 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7664 # no overlap with previous
7665 searchmark $topline $botline
7666 set smarktop $topline
7667 set smarkbot $botline
7669 if {$topline < $smarktop} {
7670 searchmark $topline [expr {$smarktop-1}]
7671 set smarktop $topline
7673 if {$botline > $smarkbot} {
7674 searchmark [expr {$smarkbot+1}] $botline
7675 set smarkbot $botline
7680 proc scrolltext {f0 f1} {
7683 .bleft.bottom.sb set $f0 $f1
7684 if {$searchstring ne {}} {
7690 global linespc charspc canvx0 canvy0
7691 global xspc1 xspc2 lthickness
7693 set linespc [font metrics mainfont -linespace]
7694 set charspc [font measure mainfont "m"]
7695 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7696 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7697 set lthickness [expr {int($linespc / 9) + 1}]
7698 set xspc1(0) $linespc
7706 set ymax [lindex [$canv cget -scrollregion] 3]
7707 if {$ymax eq {} || $ymax == 0} return
7708 set span [$canv yview]
7711 allcanvs yview moveto [lindex $span 0]
7713 if {$selectedline ne {}} {
7714 selectline $selectedline 0
7715 allcanvs yview moveto [lindex $span 0]
7719 proc parsefont {f n} {
7722 set fontattr($f,family) [lindex $n 0]
7724 if {$s eq {} || $s == 0} {
7727 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7729 set fontattr($f,size) $s
7730 set fontattr($f,weight) normal
7731 set fontattr($f,slant) roman
7732 foreach style [lrange $n 2 end] {
7735 "bold" {set fontattr($f,weight) $style}
7737 "italic" {set fontattr($f,slant) $style}
7742 proc fontflags {f {isbold 0}} {
7745 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7746 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7747 -slant $fontattr($f,slant)]
7753 set n [list $fontattr($f,family) $fontattr($f,size)]
7754 if {$fontattr($f,weight) eq "bold"} {
7757 if {$fontattr($f,slant) eq "italic"} {
7763 proc incrfont {inc} {
7764 global mainfont textfont ctext canv cflist showrefstop
7765 global stopped entries fontattr
7768 set s $fontattr(mainfont,size)
7773 set fontattr(mainfont,size) $s
7774 font config mainfont -size $s
7775 font config mainfontbold -size $s
7776 set mainfont [fontname mainfont]
7777 set s $fontattr(textfont,size)
7782 set fontattr(textfont,size) $s
7783 font config textfont -size $s
7784 font config textfontbold -size $s
7785 set textfont [fontname textfont]
7792 global sha1entry sha1string
7793 if {[string length $sha1string] == 40} {
7794 $sha1entry delete 0 end
7798 proc sha1change {n1 n2 op} {
7799 global sha1string currentid sha1but
7800 if {$sha1string == {}
7801 || ([info exists currentid] && $sha1string == $currentid)} {
7806 if {[$sha1but cget -state] == $state} return
7807 if {$state == "normal"} {
7808 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7810 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7814 proc gotocommit {} {
7815 global sha1string tagids headids curview varcid
7817 if {$sha1string == {}
7818 || ([info exists currentid] && $sha1string == $currentid)} return
7819 if {[info exists tagids($sha1string)]} {
7820 set id $tagids($sha1string)
7821 } elseif {[info exists headids($sha1string)]} {
7822 set id $headids($sha1string)
7824 set id [string tolower $sha1string]
7825 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7826 set matches [longid $id]
7827 if {$matches ne {}} {
7828 if {[llength $matches] > 1} {
7829 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7832 set id [lindex $matches 0]
7836 if {[commitinview $id $curview]} {
7837 selectline [rowofcommit $id] 1
7840 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7841 set msg [mc "SHA1 id %s is not known" $sha1string]
7843 set msg [mc "Tag/Head %s is not known" $sha1string]
7848 proc lineenter {x y id} {
7849 global hoverx hovery hoverid hovertimer
7850 global commitinfo canv
7852 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7856 if {[info exists hovertimer]} {
7857 after cancel $hovertimer
7859 set hovertimer [after 500 linehover]
7863 proc linemotion {x y id} {
7864 global hoverx hovery hoverid hovertimer
7866 if {[info exists hoverid] && $id == $hoverid} {
7869 if {[info exists hovertimer]} {
7870 after cancel $hovertimer
7872 set hovertimer [after 500 linehover]
7876 proc lineleave {id} {
7877 global hoverid hovertimer canv
7879 if {[info exists hoverid] && $id == $hoverid} {
7881 if {[info exists hovertimer]} {
7882 after cancel $hovertimer
7890 global hoverx hovery hoverid hovertimer
7891 global canv linespc lthickness
7894 set text [lindex $commitinfo($hoverid) 0]
7895 set ymax [lindex [$canv cget -scrollregion] 3]
7896 if {$ymax == {}} return
7897 set yfrac [lindex [$canv yview] 0]
7898 set x [expr {$hoverx + 2 * $linespc}]
7899 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7900 set x0 [expr {$x - 2 * $lthickness}]
7901 set y0 [expr {$y - 2 * $lthickness}]
7902 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7903 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7904 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7905 -fill \#ffff80 -outline black -width 1 -tags hover]
7907 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7912 proc clickisonarrow {id y} {
7915 set ranges [rowranges $id]
7916 set thresh [expr {2 * $lthickness + 6}]
7917 set n [expr {[llength $ranges] - 1}]
7918 for {set i 1} {$i < $n} {incr i} {
7919 set row [lindex $ranges $i]
7920 if {abs([yc $row] - $y) < $thresh} {
7927 proc arrowjump {id n y} {
7930 # 1 <-> 2, 3 <-> 4, etc...
7931 set n [expr {(($n - 1) ^ 1) + 1}]
7932 set row [lindex [rowranges $id] $n]
7934 set ymax [lindex [$canv cget -scrollregion] 3]
7935 if {$ymax eq {} || $ymax <= 0} return
7936 set view [$canv yview]
7937 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7938 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7942 allcanvs yview moveto $yfrac
7945 proc lineclick {x y id isnew} {
7946 global ctext commitinfo children canv thickerline curview
7948 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7953 # draw this line thicker than normal
7957 set ymax [lindex [$canv cget -scrollregion] 3]
7958 if {$ymax eq {}} return
7959 set yfrac [lindex [$canv yview] 0]
7960 set y [expr {$y + $yfrac * $ymax}]
7962 set dirn [clickisonarrow $id $y]
7964 arrowjump $id $dirn $y
7969 addtohistory [list lineclick $x $y $id 0]
7971 # fill the details pane with info about this line
7972 $ctext conf -state normal
7975 $ctext insert end "[mc "Parent"]:\t"
7976 $ctext insert end $id link0
7978 set info $commitinfo($id)
7979 $ctext insert end "\n\t[lindex $info 0]\n"
7980 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7981 set date [formatdate [lindex $info 2]]
7982 $ctext insert end "\t[mc "Date"]:\t$date\n"
7983 set kids $children($curview,$id)
7985 $ctext insert end "\n[mc "Children"]:"
7987 foreach child $kids {
7989 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7990 set info $commitinfo($child)
7991 $ctext insert end "\n\t"
7992 $ctext insert end $child link$i
7993 setlink $child link$i
7994 $ctext insert end "\n\t[lindex $info 0]"
7995 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7996 set date [formatdate [lindex $info 2]]
7997 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8000 $ctext conf -state disabled
8004 proc normalline {} {
8006 if {[info exists thickerline]} {
8015 if {[commitinview $id $curview]} {
8016 selectline [rowofcommit $id] 1
8022 if {![info exists startmstime]} {
8023 set startmstime [clock clicks -milliseconds]
8025 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8028 proc rowmenu {x y id} {
8029 global rowctxmenu selectedline rowmenuid curview
8030 global nullid nullid2 fakerowmenu mainhead markedid
8034 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8039 if {$id ne $nullid && $id ne $nullid2} {
8040 set menu $rowctxmenu
8041 if {$mainhead ne {}} {
8042 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8044 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8046 if {[info exists markedid] && $markedid ne $id} {
8047 $menu entryconfigure 9 -state normal
8048 $menu entryconfigure 10 -state normal
8049 $menu entryconfigure 11 -state normal
8051 $menu entryconfigure 9 -state disabled
8052 $menu entryconfigure 10 -state disabled
8053 $menu entryconfigure 11 -state disabled
8056 set menu $fakerowmenu
8058 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8059 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8060 $menu entryconfigure [mca "Make patch"] -state $state
8061 tk_popup $menu $x $y
8065 global rowmenuid markedid canv
8067 set markedid $rowmenuid
8068 make_idmark $markedid
8074 if {[info exists markedid]} {
8079 proc replace_by_kids {l r} {
8080 global curview children
8082 set id [commitonrow $r]
8083 set l [lreplace $l 0 0]
8084 foreach kid $children($curview,$id) {
8085 lappend l [rowofcommit $kid]
8087 return [lsort -integer -decreasing -unique $l]
8090 proc find_common_desc {} {
8091 global markedid rowmenuid curview children
8093 if {![info exists markedid]} return
8094 if {![commitinview $markedid $curview] ||
8095 ![commitinview $rowmenuid $curview]} return
8096 #set t1 [clock clicks -milliseconds]
8097 set l1 [list [rowofcommit $markedid]]
8098 set l2 [list [rowofcommit $rowmenuid]]
8100 set r1 [lindex $l1 0]
8101 set r2 [lindex $l2 0]
8102 if {$r1 eq {} || $r2 eq {}} break
8108 set l1 [replace_by_kids $l1 $r1]
8110 set l2 [replace_by_kids $l2 $r2]
8113 #set t2 [clock clicks -milliseconds]
8114 #puts "took [expr {$t2-$t1}]ms"
8117 proc compare_commits {} {
8118 global markedid rowmenuid curview children
8120 if {![info exists markedid]} return
8121 if {![commitinview $markedid $curview]} return
8122 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8123 do_cmp_commits $markedid $rowmenuid
8126 proc getpatchid {id} {
8129 if {![info exists patchids($id)]} {
8130 set x [exec git diff-tree -p --root $id | git patch-id]
8131 set patchids($id) [lindex $x 0]
8133 return $patchids($id)
8136 proc do_cmp_commits {a b} {
8137 global ctext curview parents children patchids commitinfo
8139 $ctext conf -state normal
8142 for {set i 0} {$i < 100} {incr i} {
8143 set shorta [string range $a 0 7]
8144 set shortb [string range $b 0 7]
8147 if {[llength $parents($curview,$a)] > 1} {
8148 appendwithlinks [mc "Skipping merge commit %s\n" $shorta] {}
8151 set patcha [getpatchid $a]
8153 if {[llength $parents($curview,$b)] > 1} {
8154 appendwithlinks [mc "Skipping merge commit %s\n" $shortb] {}
8157 set patchb [getpatchid $b]
8159 if {!$skipa && !$skipb} {
8160 set heada [lindex $commitinfo($a) 0]
8161 set headb [lindex $commitinfo($b) 0]
8162 if {$patcha eq $patchb} {
8163 if {$heada eq $headb} {
8164 appendwithlinks [mc "Commit %s == %s %s\n" \
8165 $shorta $shortb $heada] {}
8167 appendwithlinks [mc "Commit %s %s\n" $shorta $heada] {}
8168 appendwithlinks [mc " is the same patch as\n"] {}
8169 appendwithlinks [mc " %s %s\n" $shortb $headb] {}
8174 $ctext insert end "\n"
8175 appendwithlinks [mc "Commit %s %s\n" $shorta $heada] {}
8176 appendwithlinks [mc " differs from\n"] {}
8177 appendwithlinks [mc " %s %s\n" $shortb $headb] {}
8178 appendwithlinks [mc "- stopping\n"]
8183 if {[llength $children($curview,$a)] != 1} {
8184 $ctext insert end "\n"
8185 appendwithlinks [mc "Commit %s has %s children - stopping\n" \
8186 $shorta [llength $children($curview,$a)]] {}
8189 set a [lindex $children($curview,$a) 0]
8192 if {[llength $children($curview,$b)] != 1} {
8193 appendwithlinks [mc "Commit %s has %s children - stopping\n" \
8194 $shortb [llength $children($curview,$b)]] {}
8197 set b [lindex $children($curview,$b) 0]
8200 $ctext conf -state disabled
8203 proc diffvssel {dirn} {
8204 global rowmenuid selectedline
8206 if {$selectedline eq {}} return
8208 set oldid [commitonrow $selectedline]
8209 set newid $rowmenuid
8211 set oldid $rowmenuid
8212 set newid [commitonrow $selectedline]
8214 addtohistory [list doseldiff $oldid $newid]
8215 doseldiff $oldid $newid
8218 proc doseldiff {oldid newid} {
8222 $ctext conf -state normal
8224 init_flist [mc "Top"]
8225 $ctext insert end "[mc "From"] "
8226 $ctext insert end $oldid link0
8227 setlink $oldid link0
8228 $ctext insert end "\n "
8229 $ctext insert end [lindex $commitinfo($oldid) 0]
8230 $ctext insert end "\n\n[mc "To"] "
8231 $ctext insert end $newid link1
8232 setlink $newid link1
8233 $ctext insert end "\n "
8234 $ctext insert end [lindex $commitinfo($newid) 0]
8235 $ctext insert end "\n"
8236 $ctext conf -state disabled
8237 $ctext tag remove found 1.0 end
8238 startdiff [list $oldid $newid]
8242 global rowmenuid currentid commitinfo patchtop patchnum
8244 if {![info exists currentid]} return
8245 set oldid $currentid
8246 set oldhead [lindex $commitinfo($oldid) 0]
8247 set newid $rowmenuid
8248 set newhead [lindex $commitinfo($newid) 0]
8251 catch {destroy $top}
8253 make_transient $top .
8254 label $top.title -text [mc "Generate patch"]
8255 grid $top.title - -pady 10
8256 label $top.from -text [mc "From:"]
8257 entry $top.fromsha1 -width 40 -relief flat
8258 $top.fromsha1 insert 0 $oldid
8259 $top.fromsha1 conf -state readonly
8260 grid $top.from $top.fromsha1 -sticky w
8261 entry $top.fromhead -width 60 -relief flat
8262 $top.fromhead insert 0 $oldhead
8263 $top.fromhead conf -state readonly
8264 grid x $top.fromhead -sticky w
8265 label $top.to -text [mc "To:"]
8266 entry $top.tosha1 -width 40 -relief flat
8267 $top.tosha1 insert 0 $newid
8268 $top.tosha1 conf -state readonly
8269 grid $top.to $top.tosha1 -sticky w
8270 entry $top.tohead -width 60 -relief flat
8271 $top.tohead insert 0 $newhead
8272 $top.tohead conf -state readonly
8273 grid x $top.tohead -sticky w
8274 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
8275 grid $top.rev x -pady 10
8276 label $top.flab -text [mc "Output file:"]
8277 entry $top.fname -width 60
8278 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8280 grid $top.flab $top.fname -sticky w
8282 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8283 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8284 bind $top <Key-Return> mkpatchgo
8285 bind $top <Key-Escape> mkpatchcan
8286 grid $top.buts.gen $top.buts.can
8287 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8288 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8289 grid $top.buts - -pady 10 -sticky ew
8293 proc mkpatchrev {} {
8296 set oldid [$patchtop.fromsha1 get]
8297 set oldhead [$patchtop.fromhead get]
8298 set newid [$patchtop.tosha1 get]
8299 set newhead [$patchtop.tohead get]
8300 foreach e [list fromsha1 fromhead tosha1 tohead] \
8301 v [list $newid $newhead $oldid $oldhead] {
8302 $patchtop.$e conf -state normal
8303 $patchtop.$e delete 0 end
8304 $patchtop.$e insert 0 $v
8305 $patchtop.$e conf -state readonly
8310 global patchtop nullid nullid2
8312 set oldid [$patchtop.fromsha1 get]
8313 set newid [$patchtop.tosha1 get]
8314 set fname [$patchtop.fname get]
8315 set cmd [diffcmd [list $oldid $newid] -p]
8316 # trim off the initial "|"
8317 set cmd [lrange $cmd 1 end]
8318 lappend cmd >$fname &
8319 if {[catch {eval exec $cmd} err]} {
8320 error_popup "[mc "Error creating patch:"] $err" $patchtop
8322 catch {destroy $patchtop}
8326 proc mkpatchcan {} {
8329 catch {destroy $patchtop}
8334 global rowmenuid mktagtop commitinfo
8338 catch {destroy $top}
8340 make_transient $top .
8341 label $top.title -text [mc "Create tag"]
8342 grid $top.title - -pady 10
8343 label $top.id -text [mc "ID:"]
8344 entry $top.sha1 -width 40 -relief flat
8345 $top.sha1 insert 0 $rowmenuid
8346 $top.sha1 conf -state readonly
8347 grid $top.id $top.sha1 -sticky w
8348 entry $top.head -width 60 -relief flat
8349 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8350 $top.head conf -state readonly
8351 grid x $top.head -sticky w
8352 label $top.tlab -text [mc "Tag name:"]
8353 entry $top.tag -width 60
8354 grid $top.tlab $top.tag -sticky w
8356 button $top.buts.gen -text [mc "Create"] -command mktaggo
8357 button $top.buts.can -text [mc "Cancel"] -command mktagcan
8358 bind $top <Key-Return> mktaggo
8359 bind $top <Key-Escape> mktagcan
8360 grid $top.buts.gen $top.buts.can
8361 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8362 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8363 grid $top.buts - -pady 10 -sticky ew
8368 global mktagtop env tagids idtags
8370 set id [$mktagtop.sha1 get]
8371 set tag [$mktagtop.tag get]
8373 error_popup [mc "No tag name specified"] $mktagtop
8376 if {[info exists tagids($tag)]} {
8377 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8381 exec git tag $tag $id
8383 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8387 set tagids($tag) $id
8388 lappend idtags($id) $tag
8396 proc redrawtags {id} {
8397 global canv linehtag idpos currentid curview cmitlisted markedid
8398 global canvxmax iddrawn circleitem mainheadid circlecolors
8400 if {![commitinview $id $curview]} return
8401 if {![info exists iddrawn($id)]} return
8402 set row [rowofcommit $id]
8403 if {$id eq $mainheadid} {
8406 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8408 $canv itemconf $circleitem($row) -fill $ofill
8409 $canv delete tag.$id
8410 set xt [eval drawtags $id $idpos($id)]
8411 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8412 set text [$canv itemcget $linehtag($id) -text]
8413 set font [$canv itemcget $linehtag($id) -font]
8414 set xr [expr {$xt + [font measure $font $text]}]
8415 if {$xr > $canvxmax} {
8419 if {[info exists currentid] && $currentid == $id} {
8422 if {[info exists markedid] && $markedid eq $id} {
8430 catch {destroy $mktagtop}
8435 if {![domktag]} return
8439 proc writecommit {} {
8440 global rowmenuid wrcomtop commitinfo wrcomcmd
8442 set top .writecommit
8444 catch {destroy $top}
8446 make_transient $top .
8447 label $top.title -text [mc "Write commit to file"]
8448 grid $top.title - -pady 10
8449 label $top.id -text [mc "ID:"]
8450 entry $top.sha1 -width 40 -relief flat
8451 $top.sha1 insert 0 $rowmenuid
8452 $top.sha1 conf -state readonly
8453 grid $top.id $top.sha1 -sticky w
8454 entry $top.head -width 60 -relief flat
8455 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8456 $top.head conf -state readonly
8457 grid x $top.head -sticky w
8458 label $top.clab -text [mc "Command:"]
8459 entry $top.cmd -width 60 -textvariable wrcomcmd
8460 grid $top.clab $top.cmd -sticky w -pady 10
8461 label $top.flab -text [mc "Output file:"]
8462 entry $top.fname -width 60
8463 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8464 grid $top.flab $top.fname -sticky w
8466 button $top.buts.gen -text [mc "Write"] -command wrcomgo
8467 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8468 bind $top <Key-Return> wrcomgo
8469 bind $top <Key-Escape> wrcomcan
8470 grid $top.buts.gen $top.buts.can
8471 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8472 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8473 grid $top.buts - -pady 10 -sticky ew
8480 set id [$wrcomtop.sha1 get]
8481 set cmd "echo $id | [$wrcomtop.cmd get]"
8482 set fname [$wrcomtop.fname get]
8483 if {[catch {exec sh -c $cmd >$fname &} err]} {
8484 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8486 catch {destroy $wrcomtop}
8493 catch {destroy $wrcomtop}
8498 global rowmenuid mkbrtop
8501 catch {destroy $top}
8503 make_transient $top .
8504 label $top.title -text [mc "Create new branch"]
8505 grid $top.title - -pady 10
8506 label $top.id -text [mc "ID:"]
8507 entry $top.sha1 -width 40 -relief flat
8508 $top.sha1 insert 0 $rowmenuid
8509 $top.sha1 conf -state readonly
8510 grid $top.id $top.sha1 -sticky w
8511 label $top.nlab -text [mc "Name:"]
8512 entry $top.name -width 40
8513 grid $top.nlab $top.name -sticky w
8515 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8516 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8517 bind $top <Key-Return> [list mkbrgo $top]
8518 bind $top <Key-Escape> "catch {destroy $top}"
8519 grid $top.buts.go $top.buts.can
8520 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8521 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8522 grid $top.buts - -pady 10 -sticky ew
8527 global headids idheads
8529 set name [$top.name get]
8530 set id [$top.sha1 get]
8534 error_popup [mc "Please specify a name for the new branch"] $top
8537 if {[info exists headids($name)]} {
8538 if {![confirm_popup [mc \
8539 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8542 set old_id $headids($name)
8545 catch {destroy $top}
8546 lappend cmdargs $name $id
8550 eval exec git branch $cmdargs
8556 if {$old_id ne {}} {
8562 set headids($name) $id
8563 lappend idheads($id) $name
8572 proc exec_citool {tool_args {baseid {}}} {
8573 global commitinfo env
8575 set save_env [array get env GIT_AUTHOR_*]
8577 if {$baseid ne {}} {
8578 if {![info exists commitinfo($baseid)]} {
8581 set author [lindex $commitinfo($baseid) 1]
8582 set date [lindex $commitinfo($baseid) 2]
8583 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8584 $author author name email]
8586 set env(GIT_AUTHOR_NAME) $name
8587 set env(GIT_AUTHOR_EMAIL) $email
8588 set env(GIT_AUTHOR_DATE) $date
8592 eval exec git citool $tool_args &
8594 array unset env GIT_AUTHOR_*
8595 array set env $save_env
8598 proc cherrypick {} {
8599 global rowmenuid curview
8600 global mainhead mainheadid
8602 set oldhead [exec git rev-parse HEAD]
8603 set dheads [descheads $rowmenuid]
8604 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8605 set ok [confirm_popup [mc "Commit %s is already\
8606 included in branch %s -- really re-apply it?" \
8607 [string range $rowmenuid 0 7] $mainhead]]
8610 nowbusy cherrypick [mc "Cherry-picking"]
8612 # Unfortunately git-cherry-pick writes stuff to stderr even when
8613 # no error occurs, and exec takes that as an indication of error...
8614 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8617 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8619 error_popup [mc "Cherry-pick failed because of local changes\
8620 to file '%s'.\nPlease commit, reset or stash\
8621 your changes and try again." $fname]
8622 } elseif {[regexp -line \
8623 {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8625 if {[confirm_popup [mc "Cherry-pick failed because of merge\
8626 conflict.\nDo you wish to run git citool to\
8628 # Force citool to read MERGE_MSG
8629 file delete [file join [gitdir] "GITGUI_MSG"]
8630 exec_citool {} $rowmenuid
8638 set newhead [exec git rev-parse HEAD]
8639 if {$newhead eq $oldhead} {
8641 error_popup [mc "No changes committed"]
8644 addnewchild $newhead $oldhead
8645 if {[commitinview $oldhead $curview]} {
8646 # XXX this isn't right if we have a path limit...
8647 insertrow $newhead $oldhead $curview
8648 if {$mainhead ne {}} {
8649 movehead $newhead $mainhead
8650 movedhead $newhead $mainhead
8652 set mainheadid $newhead
8661 global mainhead rowmenuid confirm_ok resettype
8664 set w ".confirmreset"
8667 wm title $w [mc "Confirm reset"]
8668 message $w.m -text \
8669 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8670 -justify center -aspect 1000
8671 pack $w.m -side top -fill x -padx 20 -pady 20
8672 frame $w.f -relief sunken -border 2
8673 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8674 grid $w.f.rt -sticky w
8676 radiobutton $w.f.soft -value soft -variable resettype -justify left \
8677 -text [mc "Soft: Leave working tree and index untouched"]
8678 grid $w.f.soft -sticky w
8679 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8680 -text [mc "Mixed: Leave working tree untouched, reset index"]
8681 grid $w.f.mixed -sticky w
8682 radiobutton $w.f.hard -value hard -variable resettype -justify left \
8683 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8684 grid $w.f.hard -sticky w
8685 pack $w.f -side top -fill x
8686 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8687 pack $w.ok -side left -fill x -padx 20 -pady 20
8688 button $w.cancel -text [mc Cancel] -command "destroy $w"
8689 bind $w <Key-Escape> [list destroy $w]
8690 pack $w.cancel -side right -fill x -padx 20 -pady 20
8691 bind $w <Visibility> "grab $w; focus $w"
8693 if {!$confirm_ok} return
8694 if {[catch {set fd [open \
8695 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8699 filerun $fd [list readresetstat $fd]
8700 nowbusy reset [mc "Resetting"]
8705 proc readresetstat {fd} {
8706 global mainhead mainheadid showlocalchanges rprogcoord
8708 if {[gets $fd line] >= 0} {
8709 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8710 set rprogcoord [expr {1.0 * $m / $n}]
8718 if {[catch {close $fd} err]} {
8721 set oldhead $mainheadid
8722 set newhead [exec git rev-parse HEAD]
8723 if {$newhead ne $oldhead} {
8724 movehead $newhead $mainhead
8725 movedhead $newhead $mainhead
8726 set mainheadid $newhead
8730 if {$showlocalchanges} {
8736 # context menu for a head
8737 proc headmenu {x y id head} {
8738 global headmenuid headmenuhead headctxmenu mainhead
8742 set headmenuhead $head
8744 if {$head eq $mainhead} {
8747 $headctxmenu entryconfigure 0 -state $state
8748 $headctxmenu entryconfigure 1 -state $state
8749 tk_popup $headctxmenu $x $y
8753 global headmenuid headmenuhead headids
8754 global showlocalchanges
8756 # check the tree is clean first??
8757 nowbusy checkout [mc "Checking out"]
8761 set fd [open [list | git checkout $headmenuhead 2>@1] r]
8765 if {$showlocalchanges} {
8769 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8773 proc readcheckoutstat {fd newhead newheadid} {
8774 global mainhead mainheadid headids showlocalchanges progresscoords
8775 global viewmainheadid curview
8777 if {[gets $fd line] >= 0} {
8778 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8779 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8784 set progresscoords {0 0}
8787 if {[catch {close $fd} err]} {
8790 set oldmainid $mainheadid
8791 set mainhead $newhead
8792 set mainheadid $newheadid
8793 set viewmainheadid($curview) $newheadid
8794 redrawtags $oldmainid
8795 redrawtags $newheadid
8797 if {$showlocalchanges} {
8803 global headmenuid headmenuhead mainhead
8806 set head $headmenuhead
8808 # this check shouldn't be needed any more...
8809 if {$head eq $mainhead} {
8810 error_popup [mc "Cannot delete the currently checked-out branch"]
8813 set dheads [descheads $id]
8814 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8815 # the stuff on this branch isn't on any other branch
8816 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8817 branch.\nReally delete branch %s?" $head $head]]} return
8821 if {[catch {exec git branch -D $head} err]} {
8826 removehead $id $head
8827 removedhead $id $head
8834 # Display a list of tags and heads
8836 global showrefstop bgcolor fgcolor selectbgcolor
8837 global bglist fglist reflistfilter reflist maincursor
8840 set showrefstop $top
8841 if {[winfo exists $top]} {
8847 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8848 make_transient $top .
8849 text $top.list -background $bgcolor -foreground $fgcolor \
8850 -selectbackground $selectbgcolor -font mainfont \
8851 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8852 -width 30 -height 20 -cursor $maincursor \
8853 -spacing1 1 -spacing3 1 -state disabled
8854 $top.list tag configure highlight -background $selectbgcolor
8855 lappend bglist $top.list
8856 lappend fglist $top.list
8857 scrollbar $top.ysb -command "$top.list yview" -orient vertical
8858 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8859 grid $top.list $top.ysb -sticky nsew
8860 grid $top.xsb x -sticky ew
8862 label $top.f.l -text "[mc "Filter"]: "
8863 entry $top.f.e -width 20 -textvariable reflistfilter
8864 set reflistfilter "*"
8865 trace add variable reflistfilter write reflistfilter_change
8866 pack $top.f.e -side right -fill x -expand 1
8867 pack $top.f.l -side left
8868 grid $top.f - -sticky ew -pady 2
8869 button $top.close -command [list destroy $top] -text [mc "Close"]
8870 bind $top <Key-Escape> [list destroy $top]
8872 grid columnconfigure $top 0 -weight 1
8873 grid rowconfigure $top 0 -weight 1
8874 bind $top.list <1> {break}
8875 bind $top.list <B1-Motion> {break}
8876 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8881 proc sel_reflist {w x y} {
8882 global showrefstop reflist headids tagids otherrefids
8884 if {![winfo exists $showrefstop]} return
8885 set l [lindex [split [$w index "@$x,$y"] "."] 0]
8886 set ref [lindex $reflist [expr {$l-1}]]
8887 set n [lindex $ref 0]
8888 switch -- [lindex $ref 1] {
8889 "H" {selbyid $headids($n)}
8890 "T" {selbyid $tagids($n)}
8891 "o" {selbyid $otherrefids($n)}
8893 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8896 proc unsel_reflist {} {
8899 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8900 $showrefstop.list tag remove highlight 0.0 end
8903 proc reflistfilter_change {n1 n2 op} {
8904 global reflistfilter
8906 after cancel refill_reflist
8907 after 200 refill_reflist
8910 proc refill_reflist {} {
8911 global reflist reflistfilter showrefstop headids tagids otherrefids
8914 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8916 foreach n [array names headids] {
8917 if {[string match $reflistfilter $n]} {
8918 if {[commitinview $headids($n) $curview]} {
8919 lappend refs [list $n H]
8921 interestedin $headids($n) {run refill_reflist}
8925 foreach n [array names tagids] {
8926 if {[string match $reflistfilter $n]} {
8927 if {[commitinview $tagids($n) $curview]} {
8928 lappend refs [list $n T]
8930 interestedin $tagids($n) {run refill_reflist}
8934 foreach n [array names otherrefids] {
8935 if {[string match $reflistfilter $n]} {
8936 if {[commitinview $otherrefids($n) $curview]} {
8937 lappend refs [list $n o]
8939 interestedin $otherrefids($n) {run refill_reflist}
8943 set refs [lsort -index 0 $refs]
8944 if {$refs eq $reflist} return
8946 # Update the contents of $showrefstop.list according to the
8947 # differences between $reflist (old) and $refs (new)
8948 $showrefstop.list conf -state normal
8949 $showrefstop.list insert end "\n"
8952 while {$i < [llength $reflist] || $j < [llength $refs]} {
8953 if {$i < [llength $reflist]} {
8954 if {$j < [llength $refs]} {
8955 set cmp [string compare [lindex $reflist $i 0] \
8956 [lindex $refs $j 0]]
8958 set cmp [string compare [lindex $reflist $i 1] \
8959 [lindex $refs $j 1]]
8969 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8977 set l [expr {$j + 1}]
8978 $showrefstop.list image create $l.0 -align baseline \
8979 -image reficon-[lindex $refs $j 1] -padx 2
8980 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8986 # delete last newline
8987 $showrefstop.list delete end-2c end-1c
8988 $showrefstop.list conf -state disabled
8991 # Stuff for finding nearby tags
8992 proc getallcommits {} {
8993 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8994 global idheads idtags idotherrefs allparents tagobjid
8996 if {![info exists allcommits]} {
9002 set allccache [file join [gitdir] "gitk.cache"]
9004 set f [open $allccache r]
9013 set cmd [list | git rev-list --parents]
9014 set allcupdate [expr {$seeds ne {}}]
9018 set refs [concat [array names idheads] [array names idtags] \
9019 [array names idotherrefs]]
9022 foreach name [array names tagobjid] {
9023 lappend tagobjs $tagobjid($name)
9025 foreach id [lsort -unique $refs] {
9026 if {![info exists allparents($id)] &&
9027 [lsearch -exact $tagobjs $id] < 0} {
9038 set fd [open [concat $cmd $ids] r]
9039 fconfigure $fd -blocking 0
9042 filerun $fd [list getallclines $fd]
9048 # Since most commits have 1 parent and 1 child, we group strings of
9049 # such commits into "arcs" joining branch/merge points (BMPs), which
9050 # are commits that either don't have 1 parent or don't have 1 child.
9052 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9053 # arcout(id) - outgoing arcs for BMP
9054 # arcids(a) - list of IDs on arc including end but not start
9055 # arcstart(a) - BMP ID at start of arc
9056 # arcend(a) - BMP ID at end of arc
9057 # growing(a) - arc a is still growing
9058 # arctags(a) - IDs out of arcids (excluding end) that have tags
9059 # archeads(a) - IDs out of arcids (excluding end) that have heads
9060 # The start of an arc is at the descendent end, so "incoming" means
9061 # coming from descendents, and "outgoing" means going towards ancestors.
9063 proc getallclines {fd} {
9064 global allparents allchildren idtags idheads nextarc
9065 global arcnos arcids arctags arcout arcend arcstart archeads growing
9066 global seeds allcommits cachedarcs allcupdate
9069 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9070 set id [lindex $line 0]
9071 if {[info exists allparents($id)]} {
9076 set olds [lrange $line 1 end]
9077 set allparents($id) $olds
9078 if {![info exists allchildren($id)]} {
9079 set allchildren($id) {}
9084 if {[llength $olds] == 1 && [llength $a] == 1} {
9085 lappend arcids($a) $id
9086 if {[info exists idtags($id)]} {
9087 lappend arctags($a) $id
9089 if {[info exists idheads($id)]} {
9090 lappend archeads($a) $id
9092 if {[info exists allparents($olds)]} {
9093 # seen parent already
9094 if {![info exists arcout($olds)]} {
9097 lappend arcids($a) $olds
9098 set arcend($a) $olds
9101 lappend allchildren($olds) $id
9102 lappend arcnos($olds) $a
9106 foreach a $arcnos($id) {
9107 lappend arcids($a) $id
9114 lappend allchildren($p) $id
9115 set a [incr nextarc]
9116 set arcstart($a) $id
9123 if {[info exists allparents($p)]} {
9124 # seen it already, may need to make a new branch
9125 if {![info exists arcout($p)]} {
9128 lappend arcids($a) $p
9132 lappend arcnos($p) $a
9137 global cached_dheads cached_dtags cached_atags
9138 catch {unset cached_dheads}
9139 catch {unset cached_dtags}
9140 catch {unset cached_atags}
9143 return [expr {$nid >= 1000? 2: 1}]
9147 fconfigure $fd -blocking 1
9150 # got an error reading the list of commits
9151 # if we were updating, try rereading the whole thing again
9157 error_popup "[mc "Error reading commit topology information;\
9158 branch and preceding/following tag information\
9159 will be incomplete."]\n($err)"
9162 if {[incr allcommits -1] == 0} {
9172 proc recalcarc {a} {
9173 global arctags archeads arcids idtags idheads
9177 foreach id [lrange $arcids($a) 0 end-1] {
9178 if {[info exists idtags($id)]} {
9181 if {[info exists idheads($id)]} {
9186 set archeads($a) $ah
9190 global arcnos arcids nextarc arctags archeads idtags idheads
9191 global arcstart arcend arcout allparents growing
9194 if {[llength $a] != 1} {
9195 puts "oops splitarc called but [llength $a] arcs already"
9199 set i [lsearch -exact $arcids($a) $p]
9201 puts "oops splitarc $p not in arc $a"
9204 set na [incr nextarc]
9205 if {[info exists arcend($a)]} {
9206 set arcend($na) $arcend($a)
9208 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9209 set j [lsearch -exact $arcnos($l) $a]
9210 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9212 set tail [lrange $arcids($a) [expr {$i+1}] end]
9213 set arcids($a) [lrange $arcids($a) 0 $i]
9215 set arcstart($na) $p
9217 set arcids($na) $tail
9218 if {[info exists growing($a)]} {
9224 if {[llength $arcnos($id)] == 1} {
9227 set j [lsearch -exact $arcnos($id) $a]
9228 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9232 # reconstruct tags and heads lists
9233 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9238 set archeads($na) {}
9242 # Update things for a new commit added that is a child of one
9243 # existing commit. Used when cherry-picking.
9244 proc addnewchild {id p} {
9245 global allparents allchildren idtags nextarc
9246 global arcnos arcids arctags arcout arcend arcstart archeads growing
9247 global seeds allcommits
9249 if {![info exists allcommits] || ![info exists arcnos($p)]} return
9250 set allparents($id) [list $p]
9251 set allchildren($id) {}
9254 lappend allchildren($p) $id
9255 set a [incr nextarc]
9256 set arcstart($a) $id
9259 set arcids($a) [list $p]
9261 if {![info exists arcout($p)]} {
9264 lappend arcnos($p) $a
9265 set arcout($id) [list $a]
9268 # This implements a cache for the topology information.
9269 # The cache saves, for each arc, the start and end of the arc,
9270 # the ids on the arc, and the outgoing arcs from the end.
9271 proc readcache {f} {
9272 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9273 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9278 if {$lim - $a > 500} {
9279 set lim [expr {$a + 500}]
9283 # finish reading the cache and setting up arctags, etc.
9285 if {$line ne "1"} {error "bad final version"}
9287 foreach id [array names idtags] {
9288 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9289 [llength $allparents($id)] == 1} {
9290 set a [lindex $arcnos($id) 0]
9291 if {$arctags($a) eq {}} {
9296 foreach id [array names idheads] {
9297 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9298 [llength $allparents($id)] == 1} {
9299 set a [lindex $arcnos($id) 0]
9300 if {$archeads($a) eq {}} {
9305 foreach id [lsort -unique $possible_seeds] {
9306 if {$arcnos($id) eq {}} {
9312 while {[incr a] <= $lim} {
9314 if {[llength $line] != 3} {error "bad line"}
9315 set s [lindex $line 0]
9317 lappend arcout($s) $a
9318 if {![info exists arcnos($s)]} {
9319 lappend possible_seeds $s
9322 set e [lindex $line 1]
9327 if {![info exists arcout($e)]} {
9331 set arcids($a) [lindex $line 2]
9332 foreach id $arcids($a) {
9333 lappend allparents($s) $id
9335 lappend arcnos($id) $a
9337 if {![info exists allparents($s)]} {
9338 set allparents($s) {}
9343 set nextarc [expr {$a - 1}]
9356 global nextarc cachedarcs possible_seeds
9360 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9361 # make sure it's an integer
9362 set cachedarcs [expr {int([lindex $line 1])}]
9363 if {$cachedarcs < 0} {error "bad number of arcs"}
9365 set possible_seeds {}
9373 proc dropcache {err} {
9374 global allcwait nextarc cachedarcs seeds
9376 #puts "dropping cache ($err)"
9377 foreach v {arcnos arcout arcids arcstart arcend growing \
9378 arctags archeads allparents allchildren} {
9389 proc writecache {f} {
9390 global cachearc cachedarcs allccache
9391 global arcstart arcend arcnos arcids arcout
9395 if {$lim - $a > 1000} {
9396 set lim [expr {$a + 1000}]
9399 while {[incr a] <= $lim} {
9400 if {[info exists arcend($a)]} {
9401 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9403 puts $f [list $arcstart($a) {} $arcids($a)]
9408 catch {file delete $allccache}
9409 #puts "writing cache failed ($err)"
9412 set cachearc [expr {$a - 1}]
9413 if {$a > $cachedarcs} {
9422 global nextarc cachedarcs cachearc allccache
9424 if {$nextarc == $cachedarcs} return
9426 set cachedarcs $nextarc
9428 set f [open $allccache w]
9429 puts $f [list 1 $cachedarcs]
9434 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9435 # or 0 if neither is true.
9436 proc anc_or_desc {a b} {
9437 global arcout arcstart arcend arcnos cached_isanc
9439 if {$arcnos($a) eq $arcnos($b)} {
9440 # Both are on the same arc(s); either both are the same BMP,
9441 # or if one is not a BMP, the other is also not a BMP or is
9442 # the BMP at end of the arc (and it only has 1 incoming arc).
9443 # Or both can be BMPs with no incoming arcs.
9444 if {$a eq $b || $arcnos($a) eq {}} {
9447 # assert {[llength $arcnos($a)] == 1}
9448 set arc [lindex $arcnos($a) 0]
9449 set i [lsearch -exact $arcids($arc) $a]
9450 set j [lsearch -exact $arcids($arc) $b]
9451 if {$i < 0 || $i > $j} {
9458 if {![info exists arcout($a)]} {
9459 set arc [lindex $arcnos($a) 0]
9460 if {[info exists arcend($arc)]} {
9461 set aend $arcend($arc)
9465 set a $arcstart($arc)
9469 if {![info exists arcout($b)]} {
9470 set arc [lindex $arcnos($b) 0]
9471 if {[info exists arcend($arc)]} {
9472 set bend $arcend($arc)
9476 set b $arcstart($arc)
9486 if {[info exists cached_isanc($a,$bend)]} {
9487 if {$cached_isanc($a,$bend)} {
9491 if {[info exists cached_isanc($b,$aend)]} {
9492 if {$cached_isanc($b,$aend)} {
9495 if {[info exists cached_isanc($a,$bend)]} {
9500 set todo [list $a $b]
9503 for {set i 0} {$i < [llength $todo]} {incr i} {
9504 set x [lindex $todo $i]
9505 if {$anc($x) eq {}} {
9508 foreach arc $arcnos($x) {
9509 set xd $arcstart($arc)
9511 set cached_isanc($a,$bend) 1
9512 set cached_isanc($b,$aend) 0
9514 } elseif {$xd eq $aend} {
9515 set cached_isanc($b,$aend) 1
9516 set cached_isanc($a,$bend) 0
9519 if {![info exists anc($xd)]} {
9520 set anc($xd) $anc($x)
9522 } elseif {$anc($xd) ne $anc($x)} {
9527 set cached_isanc($a,$bend) 0
9528 set cached_isanc($b,$aend) 0
9532 # This identifies whether $desc has an ancestor that is
9533 # a growing tip of the graph and which is not an ancestor of $anc
9534 # and returns 0 if so and 1 if not.
9535 # If we subsequently discover a tag on such a growing tip, and that
9536 # turns out to be a descendent of $anc (which it could, since we
9537 # don't necessarily see children before parents), then $desc
9538 # isn't a good choice to display as a descendent tag of
9539 # $anc (since it is the descendent of another tag which is
9540 # a descendent of $anc). Similarly, $anc isn't a good choice to
9541 # display as a ancestor tag of $desc.
9543 proc is_certain {desc anc} {
9544 global arcnos arcout arcstart arcend growing problems
9547 if {[llength $arcnos($anc)] == 1} {
9548 # tags on the same arc are certain
9549 if {$arcnos($desc) eq $arcnos($anc)} {
9552 if {![info exists arcout($anc)]} {
9553 # if $anc is partway along an arc, use the start of the arc instead
9554 set a [lindex $arcnos($anc) 0]
9555 set anc $arcstart($a)
9558 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9561 set a [lindex $arcnos($desc) 0]
9567 set anclist [list $x]
9571 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9572 set x [lindex $anclist $i]
9577 foreach a $arcout($x) {
9578 if {[info exists growing($a)]} {
9579 if {![info exists growanc($x)] && $dl($x)} {
9585 if {[info exists dl($y)]} {
9589 if {![info exists done($y)]} {
9592 if {[info exists growanc($x)]} {
9596 for {set k 0} {$k < [llength $xl]} {incr k} {
9597 set z [lindex $xl $k]
9598 foreach c $arcout($z) {
9599 if {[info exists arcend($c)]} {
9601 if {[info exists dl($v)] && $dl($v)} {
9603 if {![info exists done($v)]} {
9606 if {[info exists growanc($v)]} {
9616 } elseif {$y eq $anc || !$dl($x)} {
9627 foreach x [array names growanc] {
9636 proc validate_arctags {a} {
9637 global arctags idtags
9641 foreach id $arctags($a) {
9643 if {![info exists idtags($id)]} {
9644 set na [lreplace $na $i $i]
9651 proc validate_archeads {a} {
9652 global archeads idheads
9655 set na $archeads($a)
9656 foreach id $archeads($a) {
9658 if {![info exists idheads($id)]} {
9659 set na [lreplace $na $i $i]
9663 set archeads($a) $na
9666 # Return the list of IDs that have tags that are descendents of id,
9667 # ignoring IDs that are descendents of IDs already reported.
9668 proc desctags {id} {
9669 global arcnos arcstart arcids arctags idtags allparents
9670 global growing cached_dtags
9672 if {![info exists allparents($id)]} {
9675 set t1 [clock clicks -milliseconds]
9677 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9678 # part-way along an arc; check that arc first
9679 set a [lindex $arcnos($id) 0]
9680 if {$arctags($a) ne {}} {
9682 set i [lsearch -exact $arcids($a) $id]
9684 foreach t $arctags($a) {
9685 set j [lsearch -exact $arcids($a) $t]
9693 set id $arcstart($a)
9694 if {[info exists idtags($id)]} {
9698 if {[info exists cached_dtags($id)]} {
9699 return $cached_dtags($id)
9706 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9707 set id [lindex $todo $i]
9709 set ta [info exists hastaggedancestor($id)]
9713 # ignore tags on starting node
9714 if {!$ta && $i > 0} {
9715 if {[info exists idtags($id)]} {
9718 } elseif {[info exists cached_dtags($id)]} {
9719 set tagloc($id) $cached_dtags($id)
9723 foreach a $arcnos($id) {
9725 if {!$ta && $arctags($a) ne {}} {
9727 if {$arctags($a) ne {}} {
9728 lappend tagloc($id) [lindex $arctags($a) end]
9731 if {$ta || $arctags($a) ne {}} {
9732 set tomark [list $d]
9733 for {set j 0} {$j < [llength $tomark]} {incr j} {
9734 set dd [lindex $tomark $j]
9735 if {![info exists hastaggedancestor($dd)]} {
9736 if {[info exists done($dd)]} {
9737 foreach b $arcnos($dd) {
9738 lappend tomark $arcstart($b)
9740 if {[info exists tagloc($dd)]} {
9743 } elseif {[info exists queued($dd)]} {
9746 set hastaggedancestor($dd) 1
9750 if {![info exists queued($d)]} {
9753 if {![info exists hastaggedancestor($d)]} {
9760 foreach id [array names tagloc] {
9761 if {![info exists hastaggedancestor($id)]} {
9762 foreach t $tagloc($id) {
9763 if {[lsearch -exact $tags $t] < 0} {
9769 set t2 [clock clicks -milliseconds]
9772 # remove tags that are descendents of other tags
9773 for {set i 0} {$i < [llength $tags]} {incr i} {
9774 set a [lindex $tags $i]
9775 for {set j 0} {$j < $i} {incr j} {
9776 set b [lindex $tags $j]
9777 set r [anc_or_desc $a $b]
9779 set tags [lreplace $tags $j $j]
9782 } elseif {$r == -1} {
9783 set tags [lreplace $tags $i $i]
9790 if {[array names growing] ne {}} {
9791 # graph isn't finished, need to check if any tag could get
9792 # eclipsed by another tag coming later. Simply ignore any
9793 # tags that could later get eclipsed.
9796 if {[is_certain $t $origid]} {
9800 if {$tags eq $ctags} {
9801 set cached_dtags($origid) $tags
9806 set cached_dtags($origid) $tags
9808 set t3 [clock clicks -milliseconds]
9809 if {0 && $t3 - $t1 >= 100} {
9810 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9811 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9817 global arcnos arcids arcout arcend arctags idtags allparents
9818 global growing cached_atags
9820 if {![info exists allparents($id)]} {
9823 set t1 [clock clicks -milliseconds]
9825 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9826 # part-way along an arc; check that arc first
9827 set a [lindex $arcnos($id) 0]
9828 if {$arctags($a) ne {}} {
9830 set i [lsearch -exact $arcids($a) $id]
9831 foreach t $arctags($a) {
9832 set j [lsearch -exact $arcids($a) $t]
9838 if {![info exists arcend($a)]} {
9842 if {[info exists idtags($id)]} {
9846 if {[info exists cached_atags($id)]} {
9847 return $cached_atags($id)
9855 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9856 set id [lindex $todo $i]
9858 set td [info exists hastaggeddescendent($id)]
9862 # ignore tags on starting node
9863 if {!$td && $i > 0} {
9864 if {[info exists idtags($id)]} {
9867 } elseif {[info exists cached_atags($id)]} {
9868 set tagloc($id) $cached_atags($id)
9872 foreach a $arcout($id) {
9873 if {!$td && $arctags($a) ne {}} {
9875 if {$arctags($a) ne {}} {
9876 lappend tagloc($id) [lindex $arctags($a) 0]
9879 if {![info exists arcend($a)]} continue
9881 if {$td || $arctags($a) ne {}} {
9882 set tomark [list $d]
9883 for {set j 0} {$j < [llength $tomark]} {incr j} {
9884 set dd [lindex $tomark $j]
9885 if {![info exists hastaggeddescendent($dd)]} {
9886 if {[info exists done($dd)]} {
9887 foreach b $arcout($dd) {
9888 if {[info exists arcend($b)]} {
9889 lappend tomark $arcend($b)
9892 if {[info exists tagloc($dd)]} {
9895 } elseif {[info exists queued($dd)]} {
9898 set hastaggeddescendent($dd) 1
9902 if {![info exists queued($d)]} {
9905 if {![info exists hastaggeddescendent($d)]} {
9911 set t2 [clock clicks -milliseconds]
9914 foreach id [array names tagloc] {
9915 if {![info exists hastaggeddescendent($id)]} {
9916 foreach t $tagloc($id) {
9917 if {[lsearch -exact $tags $t] < 0} {
9924 # remove tags that are ancestors of other tags
9925 for {set i 0} {$i < [llength $tags]} {incr i} {
9926 set a [lindex $tags $i]
9927 for {set j 0} {$j < $i} {incr j} {
9928 set b [lindex $tags $j]
9929 set r [anc_or_desc $a $b]
9931 set tags [lreplace $tags $j $j]
9934 } elseif {$r == 1} {
9935 set tags [lreplace $tags $i $i]
9942 if {[array names growing] ne {}} {
9943 # graph isn't finished, need to check if any tag could get
9944 # eclipsed by another tag coming later. Simply ignore any
9945 # tags that could later get eclipsed.
9948 if {[is_certain $origid $t]} {
9952 if {$tags eq $ctags} {
9953 set cached_atags($origid) $tags
9958 set cached_atags($origid) $tags
9960 set t3 [clock clicks -milliseconds]
9961 if {0 && $t3 - $t1 >= 100} {
9962 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9963 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9968 # Return the list of IDs that have heads that are descendents of id,
9969 # including id itself if it has a head.
9970 proc descheads {id} {
9971 global arcnos arcstart arcids archeads idheads cached_dheads
9974 if {![info exists allparents($id)]} {
9978 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9979 # part-way along an arc; check it first
9980 set a [lindex $arcnos($id) 0]
9981 if {$archeads($a) ne {}} {
9982 validate_archeads $a
9983 set i [lsearch -exact $arcids($a) $id]
9984 foreach t $archeads($a) {
9985 set j [lsearch -exact $arcids($a) $t]
9990 set id $arcstart($a)
9996 for {set i 0} {$i < [llength $todo]} {incr i} {
9997 set id [lindex $todo $i]
9998 if {[info exists cached_dheads($id)]} {
9999 set ret [concat $ret $cached_dheads($id)]
10001 if {[info exists idheads($id)]} {
10004 foreach a $arcnos($id) {
10005 if {$archeads($a) ne {}} {
10006 validate_archeads $a
10007 if {$archeads($a) ne {}} {
10008 set ret [concat $ret $archeads($a)]
10011 set d $arcstart($a)
10012 if {![info exists seen($d)]} {
10019 set ret [lsort -unique $ret]
10020 set cached_dheads($origid) $ret
10021 return [concat $ret $aret]
10024 proc addedtag {id} {
10025 global arcnos arcout cached_dtags cached_atags
10027 if {![info exists arcnos($id)]} return
10028 if {![info exists arcout($id)]} {
10029 recalcarc [lindex $arcnos($id) 0]
10031 catch {unset cached_dtags}
10032 catch {unset cached_atags}
10035 proc addedhead {hid head} {
10036 global arcnos arcout cached_dheads
10038 if {![info exists arcnos($hid)]} return
10039 if {![info exists arcout($hid)]} {
10040 recalcarc [lindex $arcnos($hid) 0]
10042 catch {unset cached_dheads}
10045 proc removedhead {hid head} {
10046 global cached_dheads
10048 catch {unset cached_dheads}
10051 proc movedhead {hid head} {
10052 global arcnos arcout cached_dheads
10054 if {![info exists arcnos($hid)]} return
10055 if {![info exists arcout($hid)]} {
10056 recalcarc [lindex $arcnos($hid) 0]
10058 catch {unset cached_dheads}
10061 proc changedrefs {} {
10062 global cached_dheads cached_dtags cached_atags
10063 global arctags archeads arcnos arcout idheads idtags
10065 foreach id [concat [array names idheads] [array names idtags]] {
10066 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10067 set a [lindex $arcnos($id) 0]
10068 if {![info exists donearc($a)]} {
10074 catch {unset cached_dtags}
10075 catch {unset cached_atags}
10076 catch {unset cached_dheads}
10079 proc rereadrefs {} {
10080 global idtags idheads idotherrefs mainheadid
10082 set refids [concat [array names idtags] \
10083 [array names idheads] [array names idotherrefs]]
10084 foreach id $refids {
10085 if {![info exists ref($id)]} {
10086 set ref($id) [listrefs $id]
10089 set oldmainhead $mainheadid
10092 set refids [lsort -unique [concat $refids [array names idtags] \
10093 [array names idheads] [array names idotherrefs]]]
10094 foreach id $refids {
10095 set v [listrefs $id]
10096 if {![info exists ref($id)] || $ref($id) != $v} {
10100 if {$oldmainhead ne $mainheadid} {
10101 redrawtags $oldmainhead
10102 redrawtags $mainheadid
10107 proc listrefs {id} {
10108 global idtags idheads idotherrefs
10111 if {[info exists idtags($id)]} {
10115 if {[info exists idheads($id)]} {
10116 set y $idheads($id)
10119 if {[info exists idotherrefs($id)]} {
10120 set z $idotherrefs($id)
10122 return [list $x $y $z]
10125 proc showtag {tag isnew} {
10126 global ctext tagcontents tagids linknum tagobjid
10129 addtohistory [list showtag $tag 0]
10131 $ctext conf -state normal
10135 if {![info exists tagcontents($tag)]} {
10137 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
10140 if {[info exists tagcontents($tag)]} {
10141 set text $tagcontents($tag)
10143 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
10145 appendwithlinks $text {}
10146 $ctext conf -state disabled
10158 if {[info exists gitktmpdir]} {
10159 catch {file delete -force $gitktmpdir}
10163 proc mkfontdisp {font top which} {
10164 global fontattr fontpref $font
10166 set fontpref($font) [set $font]
10167 button $top.${font}but -text $which -font optionfont \
10168 -command [list choosefont $font $which]
10169 label $top.$font -relief flat -font $font \
10170 -text $fontattr($font,family) -justify left
10171 grid x $top.${font}but $top.$font -sticky w
10174 proc choosefont {font which} {
10175 global fontparam fontlist fonttop fontattr
10178 set fontparam(which) $which
10179 set fontparam(font) $font
10180 set fontparam(family) [font actual $font -family]
10181 set fontparam(size) $fontattr($font,size)
10182 set fontparam(weight) $fontattr($font,weight)
10183 set fontparam(slant) $fontattr($font,slant)
10186 if {![winfo exists $top]} {
10188 eval font config sample [font actual $font]
10190 make_transient $top $prefstop
10191 wm title $top [mc "Gitk font chooser"]
10192 label $top.l -textvariable fontparam(which)
10193 pack $top.l -side top
10194 set fontlist [lsort [font families]]
10196 listbox $top.f.fam -listvariable fontlist \
10197 -yscrollcommand [list $top.f.sb set]
10198 bind $top.f.fam <<ListboxSelect>> selfontfam
10199 scrollbar $top.f.sb -command [list $top.f.fam yview]
10200 pack $top.f.sb -side right -fill y
10201 pack $top.f.fam -side left -fill both -expand 1
10202 pack $top.f -side top -fill both -expand 1
10204 spinbox $top.g.size -from 4 -to 40 -width 4 \
10205 -textvariable fontparam(size) \
10206 -validatecommand {string is integer -strict %s}
10207 checkbutton $top.g.bold -padx 5 \
10208 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10209 -variable fontparam(weight) -onvalue bold -offvalue normal
10210 checkbutton $top.g.ital -padx 5 \
10211 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
10212 -variable fontparam(slant) -onvalue italic -offvalue roman
10213 pack $top.g.size $top.g.bold $top.g.ital -side left
10214 pack $top.g -side top
10215 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10217 $top.c create text 100 25 -anchor center -text $which -font sample \
10218 -fill black -tags text
10219 bind $top.c <Configure> [list centertext $top.c]
10220 pack $top.c -side top -fill x
10222 button $top.buts.ok -text [mc "OK"] -command fontok -default active
10223 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10224 bind $top <Key-Return> fontok
10225 bind $top <Key-Escape> fontcan
10226 grid $top.buts.ok $top.buts.can
10227 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10228 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10229 pack $top.buts -side bottom -fill x
10230 trace add variable fontparam write chg_fontparam
10233 $top.c itemconf text -text $which
10235 set i [lsearch -exact $fontlist $fontparam(family)]
10237 $top.f.fam selection set $i
10242 proc centertext {w} {
10243 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10247 global fontparam fontpref prefstop
10249 set f $fontparam(font)
10250 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10251 if {$fontparam(weight) eq "bold"} {
10252 lappend fontpref($f) "bold"
10254 if {$fontparam(slant) eq "italic"} {
10255 lappend fontpref($f) "italic"
10258 $w conf -text $fontparam(family) -font $fontpref($f)
10264 global fonttop fontparam
10266 if {[info exists fonttop]} {
10267 catch {destroy $fonttop}
10268 catch {font delete sample}
10274 proc selfontfam {} {
10275 global fonttop fontparam
10277 set i [$fonttop.f.fam curselection]
10279 set fontparam(family) [$fonttop.f.fam get $i]
10283 proc chg_fontparam {v sub op} {
10286 font config sample -$sub $fontparam($sub)
10290 global maxwidth maxgraphpct
10291 global oldprefs prefstop showneartags showlocalchanges
10292 global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10293 global tabstop limitdiffs autoselect extdifftool perfile_attrs
10297 if {[winfo exists $top]} {
10301 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10302 limitdiffs tabstop perfile_attrs} {
10303 set oldprefs($v) [set $v]
10306 wm title $top [mc "Gitk preferences"]
10307 make_transient $top .
10308 label $top.ldisp -text [mc "Commit list display options"]
10309 grid $top.ldisp - -sticky w -pady 10
10310 label $top.spacer -text " "
10311 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10313 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10314 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10315 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10317 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10318 grid x $top.maxpctl $top.maxpct -sticky w
10319 checkbutton $top.showlocal -text [mc "Show local changes"] \
10320 -font optionfont -variable showlocalchanges
10321 grid x $top.showlocal -sticky w
10322 checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10323 -font optionfont -variable autoselect
10324 grid x $top.autoselect -sticky w
10326 label $top.ddisp -text [mc "Diff display options"]
10327 grid $top.ddisp - -sticky w -pady 10
10328 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10329 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10330 grid x $top.tabstopl $top.tabstop -sticky w
10331 checkbutton $top.ntag -text [mc "Display nearby tags"] \
10332 -font optionfont -variable showneartags
10333 grid x $top.ntag -sticky w
10334 checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10335 -font optionfont -variable limitdiffs
10336 grid x $top.ldiff -sticky w
10337 checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10338 -font optionfont -variable perfile_attrs
10339 grid x $top.lattr -sticky w
10341 entry $top.extdifft -textvariable extdifftool
10342 frame $top.extdifff
10343 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10345 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10346 -command choose_extdiff
10347 pack $top.extdifff.l $top.extdifff.b -side left
10348 grid x $top.extdifff $top.extdifft -sticky w
10350 label $top.cdisp -text [mc "Colors: press to choose"]
10351 grid $top.cdisp - -sticky w -pady 10
10352 label $top.bg -padx 40 -relief sunk -background $bgcolor
10353 button $top.bgbut -text [mc "Background"] -font optionfont \
10354 -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10355 grid x $top.bgbut $top.bg -sticky w
10356 label $top.fg -padx 40 -relief sunk -background $fgcolor
10357 button $top.fgbut -text [mc "Foreground"] -font optionfont \
10358 -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10359 grid x $top.fgbut $top.fg -sticky w
10360 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10361 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10362 -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10363 [list $ctext tag conf d0 -foreground]]
10364 grid x $top.diffoldbut $top.diffold -sticky w
10365 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10366 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10367 -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10368 [list $ctext tag conf dresult -foreground]]
10369 grid x $top.diffnewbut $top.diffnew -sticky w
10370 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10371 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10372 -command [list choosecolor diffcolors 2 $top.hunksep \
10373 [mc "diff hunk header"] \
10374 [list $ctext tag conf hunksep -foreground]]
10375 grid x $top.hunksepbut $top.hunksep -sticky w
10376 label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10377 button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10378 -command [list choosecolor markbgcolor {} $top.markbgsep \
10379 [mc "marked line background"] \
10380 [list $ctext tag conf omark -background]]
10381 grid x $top.markbgbut $top.markbgsep -sticky w
10382 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10383 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10384 -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10385 grid x $top.selbgbut $top.selbgsep -sticky w
10387 label $top.cfont -text [mc "Fonts: press to choose"]
10388 grid $top.cfont - -sticky w -pady 10
10389 mkfontdisp mainfont $top [mc "Main font"]
10390 mkfontdisp textfont $top [mc "Diff display font"]
10391 mkfontdisp uifont $top [mc "User interface font"]
10394 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10395 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10396 bind $top <Key-Return> prefsok
10397 bind $top <Key-Escape> prefscan
10398 grid $top.buts.ok $top.buts.can
10399 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10400 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10401 grid $top.buts - - -pady 10 -sticky ew
10402 bind $top <Visibility> "focus $top.buts.ok"
10405 proc choose_extdiff {} {
10408 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10410 set extdifftool $prog
10414 proc choosecolor {v vi w x cmd} {
10417 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10418 -title [mc "Gitk: choose color for %s" $x]]
10419 if {$c eq {}} return
10420 $w conf -background $c
10425 proc setselbg {c} {
10426 global bglist cflist
10427 foreach w $bglist {
10428 $w configure -selectbackground $c
10430 $cflist tag configure highlight \
10431 -background [$cflist cget -selectbackground]
10432 allcanvs itemconf secsel -fill $c
10438 foreach w $bglist {
10439 $w conf -background $c
10446 foreach w $fglist {
10447 $w conf -foreground $c
10449 allcanvs itemconf text -fill $c
10450 $canv itemconf circle -outline $c
10451 $canv itemconf markid -outline $c
10455 global oldprefs prefstop
10457 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10458 limitdiffs tabstop perfile_attrs} {
10460 set $v $oldprefs($v)
10462 catch {destroy $prefstop}
10468 global maxwidth maxgraphpct
10469 global oldprefs prefstop showneartags showlocalchanges
10470 global fontpref mainfont textfont uifont
10471 global limitdiffs treediffs perfile_attrs
10473 catch {destroy $prefstop}
10477 if {$mainfont ne $fontpref(mainfont)} {
10478 set mainfont $fontpref(mainfont)
10479 parsefont mainfont $mainfont
10480 eval font configure mainfont [fontflags mainfont]
10481 eval font configure mainfontbold [fontflags mainfont 1]
10485 if {$textfont ne $fontpref(textfont)} {
10486 set textfont $fontpref(textfont)
10487 parsefont textfont $textfont
10488 eval font configure textfont [fontflags textfont]
10489 eval font configure textfontbold [fontflags textfont 1]
10491 if {$uifont ne $fontpref(uifont)} {
10492 set uifont $fontpref(uifont)
10493 parsefont uifont $uifont
10494 eval font configure uifont [fontflags uifont]
10497 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10498 if {$showlocalchanges} {
10504 if {$limitdiffs != $oldprefs(limitdiffs) ||
10505 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10506 # treediffs elements are limited by path;
10507 # won't have encodings cached if perfile_attrs was just turned on
10508 catch {unset treediffs}
10510 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10511 || $maxgraphpct != $oldprefs(maxgraphpct)} {
10513 } elseif {$showneartags != $oldprefs(showneartags) ||
10514 $limitdiffs != $oldprefs(limitdiffs)} {
10519 proc formatdate {d} {
10520 global datetimeformat
10522 set d [clock format $d -format $datetimeformat]
10527 # This list of encoding names and aliases is distilled from
10528 # http://www.iana.org/assignments/character-sets.
10529 # Not all of them are supported by Tcl.
10530 set encoding_aliases {
10531 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10532 ISO646-US US-ASCII us IBM367 cp367 csASCII }
10533 { ISO-10646-UTF-1 csISO10646UTF1 }
10534 { ISO_646.basic:1983 ref csISO646basic1983 }
10535 { INVARIANT csINVARIANT }
10536 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10537 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10538 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10539 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10540 { NATS-DANO iso-ir-9-1 csNATSDANO }
10541 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10542 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10543 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10544 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10545 { ISO-2022-KR csISO2022KR }
10547 { ISO-2022-JP csISO2022JP }
10548 { ISO-2022-JP-2 csISO2022JP2 }
10549 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10550 csISO13JISC6220jp }
10551 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10552 { IT iso-ir-15 ISO646-IT csISO15Italian }
10553 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10554 { ES iso-ir-17 ISO646-ES csISO17Spanish }
10555 { greek7-old iso-ir-18 csISO18Greek7Old }
10556 { latin-greek iso-ir-19 csISO19LatinGreek }
10557 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10558 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10559 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10560 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10561 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10562 { BS_viewdata iso-ir-47 csISO47BSViewdata }
10563 { INIS iso-ir-49 csISO49INIS }
10564 { INIS-8 iso-ir-50 csISO50INIS8 }
10565 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10566 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10567 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10568 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10569 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10570 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10571 csISO60Norwegian1 }
10572 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10573 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10574 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10575 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10576 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10577 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10578 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10579 { greek7 iso-ir-88 csISO88Greek7 }
10580 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10581 { iso-ir-90 csISO90 }
10582 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10583 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10584 csISO92JISC62991984b }
10585 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10586 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10587 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10588 csISO95JIS62291984handadd }
10589 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10590 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10591 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10592 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10593 CP819 csISOLatin1 }
10594 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10595 { T.61-7bit iso-ir-102 csISO102T617bit }
10596 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10597 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10598 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10599 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10600 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10601 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10602 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10603 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10604 arabic csISOLatinArabic }
10605 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10606 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10607 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10608 greek greek8 csISOLatinGreek }
10609 { T.101-G2 iso-ir-128 csISO128T101G2 }
10610 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10612 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10613 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10614 { CSN_369103 iso-ir-139 csISO139CSN369103 }
10615 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10616 { ISO_6937-2-add iso-ir-142 csISOTextComm }
10617 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10618 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10619 csISOLatinCyrillic }
10620 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10621 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10622 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10623 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10624 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10625 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10626 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10627 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10628 { ISO_10367-box iso-ir-155 csISO10367Box }
10629 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10630 { latin-lap lap iso-ir-158 csISO158Lap }
10631 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10632 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10635 { JIS_X0201 X0201 csHalfWidthKatakana }
10636 { KSC5636 ISO646-KR csKSC5636 }
10637 { ISO-10646-UCS-2 csUnicode }
10638 { ISO-10646-UCS-4 csUCS4 }
10639 { DEC-MCS dec csDECMCS }
10640 { hp-roman8 roman8 r8 csHPRoman8 }
10641 { macintosh mac csMacintosh }
10642 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10644 { IBM038 EBCDIC-INT cp038 csIBM038 }
10645 { IBM273 CP273 csIBM273 }
10646 { IBM274 EBCDIC-BE CP274 csIBM274 }
10647 { IBM275 EBCDIC-BR cp275 csIBM275 }
10648 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10649 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10650 { IBM280 CP280 ebcdic-cp-it csIBM280 }
10651 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10652 { IBM284 CP284 ebcdic-cp-es csIBM284 }
10653 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10654 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10655 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10656 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10657 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10658 { IBM424 cp424 ebcdic-cp-he csIBM424 }
10659 { IBM437 cp437 437 csPC8CodePage437 }
10660 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10661 { IBM775 cp775 csPC775Baltic }
10662 { IBM850 cp850 850 csPC850Multilingual }
10663 { IBM851 cp851 851 csIBM851 }
10664 { IBM852 cp852 852 csPCp852 }
10665 { IBM855 cp855 855 csIBM855 }
10666 { IBM857 cp857 857 csIBM857 }
10667 { IBM860 cp860 860 csIBM860 }
10668 { IBM861 cp861 861 cp-is csIBM861 }
10669 { IBM862 cp862 862 csPC862LatinHebrew }
10670 { IBM863 cp863 863 csIBM863 }
10671 { IBM864 cp864 csIBM864 }
10672 { IBM865 cp865 865 csIBM865 }
10673 { IBM866 cp866 866 csIBM866 }
10674 { IBM868 CP868 cp-ar csIBM868 }
10675 { IBM869 cp869 869 cp-gr csIBM869 }
10676 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10677 { IBM871 CP871 ebcdic-cp-is csIBM871 }
10678 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10679 { IBM891 cp891 csIBM891 }
10680 { IBM903 cp903 csIBM903 }
10681 { IBM904 cp904 904 csIBBM904 }
10682 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10683 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10684 { IBM1026 CP1026 csIBM1026 }
10685 { EBCDIC-AT-DE csIBMEBCDICATDE }
10686 { EBCDIC-AT-DE-A csEBCDICATDEA }
10687 { EBCDIC-CA-FR csEBCDICCAFR }
10688 { EBCDIC-DK-NO csEBCDICDKNO }
10689 { EBCDIC-DK-NO-A csEBCDICDKNOA }
10690 { EBCDIC-FI-SE csEBCDICFISE }
10691 { EBCDIC-FI-SE-A csEBCDICFISEA }
10692 { EBCDIC-FR csEBCDICFR }
10693 { EBCDIC-IT csEBCDICIT }
10694 { EBCDIC-PT csEBCDICPT }
10695 { EBCDIC-ES csEBCDICES }
10696 { EBCDIC-ES-A csEBCDICESA }
10697 { EBCDIC-ES-S csEBCDICESS }
10698 { EBCDIC-UK csEBCDICUK }
10699 { EBCDIC-US csEBCDICUS }
10700 { UNKNOWN-8BIT csUnknown8BiT }
10701 { MNEMONIC csMnemonic }
10703 { VISCII csVISCII }
10706 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10707 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10708 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10709 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10710 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10711 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10712 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10713 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10714 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10715 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10716 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10717 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10718 { IBM1047 IBM-1047 }
10719 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10720 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10721 { UNICODE-1-1 csUnicode11 }
10722 { CESU-8 csCESU-8 }
10723 { BOCU-1 csBOCU-1 }
10724 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10725 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10727 { ISO-8859-15 ISO_8859-15 Latin-9 }
10728 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10729 { GBK CP936 MS936 windows-936 }
10730 { JIS_Encoding csJISEncoding }
10731 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10732 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10734 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10735 { ISO-10646-UCS-Basic csUnicodeASCII }
10736 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10737 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10738 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10739 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10740 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10741 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10742 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10743 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10744 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10745 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10746 { Adobe-Standard-Encoding csAdobeStandardEncoding }
10747 { Ventura-US csVenturaUS }
10748 { Ventura-International csVenturaInternational }
10749 { PC8-Danish-Norwegian csPC8DanishNorwegian }
10750 { PC8-Turkish csPC8Turkish }
10751 { IBM-Symbols csIBMSymbols }
10752 { IBM-Thai csIBMThai }
10753 { HP-Legal csHPLegal }
10754 { HP-Pi-font csHPPiFont }
10755 { HP-Math8 csHPMath8 }
10756 { Adobe-Symbol-Encoding csHPPSMath }
10757 { HP-DeskTop csHPDesktop }
10758 { Ventura-Math csVenturaMath }
10759 { Microsoft-Publishing csMicrosoftPublishing }
10760 { Windows-31J csWindows31J }
10761 { GB2312 csGB2312 }
10765 proc tcl_encoding {enc} {
10766 global encoding_aliases tcl_encoding_cache
10767 if {[info exists tcl_encoding_cache($enc)]} {
10768 return $tcl_encoding_cache($enc)
10770 set names [encoding names]
10771 set lcnames [string tolower $names]
10772 set enc [string tolower $enc]
10773 set i [lsearch -exact $lcnames $enc]
10775 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10776 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10777 set i [lsearch -exact $lcnames $encx]
10781 foreach l $encoding_aliases {
10782 set ll [string tolower $l]
10783 if {[lsearch -exact $ll $enc] < 0} continue
10784 # look through the aliases for one that tcl knows about
10786 set i [lsearch -exact $lcnames $e]
10788 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10789 set i [lsearch -exact $lcnames $ex]
10799 set tclenc [lindex $names $i]
10801 set tcl_encoding_cache($enc) $tclenc
10805 proc gitattr {path attr default} {
10806 global path_attr_cache
10807 if {[info exists path_attr_cache($attr,$path)]} {
10808 set r $path_attr_cache($attr,$path)
10810 set r "unspecified"
10811 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10812 regexp "(.*): encoding: (.*)" $line m f r
10814 set path_attr_cache($attr,$path) $r
10816 if {$r eq "unspecified"} {
10822 proc cache_gitattr {attr pathlist} {
10823 global path_attr_cache
10825 foreach path $pathlist {
10826 if {![info exists path_attr_cache($attr,$path)]} {
10827 lappend newlist $path
10831 if {[tk windowingsystem] == "win32"} {
10832 # windows has a 32k limit on the arguments to a command...
10835 while {$newlist ne {}} {
10836 set head [lrange $newlist 0 [expr {$lim - 1}]]
10837 set newlist [lrange $newlist $lim end]
10838 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10839 foreach row [split $rlist "\n"] {
10840 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10841 if {[string index $path 0] eq "\""} {
10842 set path [encoding convertfrom [lindex $path 0]]
10844 set path_attr_cache($attr,$path) $value
10851 proc get_path_encoding {path} {
10852 global gui_encoding perfile_attrs
10853 set tcl_enc $gui_encoding
10854 if {$path ne {} && $perfile_attrs} {
10855 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10863 # First check that Tcl/Tk is recent enough
10864 if {[catch {package require Tk 8.4} err]} {
10865 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10866 Gitk requires at least Tcl/Tk 8.4."]
10871 set wrcomcmd "git diff-tree --stdin -p --pretty"
10875 set gitencoding [exec git config --get i18n.commitencoding]
10878 set gitencoding [exec git config --get i18n.logoutputencoding]
10880 if {$gitencoding == ""} {
10881 set gitencoding "utf-8"
10883 set tclencoding [tcl_encoding $gitencoding]
10884 if {$tclencoding == {}} {
10885 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10888 set gui_encoding [encoding system]
10890 set enc [exec git config --get gui.encoding]
10892 set tclenc [tcl_encoding $enc]
10893 if {$tclenc ne {}} {
10894 set gui_encoding $tclenc
10896 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10901 if {[tk windowingsystem] eq "aqua"} {
10902 set mainfont {{Lucida Grande} 9}
10903 set textfont {Monaco 9}
10904 set uifont {{Lucida Grande} 9 bold}
10906 set mainfont {Helvetica 9}
10907 set textfont {Courier 9}
10908 set uifont {Helvetica 9 bold}
10911 set findmergefiles 0
10919 set cmitmode "patch"
10920 set wrapcomment "none"
10924 set showlocalchanges 1
10926 set datetimeformat "%Y-%m-%d %H:%M:%S"
10928 set perfile_attrs 0
10930 if {[tk windowingsystem] eq "aqua"} {
10931 set extdifftool "opendiff"
10933 set extdifftool "meld"
10936 set colors {green red blue magenta darkgrey brown orange}
10939 set diffcolors {red "#00a000" blue}
10942 set selectbgcolor gray85
10943 set markbgcolor "#e0e0ff"
10945 set circlecolors {white blue gray blue blue}
10947 # button for popping up context menus
10948 if {[tk windowingsystem] eq "aqua"} {
10949 set ctxbut <Button-2>
10951 set ctxbut <Button-3>
10954 ## For msgcat loading, first locate the installation location.
10955 if { [info exists ::env(GITK_MSGSDIR)] } {
10956 ## Msgsdir was manually set in the environment.
10957 set gitk_msgsdir $::env(GITK_MSGSDIR)
10959 ## Let's guess the prefix from argv0.
10960 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10961 set gitk_libdir [file join $gitk_prefix share gitk lib]
10962 set gitk_msgsdir [file join $gitk_libdir msgs]
10966 ## Internationalization (i18n) through msgcat and gettext. See
10967 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10968 package require msgcat
10969 namespace import ::msgcat::mc
10970 ## And eventually load the actual message catalog
10971 ::msgcat::mcload $gitk_msgsdir
10973 catch {source ~/.gitk}
10975 font create optionfont -family sans-serif -size -12
10977 parsefont mainfont $mainfont
10978 eval font create mainfont [fontflags mainfont]
10979 eval font create mainfontbold [fontflags mainfont 1]
10981 parsefont textfont $textfont
10982 eval font create textfont [fontflags textfont]
10983 eval font create textfontbold [fontflags textfont 1]
10985 parsefont uifont $uifont
10986 eval font create uifont [fontflags uifont]
10990 # check that we can find a .git directory somewhere...
10991 if {[catch {set gitdir [gitdir]}]} {
10992 show_error {} . [mc "Cannot find a git repository here."]
10995 if {![file isdirectory $gitdir]} {
10996 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
11001 set selectheadid {}
11004 set cmdline_files {}
11006 set revtreeargscmd {}
11007 foreach arg $argv {
11008 switch -glob -- $arg {
11011 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11014 "--select-commit=*" {
11015 set selecthead [string range $arg 16 end]
11018 set revtreeargscmd [string range $arg 10 end]
11021 lappend revtreeargs $arg
11027 if {$selecthead eq "HEAD"} {
11031 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11032 # no -- on command line, but some arguments (other than --argscmd)
11034 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11035 set cmdline_files [split $f "\n"]
11036 set n [llength $cmdline_files]
11037 set revtreeargs [lrange $revtreeargs 0 end-$n]
11038 # Unfortunately git rev-parse doesn't produce an error when
11039 # something is both a revision and a filename. To be consistent
11040 # with git log and git rev-list, check revtreeargs for filenames.
11041 foreach arg $revtreeargs {
11042 if {[file exists $arg]} {
11043 show_error {} . [mc "Ambiguous argument '%s': both revision\
11044 and filename" $arg]
11049 # unfortunately we get both stdout and stderr in $err,
11050 # so look for "fatal:".
11051 set i [string first "fatal:" $err]
11053 set err [string range $err [expr {$i + 6}] end]
11055 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11060 set nullid "0000000000000000000000000000000000000000"
11061 set nullid2 "0000000000000000000000000000000000000001"
11062 set nullfile "/dev/null"
11064 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11071 set highlight_paths {}
11073 set searchdirn -forwards
11076 set diffelide {0 0}
11077 set markingmatches 0
11078 set linkentercount 0
11079 set need_redisplay 0
11086 set selectedhlview [mc "None"]
11087 set highlight_related [mc "None"]
11088 set highlight_files {}
11089 set viewfiles(0) {}
11092 set viewargscmd(0) {}
11094 set selectedline {}
11102 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11106 image create photo gitlogo -width 16 -height 16
11108 image create photo gitlogominus -width 4 -height 2
11109 gitlogominus put #C00000 -to 0 0 4 2
11110 gitlogo copy gitlogominus -to 1 5
11111 gitlogo copy gitlogominus -to 6 5
11112 gitlogo copy gitlogominus -to 11 5
11113 image delete gitlogominus
11115 image create photo gitlogoplus -width 4 -height 4
11116 gitlogoplus put #008000 -to 1 0 3 4
11117 gitlogoplus put #008000 -to 0 1 4 3
11118 gitlogo copy gitlogoplus -to 1 9
11119 gitlogo copy gitlogoplus -to 6 9
11120 gitlogo copy gitlogoplus -to 11 9
11121 image delete gitlogoplus
11123 image create photo gitlogo32 -width 32 -height 32
11124 gitlogo32 copy gitlogo -zoom 2 2
11126 wm iconphoto . -default gitlogo gitlogo32
11128 # wait for the window to become visible
11129 tkwait visibility .
11130 wm title . "[file tail $argv0]: [file tail [pwd]]"
11133 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11134 # create a view for the files/dirs specified on the command line
11138 set viewname(1) [mc "Command line"]
11139 set viewfiles(1) $cmdline_files
11140 set viewargs(1) $revtreeargs
11141 set viewargscmd(1) $revtreeargscmd
11145 .bar.view entryconf [mca "Edit view..."] -state normal
11146 .bar.view entryconf [mca "Delete view"] -state normal
11149 if {[info exists permviews]} {
11150 foreach v $permviews {
11153 set viewname($n) [lindex $v 0]
11154 set viewfiles($n) [lindex $v 1]
11155 set viewargs($n) [lindex $v 2]
11156 set viewargscmd($n) [lindex $v 3]
11162 if {[tk windowingsystem] eq "win32"} {