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 catch {file delete "~/.gitk"}
2572 file rename -force "~/.gitk-new" "~/.gitk"
2577 proc resizeclistpanes {win w} {
2579 if {[info exists oldwidth($win)]} {
2580 set s0 [$win sash coord 0]
2581 set s1 [$win sash coord 1]
2583 set sash0 [expr {int($w/2 - 2)}]
2584 set sash1 [expr {int($w*5/6 - 2)}]
2586 set factor [expr {1.0 * $w / $oldwidth($win)}]
2587 set sash0 [expr {int($factor * [lindex $s0 0])}]
2588 set sash1 [expr {int($factor * [lindex $s1 0])}]
2592 if {$sash1 < $sash0 + 20} {
2593 set sash1 [expr {$sash0 + 20}]
2595 if {$sash1 > $w - 10} {
2596 set sash1 [expr {$w - 10}]
2597 if {$sash0 > $sash1 - 20} {
2598 set sash0 [expr {$sash1 - 20}]
2602 $win sash place 0 $sash0 [lindex $s0 1]
2603 $win sash place 1 $sash1 [lindex $s1 1]
2605 set oldwidth($win) $w
2608 proc resizecdetpanes {win w} {
2610 if {[info exists oldwidth($win)]} {
2611 set s0 [$win sash coord 0]
2613 set sash0 [expr {int($w*3/4 - 2)}]
2615 set factor [expr {1.0 * $w / $oldwidth($win)}]
2616 set sash0 [expr {int($factor * [lindex $s0 0])}]
2620 if {$sash0 > $w - 15} {
2621 set sash0 [expr {$w - 15}]
2624 $win sash place 0 $sash0 [lindex $s0 1]
2626 set oldwidth($win) $w
2629 proc allcanvs args {
2630 global canv canv2 canv3
2636 proc bindall {event action} {
2637 global canv canv2 canv3
2638 bind $canv $event $action
2639 bind $canv2 $event $action
2640 bind $canv3 $event $action
2646 if {[winfo exists $w]} {
2651 wm title $w [mc "About gitk"]
2653 message $w.m -text [mc "
2654 Gitk - a commit viewer for git
2656 Copyright © 2005-2008 Paul Mackerras
2658 Use and redistribute under the terms of the GNU General Public License"] \
2659 -justify center -aspect 400 -border 2 -bg white -relief groove
2660 pack $w.m -side top -fill x -padx 2 -pady 2
2661 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2662 pack $w.ok -side bottom
2663 bind $w <Visibility> "focus $w.ok"
2664 bind $w <Key-Escape> "destroy $w"
2665 bind $w <Key-Return> "destroy $w"
2670 if {[winfo exists $w]} {
2674 if {[tk windowingsystem] eq {aqua}} {
2680 wm title $w [mc "Gitk key bindings"]
2682 message $w.m -text "
2683 [mc "Gitk key bindings:"]
2685 [mc "<%s-Q> Quit" $M1T]
2686 [mc "<Home> Move to first commit"]
2687 [mc "<End> Move to last commit"]
2688 [mc "<Up>, p, i Move up one commit"]
2689 [mc "<Down>, n, k Move down one commit"]
2690 [mc "<Left>, z, j Go back in history list"]
2691 [mc "<Right>, x, l Go forward in history list"]
2692 [mc "<PageUp> Move up one page in commit list"]
2693 [mc "<PageDown> Move down one page in commit list"]
2694 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2695 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2696 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2697 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2698 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2699 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2700 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2701 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2702 [mc "<Delete>, b Scroll diff view up one page"]
2703 [mc "<Backspace> Scroll diff view up one page"]
2704 [mc "<Space> Scroll diff view down one page"]
2705 [mc "u Scroll diff view up 18 lines"]
2706 [mc "d Scroll diff view down 18 lines"]
2707 [mc "<%s-F> Find" $M1T]
2708 [mc "<%s-G> Move to next find hit" $M1T]
2709 [mc "<Return> Move to next find hit"]
2710 [mc "/ Focus the search box"]
2711 [mc "? Move to previous find hit"]
2712 [mc "f Scroll diff view to next file"]
2713 [mc "<%s-S> Search for next hit in diff view" $M1T]
2714 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2715 [mc "<%s-KP+> Increase font size" $M1T]
2716 [mc "<%s-plus> Increase font size" $M1T]
2717 [mc "<%s-KP-> Decrease font size" $M1T]
2718 [mc "<%s-minus> Decrease font size" $M1T]
2721 -justify left -bg white -border 2 -relief groove
2722 pack $w.m -side top -fill both -padx 2 -pady 2
2723 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2724 bind $w <Key-Escape> [list destroy $w]
2725 pack $w.ok -side bottom
2726 bind $w <Visibility> "focus $w.ok"
2727 bind $w <Key-Escape> "destroy $w"
2728 bind $w <Key-Return> "destroy $w"
2731 # Procedures for manipulating the file list window at the
2732 # bottom right of the overall window.
2734 proc treeview {w l openlevs} {
2735 global treecontents treediropen treeheight treeparent treeindex
2745 set treecontents() {}
2746 $w conf -state normal
2748 while {[string range $f 0 $prefixend] ne $prefix} {
2749 if {$lev <= $openlevs} {
2750 $w mark set e:$treeindex($prefix) "end -1c"
2751 $w mark gravity e:$treeindex($prefix) left
2753 set treeheight($prefix) $ht
2754 incr ht [lindex $htstack end]
2755 set htstack [lreplace $htstack end end]
2756 set prefixend [lindex $prefendstack end]
2757 set prefendstack [lreplace $prefendstack end end]
2758 set prefix [string range $prefix 0 $prefixend]
2761 set tail [string range $f [expr {$prefixend+1}] end]
2762 while {[set slash [string first "/" $tail]] >= 0} {
2765 lappend prefendstack $prefixend
2766 incr prefixend [expr {$slash + 1}]
2767 set d [string range $tail 0 $slash]
2768 lappend treecontents($prefix) $d
2769 set oldprefix $prefix
2771 set treecontents($prefix) {}
2772 set treeindex($prefix) [incr ix]
2773 set treeparent($prefix) $oldprefix
2774 set tail [string range $tail [expr {$slash+1}] end]
2775 if {$lev <= $openlevs} {
2777 set treediropen($prefix) [expr {$lev < $openlevs}]
2778 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2779 $w mark set d:$ix "end -1c"
2780 $w mark gravity d:$ix left
2782 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2784 $w image create end -align center -image $bm -padx 1 \
2786 $w insert end $d [highlight_tag $prefix]
2787 $w mark set s:$ix "end -1c"
2788 $w mark gravity s:$ix left
2793 if {$lev <= $openlevs} {
2796 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2798 $w insert end $tail [highlight_tag $f]
2800 lappend treecontents($prefix) $tail
2803 while {$htstack ne {}} {
2804 set treeheight($prefix) $ht
2805 incr ht [lindex $htstack end]
2806 set htstack [lreplace $htstack end end]
2807 set prefixend [lindex $prefendstack end]
2808 set prefendstack [lreplace $prefendstack end end]
2809 set prefix [string range $prefix 0 $prefixend]
2811 $w conf -state disabled
2814 proc linetoelt {l} {
2815 global treeheight treecontents
2820 foreach e $treecontents($prefix) {
2825 if {[string index $e end] eq "/"} {
2826 set n $treeheight($prefix$e)
2838 proc highlight_tree {y prefix} {
2839 global treeheight treecontents cflist
2841 foreach e $treecontents($prefix) {
2843 if {[highlight_tag $path] ne {}} {
2844 $cflist tag add bold $y.0 "$y.0 lineend"
2847 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2848 set y [highlight_tree $y $path]
2854 proc treeclosedir {w dir} {
2855 global treediropen treeheight treeparent treeindex
2857 set ix $treeindex($dir)
2858 $w conf -state normal
2859 $w delete s:$ix e:$ix
2860 set treediropen($dir) 0
2861 $w image configure a:$ix -image tri-rt
2862 $w conf -state disabled
2863 set n [expr {1 - $treeheight($dir)}]
2864 while {$dir ne {}} {
2865 incr treeheight($dir) $n
2866 set dir $treeparent($dir)
2870 proc treeopendir {w dir} {
2871 global treediropen treeheight treeparent treecontents treeindex
2873 set ix $treeindex($dir)
2874 $w conf -state normal
2875 $w image configure a:$ix -image tri-dn
2876 $w mark set e:$ix s:$ix
2877 $w mark gravity e:$ix right
2880 set n [llength $treecontents($dir)]
2881 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2884 incr treeheight($x) $n
2886 foreach e $treecontents($dir) {
2888 if {[string index $e end] eq "/"} {
2889 set iy $treeindex($de)
2890 $w mark set d:$iy e:$ix
2891 $w mark gravity d:$iy left
2892 $w insert e:$ix $str
2893 set treediropen($de) 0
2894 $w image create e:$ix -align center -image tri-rt -padx 1 \
2896 $w insert e:$ix $e [highlight_tag $de]
2897 $w mark set s:$iy e:$ix
2898 $w mark gravity s:$iy left
2899 set treeheight($de) 1
2901 $w insert e:$ix $str
2902 $w insert e:$ix $e [highlight_tag $de]
2905 $w mark gravity e:$ix right
2906 $w conf -state disabled
2907 set treediropen($dir) 1
2908 set top [lindex [split [$w index @0,0] .] 0]
2909 set ht [$w cget -height]
2910 set l [lindex [split [$w index s:$ix] .] 0]
2913 } elseif {$l + $n + 1 > $top + $ht} {
2914 set top [expr {$l + $n + 2 - $ht}]
2922 proc treeclick {w x y} {
2923 global treediropen cmitmode ctext cflist cflist_top
2925 if {$cmitmode ne "tree"} return
2926 if {![info exists cflist_top]} return
2927 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2928 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2929 $cflist tag add highlight $l.0 "$l.0 lineend"
2935 set e [linetoelt $l]
2936 if {[string index $e end] ne "/"} {
2938 } elseif {$treediropen($e)} {
2945 proc setfilelist {id} {
2946 global treefilelist cflist jump_to_here
2948 treeview $cflist $treefilelist($id) 0
2949 if {$jump_to_here ne {}} {
2950 set f [lindex $jump_to_here 0]
2951 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
2957 image create bitmap tri-rt -background black -foreground blue -data {
2958 #define tri-rt_width 13
2959 #define tri-rt_height 13
2960 static unsigned char tri-rt_bits[] = {
2961 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2962 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2965 #define tri-rt-mask_width 13
2966 #define tri-rt-mask_height 13
2967 static unsigned char tri-rt-mask_bits[] = {
2968 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2969 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2972 image create bitmap tri-dn -background black -foreground blue -data {
2973 #define tri-dn_width 13
2974 #define tri-dn_height 13
2975 static unsigned char tri-dn_bits[] = {
2976 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2977 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2980 #define tri-dn-mask_width 13
2981 #define tri-dn-mask_height 13
2982 static unsigned char tri-dn-mask_bits[] = {
2983 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2984 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2988 image create bitmap reficon-T -background black -foreground yellow -data {
2989 #define tagicon_width 13
2990 #define tagicon_height 9
2991 static unsigned char tagicon_bits[] = {
2992 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2993 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2995 #define tagicon-mask_width 13
2996 #define tagicon-mask_height 9
2997 static unsigned char tagicon-mask_bits[] = {
2998 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2999 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3002 #define headicon_width 13
3003 #define headicon_height 9
3004 static unsigned char headicon_bits[] = {
3005 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3006 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3009 #define headicon-mask_width 13
3010 #define headicon-mask_height 9
3011 static unsigned char headicon-mask_bits[] = {
3012 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3013 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3015 image create bitmap reficon-H -background black -foreground green \
3016 -data $rectdata -maskdata $rectmask
3017 image create bitmap reficon-o -background black -foreground "#ddddff" \
3018 -data $rectdata -maskdata $rectmask
3020 proc init_flist {first} {
3021 global cflist cflist_top difffilestart
3023 $cflist conf -state normal
3024 $cflist delete 0.0 end
3026 $cflist insert end $first
3028 $cflist tag add highlight 1.0 "1.0 lineend"
3030 catch {unset cflist_top}
3032 $cflist conf -state disabled
3033 set difffilestart {}
3036 proc highlight_tag {f} {
3037 global highlight_paths
3039 foreach p $highlight_paths {
3040 if {[string match $p $f]} {
3047 proc highlight_filelist {} {
3048 global cmitmode cflist
3050 $cflist conf -state normal
3051 if {$cmitmode ne "tree"} {
3052 set end [lindex [split [$cflist index end] .] 0]
3053 for {set l 2} {$l < $end} {incr l} {
3054 set line [$cflist get $l.0 "$l.0 lineend"]
3055 if {[highlight_tag $line] ne {}} {
3056 $cflist tag add bold $l.0 "$l.0 lineend"
3062 $cflist conf -state disabled
3065 proc unhighlight_filelist {} {
3068 $cflist conf -state normal
3069 $cflist tag remove bold 1.0 end
3070 $cflist conf -state disabled
3073 proc add_flist {fl} {
3076 $cflist conf -state normal
3078 $cflist insert end "\n"
3079 $cflist insert end $f [highlight_tag $f]
3081 $cflist conf -state disabled
3084 proc sel_flist {w x y} {
3085 global ctext difffilestart cflist cflist_top cmitmode
3087 if {$cmitmode eq "tree"} return
3088 if {![info exists cflist_top]} return
3089 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3090 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3091 $cflist tag add highlight $l.0 "$l.0 lineend"
3096 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3100 proc pop_flist_menu {w X Y x y} {
3101 global ctext cflist cmitmode flist_menu flist_menu_file
3102 global treediffs diffids
3105 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3107 if {$cmitmode eq "tree"} {
3108 set e [linetoelt $l]
3109 if {[string index $e end] eq "/"} return
3111 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3113 set flist_menu_file $e
3114 set xdiffstate "normal"
3115 if {$cmitmode eq "tree"} {
3116 set xdiffstate "disabled"
3118 # Disable "External diff" item in tree mode
3119 $flist_menu entryconf 2 -state $xdiffstate
3120 tk_popup $flist_menu $X $Y
3123 proc find_ctext_fileinfo {line} {
3124 global ctext_file_names ctext_file_lines
3126 set ok [bsearch $ctext_file_lines $line]
3127 set tline [lindex $ctext_file_lines $ok]
3129 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3132 return [list [lindex $ctext_file_names $ok] $tline]
3136 proc pop_diff_menu {w X Y x y} {
3137 global ctext diff_menu flist_menu_file
3138 global diff_menu_txtpos diff_menu_line
3139 global diff_menu_filebase
3141 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3142 set diff_menu_line [lindex $diff_menu_txtpos 0]
3143 # don't pop up the menu on hunk-separator or file-separator lines
3144 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3148 set f [find_ctext_fileinfo $diff_menu_line]
3149 if {$f eq {}} return
3150 set flist_menu_file [lindex $f 0]
3151 set diff_menu_filebase [lindex $f 1]
3152 tk_popup $diff_menu $X $Y
3155 proc flist_hl {only} {
3156 global flist_menu_file findstring gdttype
3158 set x [shellquote $flist_menu_file]
3159 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3162 append findstring " " $x
3164 set gdttype [mc "touching paths:"]
3167 proc save_file_from_commit {filename output what} {
3170 if {[catch {exec git show $filename -- > $output} err]} {
3171 if {[string match "fatal: bad revision *" $err]} {
3174 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3180 proc external_diff_get_one_file {diffid filename diffdir} {
3181 global nullid nullid2 nullfile
3184 if {$diffid == $nullid} {
3185 set difffile [file join [file dirname $gitdir] $filename]
3186 if {[file exists $difffile]} {
3191 if {$diffid == $nullid2} {
3192 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3193 return [save_file_from_commit :$filename $difffile index]
3195 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3196 return [save_file_from_commit $diffid:$filename $difffile \
3200 proc external_diff {} {
3201 global gitktmpdir nullid nullid2
3202 global flist_menu_file
3205 global gitdir extdifftool
3207 if {[llength $diffids] == 1} {
3208 # no reference commit given
3209 set diffidto [lindex $diffids 0]
3210 if {$diffidto eq $nullid} {
3211 # diffing working copy with index
3212 set diffidfrom $nullid2
3213 } elseif {$diffidto eq $nullid2} {
3214 # diffing index with HEAD
3215 set diffidfrom "HEAD"
3217 # use first parent commit
3218 global parentlist selectedline
3219 set diffidfrom [lindex $parentlist $selectedline 0]
3222 set diffidfrom [lindex $diffids 0]
3223 set diffidto [lindex $diffids 1]
3226 # make sure that several diffs wont collide
3227 if {![info exists gitktmpdir]} {
3228 set gitktmpdir [file join [file dirname $gitdir] \
3229 [format ".gitk-tmp.%s" [pid]]]
3230 if {[catch {file mkdir $gitktmpdir} err]} {
3231 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3238 set diffdir [file join $gitktmpdir $diffnum]
3239 if {[catch {file mkdir $diffdir} err]} {
3240 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3244 # gather files to diff
3245 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3246 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3248 if {$difffromfile ne {} && $difftofile ne {}} {
3249 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3250 if {[catch {set fl [open |$cmd r]} err]} {
3251 file delete -force $diffdir
3252 error_popup "$extdifftool: [mc "command failed:"] $err"
3254 fconfigure $fl -blocking 0
3255 filerun $fl [list delete_at_eof $fl $diffdir]
3260 proc find_hunk_blamespec {base line} {
3263 # Find and parse the hunk header
3264 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3265 if {$s_lix eq {}} return
3267 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3268 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3269 s_line old_specs osz osz1 new_line nsz]} {
3273 # base lines for the parents
3274 set base_lines [list $new_line]
3275 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3276 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3277 old_spec old_line osz]} {
3280 lappend base_lines $old_line
3283 # Now scan the lines to determine offset within the hunk
3284 set max_parent [expr {[llength $base_lines]-2}]
3286 set s_lno [lindex [split $s_lix "."] 0]
3288 # Determine if the line is removed
3289 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3290 if {[string match {[-+ ]*} $chunk]} {
3291 set removed_idx [string first "-" $chunk]
3292 # Choose a parent index
3293 if {$removed_idx >= 0} {
3294 set parent $removed_idx
3296 set unchanged_idx [string first " " $chunk]
3297 if {$unchanged_idx >= 0} {
3298 set parent $unchanged_idx
3300 # blame the current commit
3304 # then count other lines that belong to it
3305 for {set i $line} {[incr i -1] > $s_lno} {} {
3306 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3307 # Determine if the line is removed
3308 set removed_idx [string first "-" $chunk]
3310 set code [string index $chunk $parent]
3311 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3315 if {$removed_idx < 0} {
3325 incr dline [lindex $base_lines $parent]
3326 return [list $parent $dline]
3329 proc external_blame_diff {} {
3330 global currentid cmitmode
3331 global diff_menu_txtpos diff_menu_line
3332 global diff_menu_filebase flist_menu_file
3334 if {$cmitmode eq "tree"} {
3336 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3338 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3340 set parent_idx [lindex $hinfo 0]
3341 set line [lindex $hinfo 1]
3348 external_blame $parent_idx $line
3351 # Find the SHA1 ID of the blob for file $fname in the index
3353 proc index_sha1 {fname} {
3354 set f [open [list | git ls-files -s $fname] r]
3355 while {[gets $f line] >= 0} {
3356 set info [lindex [split $line "\t"] 0]
3357 set stage [lindex $info 2]
3358 if {$stage eq "0" || $stage eq "2"} {
3360 return [lindex $info 1]
3367 # Turn an absolute path into one relative to the current directory
3368 proc make_relative {f} {
3369 set elts [file split $f]
3370 set here [file split [pwd]]
3375 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3382 set elts [concat $res [lrange $elts $ei end]]
3383 return [eval file join $elts]
3386 proc external_blame {parent_idx {line {}}} {
3387 global flist_menu_file gitdir
3388 global nullid nullid2
3389 global parentlist selectedline currentid
3391 if {$parent_idx > 0} {
3392 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3394 set base_commit $currentid
3397 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3398 error_popup [mc "No such commit"]
3402 set cmdline [list git gui blame]
3403 if {$line ne {} && $line > 1} {
3404 lappend cmdline "--line=$line"
3406 set f [file join [file dirname $gitdir] $flist_menu_file]
3407 # Unfortunately it seems git gui blame doesn't like
3408 # being given an absolute path...
3409 set f [make_relative $f]
3410 lappend cmdline $base_commit $f
3411 if {[catch {eval exec $cmdline &} err]} {
3412 error_popup "[mc "git gui blame: command failed:"] $err"
3416 proc show_line_source {} {
3417 global cmitmode currentid parents curview blamestuff blameinst
3418 global diff_menu_line diff_menu_filebase flist_menu_file
3419 global nullid nullid2 gitdir
3422 if {$cmitmode eq "tree"} {
3424 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3426 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3427 if {$h eq {}} return
3428 set pi [lindex $h 0]
3430 mark_ctext_line $diff_menu_line
3434 if {$currentid eq $nullid} {
3436 # must be a merge in progress...
3438 # get the last line from .git/MERGE_HEAD
3439 set f [open [file join $gitdir MERGE_HEAD] r]
3440 set id [lindex [split [read $f] "\n"] end-1]
3443 error_popup [mc "Couldn't read merge head: %s" $err]
3446 } elseif {$parents($curview,$currentid) eq $nullid2} {
3447 # need to do the blame from the index
3449 set from_index [index_sha1 $flist_menu_file]
3451 error_popup [mc "Error reading index: %s" $err]
3455 set id $parents($curview,$currentid)
3458 set id [lindex $parents($curview,$currentid) $pi]
3460 set line [lindex $h 1]
3463 if {$from_index ne {}} {
3464 lappend blameargs | git cat-file blob $from_index
3466 lappend blameargs | git blame -p -L$line,+1
3467 if {$from_index ne {}} {
3468 lappend blameargs --contents -
3470 lappend blameargs $id
3472 lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
3474 set f [open $blameargs r]
3476 error_popup [mc "Couldn't start git blame: %s" $err]
3479 nowbusy blaming [mc "Searching"]
3480 fconfigure $f -blocking 0
3481 set i [reg_instance $f]
3482 set blamestuff($i) {}
3484 filerun $f [list read_line_source $f $i]
3487 proc stopblaming {} {
3490 if {[info exists blameinst]} {
3491 stop_instance $blameinst
3497 proc read_line_source {fd inst} {
3498 global blamestuff curview commfd blameinst nullid nullid2
3500 while {[gets $fd line] >= 0} {
3501 lappend blamestuff($inst) $line
3509 fconfigure $fd -blocking 1
3510 if {[catch {close $fd} err]} {
3511 error_popup [mc "Error running git blame: %s" $err]
3516 set line [split [lindex $blamestuff($inst) 0] " "]
3517 set id [lindex $line 0]
3518 set lnum [lindex $line 1]
3519 if {[string length $id] == 40 && [string is xdigit $id] &&
3520 [string is digit -strict $lnum]} {
3521 # look for "filename" line
3522 foreach l $blamestuff($inst) {
3523 if {[string match "filename *" $l]} {
3524 set fname [string range $l 9 end]
3530 # all looks good, select it
3531 if {$id eq $nullid} {
3532 # blame uses all-zeroes to mean not committed,
3533 # which would mean a change in the index
3536 if {[commitinview $id $curview]} {
3537 selectline [rowofcommit $id] 1 [list $fname $lnum]
3539 error_popup [mc "That line comes from commit %s, \
3540 which is not in this view" [shortids $id]]
3543 puts "oops couldn't parse git blame output"
3548 # delete $dir when we see eof on $f (presumably because the child has exited)
3549 proc delete_at_eof {f dir} {
3550 while {[gets $f line] >= 0} {}
3552 if {[catch {close $f} err]} {
3553 error_popup "[mc "External diff viewer failed:"] $err"
3555 file delete -force $dir
3561 # Functions for adding and removing shell-type quoting
3563 proc shellquote {str} {
3564 if {![string match "*\['\"\\ \t]*" $str]} {
3567 if {![string match "*\['\"\\]*" $str]} {
3570 if {![string match "*'*" $str]} {
3573 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3576 proc shellarglist {l} {
3582 append str [shellquote $a]
3587 proc shelldequote {str} {
3592 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3593 append ret [string range $str $used end]
3594 set used [string length $str]
3597 set first [lindex $first 0]
3598 set ch [string index $str $first]
3599 if {$first > $used} {
3600 append ret [string range $str $used [expr {$first - 1}]]
3603 if {$ch eq " " || $ch eq "\t"} break
3606 set first [string first "'" $str $used]
3608 error "unmatched single-quote"
3610 append ret [string range $str $used [expr {$first - 1}]]
3615 if {$used >= [string length $str]} {
3616 error "trailing backslash"
3618 append ret [string index $str $used]
3623 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3624 error "unmatched double-quote"
3626 set first [lindex $first 0]
3627 set ch [string index $str $first]
3628 if {$first > $used} {
3629 append ret [string range $str $used [expr {$first - 1}]]
3632 if {$ch eq "\""} break
3634 append ret [string index $str $used]
3638 return [list $used $ret]
3641 proc shellsplit {str} {
3644 set str [string trimleft $str]
3645 if {$str eq {}} break
3646 set dq [shelldequote $str]
3647 set n [lindex $dq 0]
3648 set word [lindex $dq 1]
3649 set str [string range $str $n end]
3655 # Code to implement multiple views
3657 proc newview {ishighlight} {
3658 global nextviewnum newviewname newishighlight
3659 global revtreeargs viewargscmd newviewopts curview
3661 set newishighlight $ishighlight
3663 if {[winfo exists $top]} {
3667 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3668 set newviewopts($nextviewnum,perm) 0
3669 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3670 decode_view_opts $nextviewnum $revtreeargs
3671 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3674 set known_view_options {
3675 {perm b . {} {mc "Remember this view"}}
3676 {args t50= + {} {mc "Commits to include (arguments to git log):"}}
3677 {all b * "--all" {mc "Use all refs"}}
3678 {dorder b . {"--date-order" "-d"} {mc "Strictly sort by date"}}
3679 {lright b . "--left-right" {mc "Mark branch sides"}}
3680 {since t15 + {"--since=*" "--after=*"} {mc "Since date:"}}
3681 {until t15 . {"--until=*" "--before=*"} {mc "Until date:"}}
3682 {limit t10 + "--max-count=*" {mc "Max count:"}}
3683 {skip t10 . "--skip=*" {mc "Skip:"}}
3684 {first b . "--first-parent" {mc "Limit to first parent"}}
3685 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3688 proc encode_view_opts {n} {
3689 global known_view_options newviewopts
3692 foreach opt $known_view_options {
3693 set patterns [lindex $opt 3]
3694 if {$patterns eq {}} continue
3695 set pattern [lindex $patterns 0]
3697 set val $newviewopts($n,[lindex $opt 0])
3699 if {[lindex $opt 1] eq "b"} {
3701 lappend rargs $pattern
3704 set val [string trim $val]
3706 set pfix [string range $pattern 0 end-1]
3707 lappend rargs $pfix$val
3711 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3714 proc decode_view_opts {n view_args} {
3715 global known_view_options newviewopts
3717 foreach opt $known_view_options {
3718 if {[lindex $opt 1] eq "b"} {
3723 set newviewopts($n,[lindex $opt 0]) $val
3726 foreach arg $view_args {
3727 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3728 && ![info exists found(limit)]} {
3729 set newviewopts($n,limit) $cnt
3734 foreach opt $known_view_options {
3735 set id [lindex $opt 0]
3736 if {[info exists found($id)]} continue
3737 foreach pattern [lindex $opt 3] {
3738 if {![string match $pattern $arg]} continue
3739 if {[lindex $opt 1] ne "b"} {
3740 set size [string length $pattern]
3741 set val [string range $arg [expr {$size-1}] end]
3745 set newviewopts($n,$id) $val
3749 if {[info exists val]} break
3751 if {[info exists val]} continue
3754 set newviewopts($n,args) [shellarglist $oargs]
3757 proc edit_or_newview {} {
3769 global viewname viewperm newviewname newviewopts
3770 global viewargs viewargscmd
3772 set top .gitkvedit-$curview
3773 if {[winfo exists $top]} {
3777 set newviewname($curview) $viewname($curview)
3778 set newviewopts($curview,perm) $viewperm($curview)
3779 set newviewopts($curview,cmd) $viewargscmd($curview)
3780 decode_view_opts $curview $viewargs($curview)
3781 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
3784 proc vieweditor {top n title} {
3785 global newviewname newviewopts viewfiles bgcolor
3786 global known_view_options
3789 wm title $top $title
3790 make_transient $top .
3794 label $top.nl -text [mc "Name"]
3795 entry $top.name -width 20 -textvariable newviewname($n)
3796 pack $top.nfr -in $top -fill x -pady 5 -padx 3
3797 pack $top.nl -in $top.nfr -side left -padx {0 30}
3798 pack $top.name -in $top.nfr -side left
3804 foreach opt $known_view_options {
3805 set id [lindex $opt 0]
3806 set type [lindex $opt 1]
3807 set flags [lindex $opt 2]
3808 set title [eval [lindex $opt 4]]
3811 if {$flags eq "+" || $flags eq "*"} {
3812 set cframe $top.fr$cnt
3815 pack $cframe -in $top -fill x -pady 3 -padx 3
3816 set cexpand [expr {$flags eq "*"}]
3822 checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
3823 pack $cframe.c_$id -in $cframe -side left \
3824 -padx [list $lxpad 0] -expand $cexpand -anchor w
3825 } elseif {[regexp {^t(\d+)$} $type type sz]} {
3826 message $cframe.l_$id -aspect 1500 -text $title
3827 entry $cframe.e_$id -width $sz -background $bgcolor \
3828 -textvariable newviewopts($n,$id)
3829 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
3830 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
3831 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
3832 message $cframe.l_$id -aspect 1500 -text $title
3833 entry $cframe.e_$id -width $sz -background $bgcolor \
3834 -textvariable newviewopts($n,$id)
3835 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
3836 pack $cframe.e_$id -in $cframe -side top -fill x
3841 message $top.l -aspect 1500 \
3842 -text [mc "Enter files and directories to include, one per line:"]
3843 pack $top.l -in $top -side top -pady [list 7 0] -anchor w -padx 3
3844 text $top.t -width 40 -height 5 -background $bgcolor -font uifont
3845 if {[info exists viewfiles($n)]} {
3846 foreach f $viewfiles($n) {
3847 $top.t insert end $f
3848 $top.t insert end "\n"
3850 $top.t delete {end - 1c} end
3851 $top.t mark set insert 0.0
3853 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
3855 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3856 button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
3857 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3858 bind $top <Control-Return> [list newviewok $top $n]
3859 bind $top <F5> [list newviewok $top $n 1]
3860 bind $top <Escape> [list destroy $top]
3861 grid $top.buts.ok $top.buts.apply $top.buts.can
3862 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3863 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3864 grid columnconfigure $top.buts 2 -weight 1 -uniform a
3865 pack $top.buts -in $top -side top -fill x
3869 proc doviewmenu {m first cmd op argv} {
3870 set nmenu [$m index end]
3871 for {set i $first} {$i <= $nmenu} {incr i} {
3872 if {[$m entrycget $i -command] eq $cmd} {
3873 eval $m $op $i $argv
3879 proc allviewmenus {n op args} {
3882 doviewmenu .bar.view 5 [list showview $n] $op $args
3883 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3886 proc newviewok {top n {apply 0}} {
3887 global nextviewnum newviewperm newviewname newishighlight
3888 global viewname viewfiles viewperm selectedview curview
3889 global viewargs viewargscmd newviewopts viewhlmenu
3892 set newargs [encode_view_opts $n]
3894 error_popup "[mc "Error in commit selection arguments:"] $err" $top
3898 foreach f [split [$top.t get 0.0 end] "\n"] {
3899 set ft [string trim $f]
3904 if {![info exists viewfiles($n)]} {
3905 # creating a new view
3907 set viewname($n) $newviewname($n)
3908 set viewperm($n) $newviewopts($n,perm)
3909 set viewfiles($n) $files
3910 set viewargs($n) $newargs
3911 set viewargscmd($n) $newviewopts($n,cmd)
3913 if {!$newishighlight} {
3916 run addvhighlight $n
3919 # editing an existing view
3920 set viewperm($n) $newviewopts($n,perm)
3921 if {$newviewname($n) ne $viewname($n)} {
3922 set viewname($n) $newviewname($n)
3923 doviewmenu .bar.view 5 [list showview $n] \
3924 entryconf [list -label $viewname($n)]
3925 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3926 # entryconf [list -label $viewname($n) -value $viewname($n)]
3928 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3929 $newviewopts($n,cmd) ne $viewargscmd($n)} {
3930 set viewfiles($n) $files
3931 set viewargs($n) $newargs
3932 set viewargscmd($n) $newviewopts($n,cmd)
3933 if {$curview == $n} {
3939 catch {destroy $top}
3943 global curview viewperm hlview selectedhlview
3945 if {$curview == 0} return
3946 if {[info exists hlview] && $hlview == $curview} {
3947 set selectedhlview [mc "None"]
3950 allviewmenus $curview delete
3951 set viewperm($curview) 0
3955 proc addviewmenu {n} {
3956 global viewname viewhlmenu
3958 .bar.view add radiobutton -label $viewname($n) \
3959 -command [list showview $n] -variable selectedview -value $n
3960 #$viewhlmenu add radiobutton -label $viewname($n) \
3961 # -command [list addvhighlight $n] -variable selectedhlview
3965 global curview cached_commitrow ordertok
3966 global displayorder parentlist rowidlist rowisopt rowfinal
3967 global colormap rowtextx nextcolor canvxmax
3968 global numcommits viewcomplete
3969 global selectedline currentid canv canvy0
3971 global pending_select mainheadid
3974 global hlview selectedhlview commitinterest
3976 if {$n == $curview} return
3978 set ymax [lindex [$canv cget -scrollregion] 3]
3979 set span [$canv yview]
3980 set ytop [expr {[lindex $span 0] * $ymax}]
3981 set ybot [expr {[lindex $span 1] * $ymax}]
3982 set yscreen [expr {($ybot - $ytop) / 2}]
3983 if {$selectedline ne {}} {
3984 set selid $currentid
3985 set y [yc $selectedline]
3986 if {$ytop < $y && $y < $ybot} {
3987 set yscreen [expr {$y - $ytop}]
3989 } elseif {[info exists pending_select]} {
3990 set selid $pending_select
3991 unset pending_select
3995 catch {unset treediffs}
3997 if {[info exists hlview] && $hlview == $n} {
3999 set selectedhlview [mc "None"]
4001 catch {unset commitinterest}
4002 catch {unset cached_commitrow}
4003 catch {unset ordertok}
4007 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4008 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4011 if {![info exists viewcomplete($n)]} {
4021 set numcommits $commitidx($n)
4023 catch {unset colormap}
4024 catch {unset rowtextx}
4026 set canvxmax [$canv cget -width]
4032 if {$selid ne {} && [commitinview $selid $n]} {
4033 set row [rowofcommit $selid]
4034 # try to get the selected row in the same position on the screen
4035 set ymax [lindex [$canv cget -scrollregion] 3]
4036 set ytop [expr {[yc $row] - $yscreen}]
4040 set yf [expr {$ytop * 1.0 / $ymax}]
4042 allcanvs yview moveto $yf
4046 } elseif {!$viewcomplete($n)} {
4047 reset_pending_select $selid
4049 reset_pending_select {}
4051 if {[commitinview $pending_select $curview]} {
4052 selectline [rowofcommit $pending_select] 1
4054 set row [first_real_row]
4055 if {$row < $numcommits} {
4060 if {!$viewcomplete($n)} {
4061 if {$numcommits == 0} {
4062 show_status [mc "Reading commits..."]
4064 } elseif {$numcommits == 0} {
4065 show_status [mc "No commits selected"]
4069 # Stuff relating to the highlighting facility
4071 proc ishighlighted {id} {
4072 global vhighlights fhighlights nhighlights rhighlights
4074 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4075 return $nhighlights($id)
4077 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4078 return $vhighlights($id)
4080 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4081 return $fhighlights($id)
4083 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4084 return $rhighlights($id)
4089 proc bolden {id font} {
4090 global canv linehtag currentid boldids need_redisplay markedid
4092 # need_redisplay = 1 means the display is stale and about to be redrawn
4093 if {$need_redisplay} return
4095 $canv itemconf $linehtag($id) -font $font
4096 if {[info exists currentid] && $id eq $currentid} {
4098 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4099 -outline {{}} -tags secsel \
4100 -fill [$canv cget -selectbackground]]
4103 if {[info exists markedid] && $id eq $markedid} {
4108 proc bolden_name {id font} {
4109 global canv2 linentag currentid boldnameids need_redisplay
4111 if {$need_redisplay} return
4112 lappend boldnameids $id
4113 $canv2 itemconf $linentag($id) -font $font
4114 if {[info exists currentid] && $id eq $currentid} {
4115 $canv2 delete secsel
4116 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4117 -outline {{}} -tags secsel \
4118 -fill [$canv2 cget -selectbackground]]
4127 foreach id $boldids {
4128 if {![ishighlighted $id]} {
4131 lappend stillbold $id
4134 set boldids $stillbold
4137 proc addvhighlight {n} {
4138 global hlview viewcomplete curview vhl_done commitidx
4140 if {[info exists hlview]} {
4144 if {$n != $curview && ![info exists viewcomplete($n)]} {
4147 set vhl_done $commitidx($hlview)
4148 if {$vhl_done > 0} {
4153 proc delvhighlight {} {
4154 global hlview vhighlights
4156 if {![info exists hlview]} return
4158 catch {unset vhighlights}
4162 proc vhighlightmore {} {
4163 global hlview vhl_done commitidx vhighlights curview
4165 set max $commitidx($hlview)
4166 set vr [visiblerows]
4167 set r0 [lindex $vr 0]
4168 set r1 [lindex $vr 1]
4169 for {set i $vhl_done} {$i < $max} {incr i} {
4170 set id [commitonrow $i $hlview]
4171 if {[commitinview $id $curview]} {
4172 set row [rowofcommit $id]
4173 if {$r0 <= $row && $row <= $r1} {
4174 if {![highlighted $row]} {
4175 bolden $id mainfontbold
4177 set vhighlights($id) 1
4185 proc askvhighlight {row id} {
4186 global hlview vhighlights iddrawn
4188 if {[commitinview $id $hlview]} {
4189 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4190 bolden $id mainfontbold
4192 set vhighlights($id) 1
4194 set vhighlights($id) 0
4198 proc hfiles_change {} {
4199 global highlight_files filehighlight fhighlights fh_serial
4200 global highlight_paths
4202 if {[info exists filehighlight]} {
4203 # delete previous highlights
4204 catch {close $filehighlight}
4206 catch {unset fhighlights}
4208 unhighlight_filelist
4210 set highlight_paths {}
4211 after cancel do_file_hl $fh_serial
4213 if {$highlight_files ne {}} {
4214 after 300 do_file_hl $fh_serial
4218 proc gdttype_change {name ix op} {
4219 global gdttype highlight_files findstring findpattern
4222 if {$findstring ne {}} {
4223 if {$gdttype eq [mc "containing:"]} {
4224 if {$highlight_files ne {}} {
4225 set highlight_files {}
4230 if {$findpattern ne {}} {
4234 set highlight_files $findstring
4239 # enable/disable findtype/findloc menus too
4242 proc find_change {name ix op} {
4243 global gdttype findstring highlight_files
4246 if {$gdttype eq [mc "containing:"]} {
4249 if {$highlight_files ne $findstring} {
4250 set highlight_files $findstring
4257 proc findcom_change args {
4258 global nhighlights boldnameids
4259 global findpattern findtype findstring gdttype
4262 # delete previous highlights, if any
4263 foreach id $boldnameids {
4264 bolden_name $id mainfont
4267 catch {unset nhighlights}
4270 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4272 } elseif {$findtype eq [mc "Regexp"]} {
4273 set findpattern $findstring
4275 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4277 set findpattern "*$e*"
4281 proc makepatterns {l} {
4284 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4285 if {[string index $ee end] eq "/"} {
4295 proc do_file_hl {serial} {
4296 global highlight_files filehighlight highlight_paths gdttype fhl_list
4298 if {$gdttype eq [mc "touching paths:"]} {
4299 if {[catch {set paths [shellsplit $highlight_files]}]} return
4300 set highlight_paths [makepatterns $paths]
4302 set gdtargs [concat -- $paths]
4303 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4304 set gdtargs [list "-S$highlight_files"]
4306 # must be "containing:", i.e. we're searching commit info
4309 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4310 set filehighlight [open $cmd r+]
4311 fconfigure $filehighlight -blocking 0
4312 filerun $filehighlight readfhighlight
4318 proc flushhighlights {} {
4319 global filehighlight fhl_list
4321 if {[info exists filehighlight]} {
4323 puts $filehighlight ""
4324 flush $filehighlight
4328 proc askfilehighlight {row id} {
4329 global filehighlight fhighlights fhl_list
4331 lappend fhl_list $id
4332 set fhighlights($id) -1
4333 puts $filehighlight $id
4336 proc readfhighlight {} {
4337 global filehighlight fhighlights curview iddrawn
4338 global fhl_list find_dirn
4340 if {![info exists filehighlight]} {
4344 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4345 set line [string trim $line]
4346 set i [lsearch -exact $fhl_list $line]
4347 if {$i < 0} continue
4348 for {set j 0} {$j < $i} {incr j} {
4349 set id [lindex $fhl_list $j]
4350 set fhighlights($id) 0
4352 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4353 if {$line eq {}} continue
4354 if {![commitinview $line $curview]} continue
4355 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4356 bolden $line mainfontbold
4358 set fhighlights($line) 1
4360 if {[eof $filehighlight]} {
4362 puts "oops, git diff-tree died"
4363 catch {close $filehighlight}
4367 if {[info exists find_dirn]} {
4373 proc doesmatch {f} {
4374 global findtype findpattern
4376 if {$findtype eq [mc "Regexp"]} {
4377 return [regexp $findpattern $f]
4378 } elseif {$findtype eq [mc "IgnCase"]} {
4379 return [string match -nocase $findpattern $f]
4381 return [string match $findpattern $f]
4385 proc askfindhighlight {row id} {
4386 global nhighlights commitinfo iddrawn
4388 global markingmatches
4390 if {![info exists commitinfo($id)]} {
4393 set info $commitinfo($id)
4395 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4396 foreach f $info ty $fldtypes {
4397 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4399 if {$ty eq [mc "Author"]} {
4406 if {$isbold && [info exists iddrawn($id)]} {
4407 if {![ishighlighted $id]} {
4408 bolden $id mainfontbold
4410 bolden_name $id mainfontbold
4413 if {$markingmatches} {
4414 markrowmatches $row $id
4417 set nhighlights($id) $isbold
4420 proc markrowmatches {row id} {
4421 global canv canv2 linehtag linentag commitinfo findloc
4423 set headline [lindex $commitinfo($id) 0]
4424 set author [lindex $commitinfo($id) 1]
4425 $canv delete match$row
4426 $canv2 delete match$row
4427 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4428 set m [findmatches $headline]
4430 markmatches $canv $row $headline $linehtag($id) $m \
4431 [$canv itemcget $linehtag($id) -font] $row
4434 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4435 set m [findmatches $author]
4437 markmatches $canv2 $row $author $linentag($id) $m \
4438 [$canv2 itemcget $linentag($id) -font] $row
4443 proc vrel_change {name ix op} {
4444 global highlight_related
4447 if {$highlight_related ne [mc "None"]} {
4452 # prepare for testing whether commits are descendents or ancestors of a
4453 proc rhighlight_sel {a} {
4454 global descendent desc_todo ancestor anc_todo
4455 global highlight_related
4457 catch {unset descendent}
4458 set desc_todo [list $a]
4459 catch {unset ancestor}
4460 set anc_todo [list $a]
4461 if {$highlight_related ne [mc "None"]} {
4467 proc rhighlight_none {} {
4470 catch {unset rhighlights}
4474 proc is_descendent {a} {
4475 global curview children descendent desc_todo
4478 set la [rowofcommit $a]
4482 for {set i 0} {$i < [llength $todo]} {incr i} {
4483 set do [lindex $todo $i]
4484 if {[rowofcommit $do] < $la} {
4485 lappend leftover $do
4488 foreach nk $children($v,$do) {
4489 if {![info exists descendent($nk)]} {
4490 set descendent($nk) 1
4498 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4502 set descendent($a) 0
4503 set desc_todo $leftover
4506 proc is_ancestor {a} {
4507 global curview parents ancestor anc_todo
4510 set la [rowofcommit $a]
4514 for {set i 0} {$i < [llength $todo]} {incr i} {
4515 set do [lindex $todo $i]
4516 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4517 lappend leftover $do
4520 foreach np $parents($v,$do) {
4521 if {![info exists ancestor($np)]} {
4530 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4535 set anc_todo $leftover
4538 proc askrelhighlight {row id} {
4539 global descendent highlight_related iddrawn rhighlights
4540 global selectedline ancestor
4542 if {$selectedline eq {}} return
4544 if {$highlight_related eq [mc "Descendant"] ||
4545 $highlight_related eq [mc "Not descendant"]} {
4546 if {![info exists descendent($id)]} {
4549 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4552 } elseif {$highlight_related eq [mc "Ancestor"] ||
4553 $highlight_related eq [mc "Not ancestor"]} {
4554 if {![info exists ancestor($id)]} {
4557 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4561 if {[info exists iddrawn($id)]} {
4562 if {$isbold && ![ishighlighted $id]} {
4563 bolden $id mainfontbold
4566 set rhighlights($id) $isbold
4569 # Graph layout functions
4571 proc shortids {ids} {
4574 if {[llength $id] > 1} {
4575 lappend res [shortids $id]
4576 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4577 lappend res [string range $id 0 7]
4588 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4589 if {($n & $mask) != 0} {
4590 set ret [concat $ret $o]
4592 set o [concat $o $o]
4597 proc ordertoken {id} {
4598 global ordertok curview varcid varcstart varctok curview parents children
4599 global nullid nullid2
4601 if {[info exists ordertok($id)]} {
4602 return $ordertok($id)
4607 if {[info exists varcid($curview,$id)]} {
4608 set a $varcid($curview,$id)
4609 set p [lindex $varcstart($curview) $a]
4611 set p [lindex $children($curview,$id) 0]
4613 if {[info exists ordertok($p)]} {
4614 set tok $ordertok($p)
4617 set id [first_real_child $curview,$p]
4620 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4623 if {[llength $parents($curview,$id)] == 1} {
4624 lappend todo [list $p {}]
4626 set j [lsearch -exact $parents($curview,$id) $p]
4628 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4630 lappend todo [list $p [strrep $j]]
4633 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4634 set p [lindex $todo $i 0]
4635 append tok [lindex $todo $i 1]
4636 set ordertok($p) $tok
4638 set ordertok($origid) $tok
4642 # Work out where id should go in idlist so that order-token
4643 # values increase from left to right
4644 proc idcol {idlist id {i 0}} {
4645 set t [ordertoken $id]
4649 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4650 if {$i > [llength $idlist]} {
4651 set i [llength $idlist]
4653 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4656 if {$t > [ordertoken [lindex $idlist $i]]} {
4657 while {[incr i] < [llength $idlist] &&
4658 $t >= [ordertoken [lindex $idlist $i]]} {}
4664 proc initlayout {} {
4665 global rowidlist rowisopt rowfinal displayorder parentlist
4666 global numcommits canvxmax canv
4668 global colormap rowtextx
4677 set canvxmax [$canv cget -width]
4678 catch {unset colormap}
4679 catch {unset rowtextx}
4683 proc setcanvscroll {} {
4684 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4685 global lastscrollset lastscrollrows
4687 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4688 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4689 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4690 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4691 set lastscrollset [clock clicks -milliseconds]
4692 set lastscrollrows $numcommits
4695 proc visiblerows {} {
4696 global canv numcommits linespc
4698 set ymax [lindex [$canv cget -scrollregion] 3]
4699 if {$ymax eq {} || $ymax == 0} return
4701 set y0 [expr {int([lindex $f 0] * $ymax)}]
4702 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4706 set y1 [expr {int([lindex $f 1] * $ymax)}]
4707 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4708 if {$r1 >= $numcommits} {
4709 set r1 [expr {$numcommits - 1}]
4711 return [list $r0 $r1]
4714 proc layoutmore {} {
4715 global commitidx viewcomplete curview
4716 global numcommits pending_select curview
4717 global lastscrollset lastscrollrows
4719 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4720 [clock clicks -milliseconds] - $lastscrollset > 500} {
4723 if {[info exists pending_select] &&
4724 [commitinview $pending_select $curview]} {
4726 selectline [rowofcommit $pending_select] 1
4731 # With path limiting, we mightn't get the actual HEAD commit,
4732 # so ask git rev-list what is the first ancestor of HEAD that
4733 # touches a file in the path limit.
4734 proc get_viewmainhead {view} {
4735 global viewmainheadid vfilelimit viewinstances mainheadid
4738 set rfd [open [concat | git rev-list -1 $mainheadid \
4739 -- $vfilelimit($view)] r]
4740 set j [reg_instance $rfd]
4741 lappend viewinstances($view) $j
4742 fconfigure $rfd -blocking 0
4743 filerun $rfd [list getviewhead $rfd $j $view]
4744 set viewmainheadid($curview) {}
4748 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4749 proc getviewhead {fd inst view} {
4750 global viewmainheadid commfd curview viewinstances showlocalchanges
4753 if {[gets $fd line] < 0} {
4757 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4760 set viewmainheadid($view) $id
4763 set i [lsearch -exact $viewinstances($view) $inst]
4765 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4767 if {$showlocalchanges && $id ne {} && $view == $curview} {
4773 proc doshowlocalchanges {} {
4774 global curview viewmainheadid
4776 if {$viewmainheadid($curview) eq {}} return
4777 if {[commitinview $viewmainheadid($curview) $curview]} {
4780 interestedin $viewmainheadid($curview) dodiffindex
4784 proc dohidelocalchanges {} {
4785 global nullid nullid2 lserial curview
4787 if {[commitinview $nullid $curview]} {
4788 removefakerow $nullid
4790 if {[commitinview $nullid2 $curview]} {
4791 removefakerow $nullid2
4796 # spawn off a process to do git diff-index --cached HEAD
4797 proc dodiffindex {} {
4798 global lserial showlocalchanges vfilelimit curview
4801 if {!$showlocalchanges || !$isworktree} return
4803 set cmd "|git diff-index --cached HEAD"
4804 if {$vfilelimit($curview) ne {}} {
4805 set cmd [concat $cmd -- $vfilelimit($curview)]
4807 set fd [open $cmd r]
4808 fconfigure $fd -blocking 0
4809 set i [reg_instance $fd]
4810 filerun $fd [list readdiffindex $fd $lserial $i]
4813 proc readdiffindex {fd serial inst} {
4814 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
4818 if {[gets $fd line] < 0} {
4824 # we only need to see one line and we don't really care what it says...
4827 if {$serial != $lserial} {
4831 # now see if there are any local changes not checked in to the index
4832 set cmd "|git diff-files"
4833 if {$vfilelimit($curview) ne {}} {
4834 set cmd [concat $cmd -- $vfilelimit($curview)]
4836 set fd [open $cmd r]
4837 fconfigure $fd -blocking 0
4838 set i [reg_instance $fd]
4839 filerun $fd [list readdifffiles $fd $serial $i]
4841 if {$isdiff && ![commitinview $nullid2 $curview]} {
4842 # add the line for the changes in the index to the graph
4843 set hl [mc "Local changes checked in to index but not committed"]
4844 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4845 set commitdata($nullid2) "\n $hl\n"
4846 if {[commitinview $nullid $curview]} {
4847 removefakerow $nullid
4849 insertfakerow $nullid2 $viewmainheadid($curview)
4850 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4851 if {[commitinview $nullid $curview]} {
4852 removefakerow $nullid
4854 removefakerow $nullid2
4859 proc readdifffiles {fd serial inst} {
4860 global viewmainheadid nullid nullid2 curview
4861 global commitinfo commitdata lserial
4864 if {[gets $fd line] < 0} {
4870 # we only need to see one line and we don't really care what it says...
4873 if {$serial != $lserial} {
4877 if {$isdiff && ![commitinview $nullid $curview]} {
4878 # add the line for the local diff to the graph
4879 set hl [mc "Local uncommitted changes, not checked in to index"]
4880 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4881 set commitdata($nullid) "\n $hl\n"
4882 if {[commitinview $nullid2 $curview]} {
4885 set p $viewmainheadid($curview)
4887 insertfakerow $nullid $p
4888 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4889 removefakerow $nullid
4894 proc nextuse {id row} {
4895 global curview children
4897 if {[info exists children($curview,$id)]} {
4898 foreach kid $children($curview,$id) {
4899 if {![commitinview $kid $curview]} {
4902 if {[rowofcommit $kid] > $row} {
4903 return [rowofcommit $kid]
4907 if {[commitinview $id $curview]} {
4908 return [rowofcommit $id]
4913 proc prevuse {id row} {
4914 global curview children
4917 if {[info exists children($curview,$id)]} {
4918 foreach kid $children($curview,$id) {
4919 if {![commitinview $kid $curview]} break
4920 if {[rowofcommit $kid] < $row} {
4921 set ret [rowofcommit $kid]
4928 proc make_idlist {row} {
4929 global displayorder parentlist uparrowlen downarrowlen mingaplen
4930 global commitidx curview children
4932 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4936 set ra [expr {$row - $downarrowlen}]
4940 set rb [expr {$row + $uparrowlen}]
4941 if {$rb > $commitidx($curview)} {
4942 set rb $commitidx($curview)
4944 make_disporder $r [expr {$rb + 1}]
4946 for {} {$r < $ra} {incr r} {
4947 set nextid [lindex $displayorder [expr {$r + 1}]]
4948 foreach p [lindex $parentlist $r] {
4949 if {$p eq $nextid} continue
4950 set rn [nextuse $p $r]
4952 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4953 lappend ids [list [ordertoken $p] $p]
4957 for {} {$r < $row} {incr r} {
4958 set nextid [lindex $displayorder [expr {$r + 1}]]
4959 foreach p [lindex $parentlist $r] {
4960 if {$p eq $nextid} continue
4961 set rn [nextuse $p $r]
4962 if {$rn < 0 || $rn >= $row} {
4963 lappend ids [list [ordertoken $p] $p]
4967 set id [lindex $displayorder $row]
4968 lappend ids [list [ordertoken $id] $id]
4970 foreach p [lindex $parentlist $r] {
4971 set firstkid [lindex $children($curview,$p) 0]
4972 if {[rowofcommit $firstkid] < $row} {
4973 lappend ids [list [ordertoken $p] $p]
4977 set id [lindex $displayorder $r]
4979 set firstkid [lindex $children($curview,$id) 0]
4980 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4981 lappend ids [list [ordertoken $id] $id]
4986 foreach idx [lsort -unique $ids] {
4987 lappend idlist [lindex $idx 1]
4992 proc rowsequal {a b} {
4993 while {[set i [lsearch -exact $a {}]] >= 0} {
4994 set a [lreplace $a $i $i]
4996 while {[set i [lsearch -exact $b {}]] >= 0} {
4997 set b [lreplace $b $i $i]
4999 return [expr {$a eq $b}]
5002 proc makeupline {id row rend col} {
5003 global rowidlist uparrowlen downarrowlen mingaplen
5005 for {set r $rend} {1} {set r $rstart} {
5006 set rstart [prevuse $id $r]
5007 if {$rstart < 0} return
5008 if {$rstart < $row} break
5010 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5011 set rstart [expr {$rend - $uparrowlen - 1}]
5013 for {set r $rstart} {[incr r] <= $row} {} {
5014 set idlist [lindex $rowidlist $r]
5015 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5016 set col [idcol $idlist $id $col]
5017 lset rowidlist $r [linsert $idlist $col $id]
5023 proc layoutrows {row endrow} {
5024 global rowidlist rowisopt rowfinal displayorder
5025 global uparrowlen downarrowlen maxwidth mingaplen
5026 global children parentlist
5027 global commitidx viewcomplete curview
5029 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5032 set rm1 [expr {$row - 1}]
5033 foreach id [lindex $rowidlist $rm1] {
5038 set final [lindex $rowfinal $rm1]
5040 for {} {$row < $endrow} {incr row} {
5041 set rm1 [expr {$row - 1}]
5042 if {$rm1 < 0 || $idlist eq {}} {
5043 set idlist [make_idlist $row]
5046 set id [lindex $displayorder $rm1]
5047 set col [lsearch -exact $idlist $id]
5048 set idlist [lreplace $idlist $col $col]
5049 foreach p [lindex $parentlist $rm1] {
5050 if {[lsearch -exact $idlist $p] < 0} {
5051 set col [idcol $idlist $p $col]
5052 set idlist [linsert $idlist $col $p]
5053 # if not the first child, we have to insert a line going up
5054 if {$id ne [lindex $children($curview,$p) 0]} {
5055 makeupline $p $rm1 $row $col
5059 set id [lindex $displayorder $row]
5060 if {$row > $downarrowlen} {
5061 set termrow [expr {$row - $downarrowlen - 1}]
5062 foreach p [lindex $parentlist $termrow] {
5063 set i [lsearch -exact $idlist $p]
5064 if {$i < 0} continue
5065 set nr [nextuse $p $termrow]
5066 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5067 set idlist [lreplace $idlist $i $i]
5071 set col [lsearch -exact $idlist $id]
5073 set col [idcol $idlist $id]
5074 set idlist [linsert $idlist $col $id]
5075 if {$children($curview,$id) ne {}} {
5076 makeupline $id $rm1 $row $col
5079 set r [expr {$row + $uparrowlen - 1}]
5080 if {$r < $commitidx($curview)} {
5082 foreach p [lindex $parentlist $r] {
5083 if {[lsearch -exact $idlist $p] >= 0} continue
5084 set fk [lindex $children($curview,$p) 0]
5085 if {[rowofcommit $fk] < $row} {
5086 set x [idcol $idlist $p $x]
5087 set idlist [linsert $idlist $x $p]
5090 if {[incr r] < $commitidx($curview)} {
5091 set p [lindex $displayorder $r]
5092 if {[lsearch -exact $idlist $p] < 0} {
5093 set fk [lindex $children($curview,$p) 0]
5094 if {$fk ne {} && [rowofcommit $fk] < $row} {
5095 set x [idcol $idlist $p $x]
5096 set idlist [linsert $idlist $x $p]
5102 if {$final && !$viewcomplete($curview) &&
5103 $row + $uparrowlen + $mingaplen + $downarrowlen
5104 >= $commitidx($curview)} {
5107 set l [llength $rowidlist]
5109 lappend rowidlist $idlist
5111 lappend rowfinal $final
5112 } elseif {$row < $l} {
5113 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5114 lset rowidlist $row $idlist
5117 lset rowfinal $row $final
5119 set pad [ntimes [expr {$row - $l}] {}]
5120 set rowidlist [concat $rowidlist $pad]
5121 lappend rowidlist $idlist
5122 set rowfinal [concat $rowfinal $pad]
5123 lappend rowfinal $final
5124 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5130 proc changedrow {row} {
5131 global displayorder iddrawn rowisopt need_redisplay
5133 set l [llength $rowisopt]
5135 lset rowisopt $row 0
5136 if {$row + 1 < $l} {
5137 lset rowisopt [expr {$row + 1}] 0
5138 if {$row + 2 < $l} {
5139 lset rowisopt [expr {$row + 2}] 0
5143 set id [lindex $displayorder $row]
5144 if {[info exists iddrawn($id)]} {
5145 set need_redisplay 1
5149 proc insert_pad {row col npad} {
5152 set pad [ntimes $npad {}]
5153 set idlist [lindex $rowidlist $row]
5154 set bef [lrange $idlist 0 [expr {$col - 1}]]
5155 set aft [lrange $idlist $col end]
5156 set i [lsearch -exact $aft {}]
5158 set aft [lreplace $aft $i $i]
5160 lset rowidlist $row [concat $bef $pad $aft]
5164 proc optimize_rows {row col endrow} {
5165 global rowidlist rowisopt displayorder curview children
5170 for {} {$row < $endrow} {incr row; set col 0} {
5171 if {[lindex $rowisopt $row]} continue
5173 set y0 [expr {$row - 1}]
5174 set ym [expr {$row - 2}]
5175 set idlist [lindex $rowidlist $row]
5176 set previdlist [lindex $rowidlist $y0]
5177 if {$idlist eq {} || $previdlist eq {}} continue
5179 set pprevidlist [lindex $rowidlist $ym]
5180 if {$pprevidlist eq {}} continue
5186 for {} {$col < [llength $idlist]} {incr col} {
5187 set id [lindex $idlist $col]
5188 if {[lindex $previdlist $col] eq $id} continue
5193 set x0 [lsearch -exact $previdlist $id]
5194 if {$x0 < 0} continue
5195 set z [expr {$x0 - $col}]
5199 set xm [lsearch -exact $pprevidlist $id]
5201 set z0 [expr {$xm - $x0}]
5205 # if row y0 is the first child of $id then it's not an arrow
5206 if {[lindex $children($curview,$id) 0] ne
5207 [lindex $displayorder $y0]} {
5211 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5212 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5215 # Looking at lines from this row to the previous row,
5216 # make them go straight up if they end in an arrow on
5217 # the previous row; otherwise make them go straight up
5219 if {$z < -1 || ($z < 0 && $isarrow)} {
5220 # Line currently goes left too much;
5221 # insert pads in the previous row, then optimize it
5222 set npad [expr {-1 - $z + $isarrow}]
5223 insert_pad $y0 $x0 $npad
5225 optimize_rows $y0 $x0 $row
5227 set previdlist [lindex $rowidlist $y0]
5228 set x0 [lsearch -exact $previdlist $id]
5229 set z [expr {$x0 - $col}]
5231 set pprevidlist [lindex $rowidlist $ym]
5232 set xm [lsearch -exact $pprevidlist $id]
5233 set z0 [expr {$xm - $x0}]
5235 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5236 # Line currently goes right too much;
5237 # insert pads in this line
5238 set npad [expr {$z - 1 + $isarrow}]
5239 insert_pad $row $col $npad
5240 set idlist [lindex $rowidlist $row]
5242 set z [expr {$x0 - $col}]
5245 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5246 # this line links to its first child on row $row-2
5247 set id [lindex $displayorder $ym]
5248 set xc [lsearch -exact $pprevidlist $id]
5250 set z0 [expr {$xc - $x0}]
5253 # avoid lines jigging left then immediately right
5254 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5255 insert_pad $y0 $x0 1
5257 optimize_rows $y0 $x0 $row
5258 set previdlist [lindex $rowidlist $y0]
5262 # Find the first column that doesn't have a line going right
5263 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5264 set id [lindex $idlist $col]
5265 if {$id eq {}} break
5266 set x0 [lsearch -exact $previdlist $id]
5268 # check if this is the link to the first child
5269 set kid [lindex $displayorder $y0]
5270 if {[lindex $children($curview,$id) 0] eq $kid} {
5271 # it is, work out offset to child
5272 set x0 [lsearch -exact $previdlist $kid]
5275 if {$x0 <= $col} break
5277 # Insert a pad at that column as long as it has a line and
5278 # isn't the last column
5279 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5280 set idlist [linsert $idlist $col {}]
5281 lset rowidlist $row $idlist
5289 global canvx0 linespc
5290 return [expr {$canvx0 + $col * $linespc}]
5294 global canvy0 linespc
5295 return [expr {$canvy0 + $row * $linespc}]
5298 proc linewidth {id} {
5299 global thickerline lthickness
5302 if {[info exists thickerline] && $id eq $thickerline} {
5303 set wid [expr {2 * $lthickness}]
5308 proc rowranges {id} {
5309 global curview children uparrowlen downarrowlen
5312 set kids $children($curview,$id)
5318 foreach child $kids {
5319 if {![commitinview $child $curview]} break
5320 set row [rowofcommit $child]
5321 if {![info exists prev]} {
5322 lappend ret [expr {$row + 1}]
5324 if {$row <= $prevrow} {
5325 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5327 # see if the line extends the whole way from prevrow to row
5328 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5329 [lsearch -exact [lindex $rowidlist \
5330 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5331 # it doesn't, see where it ends
5332 set r [expr {$prevrow + $downarrowlen}]
5333 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5334 while {[incr r -1] > $prevrow &&
5335 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5337 while {[incr r] <= $row &&
5338 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5342 # see where it starts up again
5343 set r [expr {$row - $uparrowlen}]
5344 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5345 while {[incr r] < $row &&
5346 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5348 while {[incr r -1] >= $prevrow &&
5349 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5355 if {$child eq $id} {
5364 proc drawlineseg {id row endrow arrowlow} {
5365 global rowidlist displayorder iddrawn linesegs
5366 global canv colormap linespc curview maxlinelen parentlist
5368 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5369 set le [expr {$row + 1}]
5372 set c [lsearch -exact [lindex $rowidlist $le] $id]
5378 set x [lindex $displayorder $le]
5383 if {[info exists iddrawn($x)] || $le == $endrow} {
5384 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5400 if {[info exists linesegs($id)]} {
5401 set lines $linesegs($id)
5403 set r0 [lindex $li 0]
5405 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5415 set li [lindex $lines [expr {$i-1}]]
5416 set r1 [lindex $li 1]
5417 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5422 set x [lindex $cols [expr {$le - $row}]]
5423 set xp [lindex $cols [expr {$le - 1 - $row}]]
5424 set dir [expr {$xp - $x}]
5426 set ith [lindex $lines $i 2]
5427 set coords [$canv coords $ith]
5428 set ah [$canv itemcget $ith -arrow]
5429 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5430 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5431 if {$x2 ne {} && $x - $x2 == $dir} {
5432 set coords [lrange $coords 0 end-2]
5435 set coords [list [xc $le $x] [yc $le]]
5438 set itl [lindex $lines [expr {$i-1}] 2]
5439 set al [$canv itemcget $itl -arrow]
5440 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5441 } elseif {$arrowlow} {
5442 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5443 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5447 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5448 for {set y $le} {[incr y -1] > $row} {} {
5450 set xp [lindex $cols [expr {$y - 1 - $row}]]
5451 set ndir [expr {$xp - $x}]
5452 if {$dir != $ndir || $xp < 0} {
5453 lappend coords [xc $y $x] [yc $y]
5459 # join parent line to first child
5460 set ch [lindex $displayorder $row]
5461 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5463 puts "oops: drawlineseg: child $ch not on row $row"
5464 } elseif {$xc != $x} {
5465 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5466 set d [expr {int(0.5 * $linespc)}]
5469 set x2 [expr {$x1 - $d}]
5471 set x2 [expr {$x1 + $d}]
5474 set y1 [expr {$y2 + $d}]
5475 lappend coords $x1 $y1 $x2 $y2
5476 } elseif {$xc < $x - 1} {
5477 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5478 } elseif {$xc > $x + 1} {
5479 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5483 lappend coords [xc $row $x] [yc $row]
5485 set xn [xc $row $xp]
5487 lappend coords $xn $yn
5491 set t [$canv create line $coords -width [linewidth $id] \
5492 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5495 set lines [linsert $lines $i [list $row $le $t]]
5497 $canv coords $ith $coords
5498 if {$arrow ne $ah} {
5499 $canv itemconf $ith -arrow $arrow
5501 lset lines $i 0 $row
5504 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5505 set ndir [expr {$xo - $xp}]
5506 set clow [$canv coords $itl]
5507 if {$dir == $ndir} {
5508 set clow [lrange $clow 2 end]
5510 set coords [concat $coords $clow]
5512 lset lines [expr {$i-1}] 1 $le
5514 # coalesce two pieces
5516 set b [lindex $lines [expr {$i-1}] 0]
5517 set e [lindex $lines $i 1]
5518 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5520 $canv coords $itl $coords
5521 if {$arrow ne $al} {
5522 $canv itemconf $itl -arrow $arrow
5526 set linesegs($id) $lines
5530 proc drawparentlinks {id row} {
5531 global rowidlist canv colormap curview parentlist
5532 global idpos linespc
5534 set rowids [lindex $rowidlist $row]
5535 set col [lsearch -exact $rowids $id]
5536 if {$col < 0} return
5537 set olds [lindex $parentlist $row]
5538 set row2 [expr {$row + 1}]
5539 set x [xc $row $col]
5542 set d [expr {int(0.5 * $linespc)}]
5543 set ymid [expr {$y + $d}]
5544 set ids [lindex $rowidlist $row2]
5545 # rmx = right-most X coord used
5548 set i [lsearch -exact $ids $p]
5550 puts "oops, parent $p of $id not in list"
5553 set x2 [xc $row2 $i]
5557 set j [lsearch -exact $rowids $p]
5559 # drawlineseg will do this one for us
5563 # should handle duplicated parents here...
5564 set coords [list $x $y]
5566 # if attaching to a vertical segment, draw a smaller
5567 # slant for visual distinctness
5570 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5572 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5574 } elseif {$i < $col && $i < $j} {
5575 # segment slants towards us already
5576 lappend coords [xc $row $j] $y
5578 if {$i < $col - 1} {
5579 lappend coords [expr {$x2 + $linespc}] $y
5580 } elseif {$i > $col + 1} {
5581 lappend coords [expr {$x2 - $linespc}] $y
5583 lappend coords $x2 $y2
5586 lappend coords $x2 $y2
5588 set t [$canv create line $coords -width [linewidth $p] \
5589 -fill $colormap($p) -tags lines.$p]
5593 if {$rmx > [lindex $idpos($id) 1]} {
5594 lset idpos($id) 1 $rmx
5599 proc drawlines {id} {
5602 $canv itemconf lines.$id -width [linewidth $id]
5605 proc drawcmittext {id row col} {
5606 global linespc canv canv2 canv3 fgcolor curview
5607 global cmitlisted commitinfo rowidlist parentlist
5608 global rowtextx idpos idtags idheads idotherrefs
5609 global linehtag linentag linedtag selectedline
5610 global canvxmax boldids boldnameids fgcolor markedid
5611 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5613 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5614 set listed $cmitlisted($curview,$id)
5615 if {$id eq $nullid} {
5617 } elseif {$id eq $nullid2} {
5619 } elseif {$id eq $mainheadid} {
5622 set ofill [lindex $circlecolors $listed]
5624 set x [xc $row $col]
5626 set orad [expr {$linespc / 3}]
5628 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5629 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5630 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5631 } elseif {$listed == 3} {
5632 # triangle pointing left for left-side commits
5633 set t [$canv create polygon \
5634 [expr {$x - $orad}] $y \
5635 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5636 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5637 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5639 # triangle pointing right for right-side commits
5640 set t [$canv create polygon \
5641 [expr {$x + $orad - 1}] $y \
5642 [expr {$x - $orad}] [expr {$y - $orad}] \
5643 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5644 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5646 set circleitem($row) $t
5648 $canv bind $t <1> {selcanvline {} %x %y}
5649 set rmx [llength [lindex $rowidlist $row]]
5650 set olds [lindex $parentlist $row]
5652 set nextids [lindex $rowidlist [expr {$row + 1}]]
5654 set i [lsearch -exact $nextids $p]
5660 set xt [xc $row $rmx]
5661 set rowtextx($row) $xt
5662 set idpos($id) [list $x $xt $y]
5663 if {[info exists idtags($id)] || [info exists idheads($id)]
5664 || [info exists idotherrefs($id)]} {
5665 set xt [drawtags $id $x $xt $y]
5667 set headline [lindex $commitinfo($id) 0]
5668 set name [lindex $commitinfo($id) 1]
5669 set date [lindex $commitinfo($id) 2]
5670 set date [formatdate $date]
5673 set isbold [ishighlighted $id]
5676 set font mainfontbold
5678 lappend boldnameids $id
5679 set nfont mainfontbold
5682 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5683 -text $headline -font $font -tags text]
5684 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5685 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5686 -text $name -font $nfont -tags text]
5687 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5688 -text $date -font mainfont -tags text]
5689 if {$selectedline == $row} {
5692 if {[info exists markedid] && $markedid eq $id} {
5695 set xr [expr {$xt + [font measure $font $headline]}]
5696 if {$xr > $canvxmax} {
5702 proc drawcmitrow {row} {
5703 global displayorder rowidlist nrows_drawn
5704 global iddrawn markingmatches
5705 global commitinfo numcommits
5706 global filehighlight fhighlights findpattern nhighlights
5707 global hlview vhighlights
5708 global highlight_related rhighlights
5710 if {$row >= $numcommits} return
5712 set id [lindex $displayorder $row]
5713 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5714 askvhighlight $row $id
5716 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5717 askfilehighlight $row $id
5719 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5720 askfindhighlight $row $id
5722 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5723 askrelhighlight $row $id
5725 if {![info exists iddrawn($id)]} {
5726 set col [lsearch -exact [lindex $rowidlist $row] $id]
5728 puts "oops, row $row id $id not in list"
5731 if {![info exists commitinfo($id)]} {
5735 drawcmittext $id $row $col
5739 if {$markingmatches} {
5740 markrowmatches $row $id
5744 proc drawcommits {row {endrow {}}} {
5745 global numcommits iddrawn displayorder curview need_redisplay
5746 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5751 if {$endrow eq {}} {
5754 if {$endrow >= $numcommits} {
5755 set endrow [expr {$numcommits - 1}]
5758 set rl1 [expr {$row - $downarrowlen - 3}]
5762 set ro1 [expr {$row - 3}]
5766 set r2 [expr {$endrow + $uparrowlen + 3}]
5767 if {$r2 > $numcommits} {
5770 for {set r $rl1} {$r < $r2} {incr r} {
5771 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5775 set rl1 [expr {$r + 1}]
5781 optimize_rows $ro1 0 $r2
5782 if {$need_redisplay || $nrows_drawn > 2000} {
5786 # make the lines join to already-drawn rows either side
5787 set r [expr {$row - 1}]
5788 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5791 set er [expr {$endrow + 1}]
5792 if {$er >= $numcommits ||
5793 ![info exists iddrawn([lindex $displayorder $er])]} {
5796 for {} {$r <= $er} {incr r} {
5797 set id [lindex $displayorder $r]
5798 set wasdrawn [info exists iddrawn($id)]
5800 if {$r == $er} break
5801 set nextid [lindex $displayorder [expr {$r + 1}]]
5802 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5803 drawparentlinks $id $r
5805 set rowids [lindex $rowidlist $r]
5806 foreach lid $rowids {
5807 if {$lid eq {}} continue
5808 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5810 # see if this is the first child of any of its parents
5811 foreach p [lindex $parentlist $r] {
5812 if {[lsearch -exact $rowids $p] < 0} {
5813 # make this line extend up to the child
5814 set lineend($p) [drawlineseg $p $r $er 0]
5818 set lineend($lid) [drawlineseg $lid $r $er 1]
5824 proc undolayout {row} {
5825 global uparrowlen mingaplen downarrowlen
5826 global rowidlist rowisopt rowfinal need_redisplay
5828 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5832 if {[llength $rowidlist] > $r} {
5834 set rowidlist [lrange $rowidlist 0 $r]
5835 set rowfinal [lrange $rowfinal 0 $r]
5836 set rowisopt [lrange $rowisopt 0 $r]
5837 set need_redisplay 1
5842 proc drawvisible {} {
5843 global canv linespc curview vrowmod selectedline targetrow targetid
5844 global need_redisplay cscroll numcommits
5846 set fs [$canv yview]
5847 set ymax [lindex [$canv cget -scrollregion] 3]
5848 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5849 set f0 [lindex $fs 0]
5850 set f1 [lindex $fs 1]
5851 set y0 [expr {int($f0 * $ymax)}]
5852 set y1 [expr {int($f1 * $ymax)}]
5854 if {[info exists targetid]} {
5855 if {[commitinview $targetid $curview]} {
5856 set r [rowofcommit $targetid]
5857 if {$r != $targetrow} {
5858 # Fix up the scrollregion and change the scrolling position
5859 # now that our target row has moved.
5860 set diff [expr {($r - $targetrow) * $linespc}]
5863 set ymax [lindex [$canv cget -scrollregion] 3]
5866 set f0 [expr {$y0 / $ymax}]
5867 set f1 [expr {$y1 / $ymax}]
5868 allcanvs yview moveto $f0
5869 $cscroll set $f0 $f1
5870 set need_redisplay 1
5877 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5878 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5879 if {$endrow >= $vrowmod($curview)} {
5880 update_arcrows $curview
5882 if {$selectedline ne {} &&
5883 $row <= $selectedline && $selectedline <= $endrow} {
5884 set targetrow $selectedline
5885 } elseif {[info exists targetid]} {
5886 set targetrow [expr {int(($row + $endrow) / 2)}]
5888 if {[info exists targetrow]} {
5889 if {$targetrow >= $numcommits} {
5890 set targetrow [expr {$numcommits - 1}]
5892 set targetid [commitonrow $targetrow]
5894 drawcommits $row $endrow
5897 proc clear_display {} {
5898 global iddrawn linesegs need_redisplay nrows_drawn
5899 global vhighlights fhighlights nhighlights rhighlights
5900 global linehtag linentag linedtag boldids boldnameids
5903 catch {unset iddrawn}
5904 catch {unset linesegs}
5905 catch {unset linehtag}
5906 catch {unset linentag}
5907 catch {unset linedtag}
5910 catch {unset vhighlights}
5911 catch {unset fhighlights}
5912 catch {unset nhighlights}
5913 catch {unset rhighlights}
5914 set need_redisplay 0
5918 proc findcrossings {id} {
5919 global rowidlist parentlist numcommits displayorder
5923 foreach {s e} [rowranges $id] {
5924 if {$e >= $numcommits} {
5925 set e [expr {$numcommits - 1}]
5927 if {$e <= $s} continue
5928 for {set row $e} {[incr row -1] >= $s} {} {
5929 set x [lsearch -exact [lindex $rowidlist $row] $id]
5931 set olds [lindex $parentlist $row]
5932 set kid [lindex $displayorder $row]
5933 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5934 if {$kidx < 0} continue
5935 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5937 set px [lsearch -exact $nextrow $p]
5938 if {$px < 0} continue
5939 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5940 if {[lsearch -exact $ccross $p] >= 0} continue
5941 if {$x == $px + ($kidx < $px? -1: 1)} {
5943 } elseif {[lsearch -exact $cross $p] < 0} {
5950 return [concat $ccross {{}} $cross]
5953 proc assigncolor {id} {
5954 global colormap colors nextcolor
5955 global parents children children curview
5957 if {[info exists colormap($id)]} return
5958 set ncolors [llength $colors]
5959 if {[info exists children($curview,$id)]} {
5960 set kids $children($curview,$id)
5964 if {[llength $kids] == 1} {
5965 set child [lindex $kids 0]
5966 if {[info exists colormap($child)]
5967 && [llength $parents($curview,$child)] == 1} {
5968 set colormap($id) $colormap($child)
5974 foreach x [findcrossings $id] {
5976 # delimiter between corner crossings and other crossings
5977 if {[llength $badcolors] >= $ncolors - 1} break
5978 set origbad $badcolors
5980 if {[info exists colormap($x)]
5981 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5982 lappend badcolors $colormap($x)
5985 if {[llength $badcolors] >= $ncolors} {
5986 set badcolors $origbad
5988 set origbad $badcolors
5989 if {[llength $badcolors] < $ncolors - 1} {
5990 foreach child $kids {
5991 if {[info exists colormap($child)]
5992 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5993 lappend badcolors $colormap($child)
5995 foreach p $parents($curview,$child) {
5996 if {[info exists colormap($p)]
5997 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5998 lappend badcolors $colormap($p)
6002 if {[llength $badcolors] >= $ncolors} {
6003 set badcolors $origbad
6006 for {set i 0} {$i <= $ncolors} {incr i} {
6007 set c [lindex $colors $nextcolor]
6008 if {[incr nextcolor] >= $ncolors} {
6011 if {[lsearch -exact $badcolors $c]} break
6013 set colormap($id) $c
6016 proc bindline {t id} {
6019 $canv bind $t <Enter> "lineenter %x %y $id"
6020 $canv bind $t <Motion> "linemotion %x %y $id"
6021 $canv bind $t <Leave> "lineleave $id"
6022 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6025 proc drawtags {id x xt y1} {
6026 global idtags idheads idotherrefs mainhead
6027 global linespc lthickness
6028 global canv rowtextx curview fgcolor bgcolor ctxbut
6033 if {[info exists idtags($id)]} {
6034 set marks $idtags($id)
6035 set ntags [llength $marks]
6037 if {[info exists idheads($id)]} {
6038 set marks [concat $marks $idheads($id)]
6039 set nheads [llength $idheads($id)]
6041 if {[info exists idotherrefs($id)]} {
6042 set marks [concat $marks $idotherrefs($id)]
6048 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6049 set yt [expr {$y1 - 0.5 * $linespc}]
6050 set yb [expr {$yt + $linespc - 1}]
6054 foreach tag $marks {
6056 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6057 set wid [font measure mainfontbold $tag]
6059 set wid [font measure mainfont $tag]
6063 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6065 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6066 -width $lthickness -fill black -tags tag.$id]
6068 foreach tag $marks x $xvals wid $wvals {
6069 set xl [expr {$x + $delta}]
6070 set xr [expr {$x + $delta + $wid + $lthickness}]
6072 if {[incr ntags -1] >= 0} {
6074 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6075 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6076 -width 1 -outline black -fill yellow -tags tag.$id]
6077 $canv bind $t <1> [list showtag $tag 1]
6078 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6080 # draw a head or other ref
6081 if {[incr nheads -1] >= 0} {
6083 if {$tag eq $mainhead} {
6084 set font mainfontbold
6089 set xl [expr {$xl - $delta/2}]
6090 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6091 -width 1 -outline black -fill $col -tags tag.$id
6092 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6093 set rwid [font measure mainfont $remoteprefix]
6094 set xi [expr {$x + 1}]
6095 set yti [expr {$yt + 1}]
6096 set xri [expr {$x + $rwid}]
6097 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6098 -width 0 -fill "#ffddaa" -tags tag.$id
6101 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6102 -font $font -tags [list tag.$id text]]
6104 $canv bind $t <1> [list showtag $tag 1]
6105 } elseif {$nheads >= 0} {
6106 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
6112 proc xcoord {i level ln} {
6113 global canvx0 xspc1 xspc2
6115 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6116 if {$i > 0 && $i == $level} {
6117 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6118 } elseif {$i > $level} {
6119 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6124 proc show_status {msg} {
6128 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6129 -tags text -fill $fgcolor
6132 # Don't change the text pane cursor if it is currently the hand cursor,
6133 # showing that we are over a sha1 ID link.
6134 proc settextcursor {c} {
6135 global ctext curtextcursor
6137 if {[$ctext cget -cursor] == $curtextcursor} {
6138 $ctext config -cursor $c
6140 set curtextcursor $c
6143 proc nowbusy {what {name {}}} {
6144 global isbusy busyname statusw
6146 if {[array names isbusy] eq {}} {
6147 . config -cursor watch
6151 set busyname($what) $name
6153 $statusw conf -text $name
6157 proc notbusy {what} {
6158 global isbusy maincursor textcursor busyname statusw
6162 if {$busyname($what) ne {} &&
6163 [$statusw cget -text] eq $busyname($what)} {
6164 $statusw conf -text {}
6167 if {[array names isbusy] eq {}} {
6168 . config -cursor $maincursor
6169 settextcursor $textcursor
6173 proc findmatches {f} {
6174 global findtype findstring
6175 if {$findtype == [mc "Regexp"]} {
6176 set matches [regexp -indices -all -inline $findstring $f]
6179 if {$findtype == [mc "IgnCase"]} {
6180 set f [string tolower $f]
6181 set fs [string tolower $fs]
6185 set l [string length $fs]
6186 while {[set j [string first $fs $f $i]] >= 0} {
6187 lappend matches [list $j [expr {$j+$l-1}]]
6188 set i [expr {$j + $l}]
6194 proc dofind {{dirn 1} {wrap 1}} {
6195 global findstring findstartline findcurline selectedline numcommits
6196 global gdttype filehighlight fh_serial find_dirn findallowwrap
6198 if {[info exists find_dirn]} {
6199 if {$find_dirn == $dirn} return
6203 if {$findstring eq {} || $numcommits == 0} return
6204 if {$selectedline eq {}} {
6205 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6207 set findstartline $selectedline
6209 set findcurline $findstartline
6210 nowbusy finding [mc "Searching"]
6211 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6212 after cancel do_file_hl $fh_serial
6213 do_file_hl $fh_serial
6216 set findallowwrap $wrap
6220 proc stopfinding {} {
6221 global find_dirn findcurline fprogcoord
6223 if {[info exists find_dirn]} {
6234 global commitdata commitinfo numcommits findpattern findloc
6235 global findstartline findcurline findallowwrap
6236 global find_dirn gdttype fhighlights fprogcoord
6237 global curview varcorder vrownum varccommits vrowmod
6239 if {![info exists find_dirn]} {
6242 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6245 if {$find_dirn > 0} {
6247 if {$l >= $numcommits} {
6250 if {$l <= $findstartline} {
6251 set lim [expr {$findstartline + 1}]
6254 set moretodo $findallowwrap
6261 if {$l >= $findstartline} {
6262 set lim [expr {$findstartline - 1}]
6265 set moretodo $findallowwrap
6268 set n [expr {($lim - $l) * $find_dirn}]
6273 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6274 update_arcrows $curview
6278 set ai [bsearch $vrownum($curview) $l]
6279 set a [lindex $varcorder($curview) $ai]
6280 set arow [lindex $vrownum($curview) $ai]
6281 set ids [lindex $varccommits($curview,$a)]
6282 set arowend [expr {$arow + [llength $ids]}]
6283 if {$gdttype eq [mc "containing:"]} {
6284 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6285 if {$l < $arow || $l >= $arowend} {
6287 set a [lindex $varcorder($curview) $ai]
6288 set arow [lindex $vrownum($curview) $ai]
6289 set ids [lindex $varccommits($curview,$a)]
6290 set arowend [expr {$arow + [llength $ids]}]
6292 set id [lindex $ids [expr {$l - $arow}]]
6293 # shouldn't happen unless git log doesn't give all the commits...
6294 if {![info exists commitdata($id)] ||
6295 ![doesmatch $commitdata($id)]} {
6298 if {![info exists commitinfo($id)]} {
6301 set info $commitinfo($id)
6302 foreach f $info ty $fldtypes {
6303 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6312 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6313 if {$l < $arow || $l >= $arowend} {
6315 set a [lindex $varcorder($curview) $ai]
6316 set arow [lindex $vrownum($curview) $ai]
6317 set ids [lindex $varccommits($curview,$a)]
6318 set arowend [expr {$arow + [llength $ids]}]
6320 set id [lindex $ids [expr {$l - $arow}]]
6321 if {![info exists fhighlights($id)]} {
6322 # this sets fhighlights($id) to -1
6323 askfilehighlight $l $id
6325 if {$fhighlights($id) > 0} {
6329 if {$fhighlights($id) < 0} {
6332 set findcurline [expr {$l - $find_dirn}]
6337 if {$found || ($domore && !$moretodo)} {
6353 set findcurline [expr {$l - $find_dirn}]
6355 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6359 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6364 proc findselectline {l} {
6365 global findloc commentend ctext findcurline markingmatches gdttype
6367 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6370 if {$markingmatches &&
6371 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6372 # highlight the matches in the comments
6373 set f [$ctext get 1.0 $commentend]
6374 set matches [findmatches $f]
6375 foreach match $matches {
6376 set start [lindex $match 0]
6377 set end [expr {[lindex $match 1] + 1}]
6378 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6384 # mark the bits of a headline or author that match a find string
6385 proc markmatches {canv l str tag matches font row} {
6388 set bbox [$canv bbox $tag]
6389 set x0 [lindex $bbox 0]
6390 set y0 [lindex $bbox 1]
6391 set y1 [lindex $bbox 3]
6392 foreach match $matches {
6393 set start [lindex $match 0]
6394 set end [lindex $match 1]
6395 if {$start > $end} continue
6396 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6397 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6398 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6399 [expr {$x0+$xlen+2}] $y1 \
6400 -outline {} -tags [list match$l matches] -fill yellow]
6402 if {$row == $selectedline} {
6403 $canv raise $t secsel
6408 proc unmarkmatches {} {
6409 global markingmatches
6411 allcanvs delete matches
6412 set markingmatches 0
6416 proc selcanvline {w x y} {
6417 global canv canvy0 ctext linespc
6419 set ymax [lindex [$canv cget -scrollregion] 3]
6420 if {$ymax == {}} return
6421 set yfrac [lindex [$canv yview] 0]
6422 set y [expr {$y + $yfrac * $ymax}]
6423 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6428 set xmax [lindex [$canv cget -scrollregion] 2]
6429 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6430 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6436 proc commit_descriptor {p} {
6438 if {![info exists commitinfo($p)]} {
6442 if {[llength $commitinfo($p)] > 1} {
6443 set l [lindex $commitinfo($p) 0]
6448 # append some text to the ctext widget, and make any SHA1 ID
6449 # that we know about be a clickable link.
6450 proc appendwithlinks {text tags} {
6451 global ctext linknum curview
6453 set start [$ctext index "end - 1c"]
6454 $ctext insert end $text $tags
6455 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6459 set linkid [string range $text $s $e]
6461 $ctext tag delete link$linknum
6462 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6463 setlink $linkid link$linknum
6468 proc setlink {id lk} {
6469 global curview ctext pendinglinks
6472 if {[string length $id] < 40} {
6473 set matches [longid $id]
6474 if {[llength $matches] > 0} {
6475 if {[llength $matches] > 1} return
6477 set id [lindex $matches 0]
6480 set known [commitinview $id $curview]
6483 $ctext tag conf $lk -foreground blue -underline 1
6484 $ctext tag bind $lk <1> [list selbyid $id]
6485 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6486 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6488 lappend pendinglinks($id) $lk
6489 interestedin $id {makelink %P}
6493 proc appendshortlink {id {pre {}} {post {}}} {
6494 global ctext linknum
6496 $ctext insert end $pre
6497 $ctext tag delete link$linknum
6498 $ctext insert end [string range $id 0 7] link$linknum
6499 $ctext insert end $post
6500 setlink $id link$linknum
6504 proc makelink {id} {
6507 if {![info exists pendinglinks($id)]} return
6508 foreach lk $pendinglinks($id) {
6511 unset pendinglinks($id)
6514 proc linkcursor {w inc} {
6515 global linkentercount curtextcursor
6517 if {[incr linkentercount $inc] > 0} {
6518 $w configure -cursor hand2
6520 $w configure -cursor $curtextcursor
6521 if {$linkentercount < 0} {
6522 set linkentercount 0
6527 proc viewnextline {dir} {
6531 set ymax [lindex [$canv cget -scrollregion] 3]
6532 set wnow [$canv yview]
6533 set wtop [expr {[lindex $wnow 0] * $ymax}]
6534 set newtop [expr {$wtop + $dir * $linespc}]
6537 } elseif {$newtop > $ymax} {
6540 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6543 # add a list of tag or branch names at position pos
6544 # returns the number of names inserted
6545 proc appendrefs {pos ids var} {
6546 global ctext linknum curview $var maxrefs
6548 if {[catch {$ctext index $pos}]} {
6551 $ctext conf -state normal
6552 $ctext delete $pos "$pos lineend"
6555 foreach tag [set $var\($id\)] {
6556 lappend tags [list $tag $id]
6559 if {[llength $tags] > $maxrefs} {
6560 $ctext insert $pos "[mc "many"] ([llength $tags])"
6562 set tags [lsort -index 0 -decreasing $tags]
6565 set id [lindex $ti 1]
6568 $ctext tag delete $lk
6569 $ctext insert $pos $sep
6570 $ctext insert $pos [lindex $ti 0] $lk
6575 $ctext conf -state disabled
6576 return [llength $tags]
6579 # called when we have finished computing the nearby tags
6580 proc dispneartags {delay} {
6581 global selectedline currentid showneartags tagphase
6583 if {$selectedline eq {} || !$showneartags} return
6584 after cancel dispnexttag
6586 after 200 dispnexttag
6589 after idle dispnexttag
6594 proc dispnexttag {} {
6595 global selectedline currentid showneartags tagphase ctext
6597 if {$selectedline eq {} || !$showneartags} return
6598 switch -- $tagphase {
6600 set dtags [desctags $currentid]
6602 appendrefs precedes $dtags idtags
6606 set atags [anctags $currentid]
6608 appendrefs follows $atags idtags
6612 set dheads [descheads $currentid]
6613 if {$dheads ne {}} {
6614 if {[appendrefs branch $dheads idheads] > 1
6615 && [$ctext get "branch -3c"] eq "h"} {
6616 # turn "Branch" into "Branches"
6617 $ctext conf -state normal
6618 $ctext insert "branch -2c" "es"
6619 $ctext conf -state disabled
6624 if {[incr tagphase] <= 2} {
6625 after idle dispnexttag
6629 proc make_secsel {id} {
6630 global linehtag linentag linedtag canv canv2 canv3
6632 if {![info exists linehtag($id)]} return
6634 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6635 -tags secsel -fill [$canv cget -selectbackground]]
6637 $canv2 delete secsel
6638 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6639 -tags secsel -fill [$canv2 cget -selectbackground]]
6641 $canv3 delete secsel
6642 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6643 -tags secsel -fill [$canv3 cget -selectbackground]]
6647 proc make_idmark {id} {
6648 global linehtag canv fgcolor
6650 if {![info exists linehtag($id)]} return
6652 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6653 -tags markid -outline $fgcolor]
6657 proc selectline {l isnew {desired_loc {}}} {
6658 global canv ctext commitinfo selectedline
6659 global canvy0 linespc parents children curview
6660 global currentid sha1entry
6661 global commentend idtags linknum
6662 global mergemax numcommits pending_select
6663 global cmitmode showneartags allcommits
6664 global targetrow targetid lastscrollrows
6665 global autoselect jump_to_here
6667 catch {unset pending_select}
6672 if {$l < 0 || $l >= $numcommits} return
6673 set id [commitonrow $l]
6678 if {$lastscrollrows < $numcommits} {
6682 set y [expr {$canvy0 + $l * $linespc}]
6683 set ymax [lindex [$canv cget -scrollregion] 3]
6684 set ytop [expr {$y - $linespc - 1}]
6685 set ybot [expr {$y + $linespc + 1}]
6686 set wnow [$canv yview]
6687 set wtop [expr {[lindex $wnow 0] * $ymax}]
6688 set wbot [expr {[lindex $wnow 1] * $ymax}]
6689 set wh [expr {$wbot - $wtop}]
6691 if {$ytop < $wtop} {
6692 if {$ybot < $wtop} {
6693 set newtop [expr {$y - $wh / 2.0}]
6696 if {$newtop > $wtop - $linespc} {
6697 set newtop [expr {$wtop - $linespc}]
6700 } elseif {$ybot > $wbot} {
6701 if {$ytop > $wbot} {
6702 set newtop [expr {$y - $wh / 2.0}]
6704 set newtop [expr {$ybot - $wh}]
6705 if {$newtop < $wtop + $linespc} {
6706 set newtop [expr {$wtop + $linespc}]
6710 if {$newtop != $wtop} {
6714 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6721 addtohistory [list selbyid $id]
6724 $sha1entry delete 0 end
6725 $sha1entry insert 0 $id
6727 $sha1entry selection from 0
6728 $sha1entry selection to end
6732 $ctext conf -state normal
6735 if {![info exists commitinfo($id)]} {
6738 set info $commitinfo($id)
6739 set date [formatdate [lindex $info 2]]
6740 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6741 set date [formatdate [lindex $info 4]]
6742 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6743 if {[info exists idtags($id)]} {
6744 $ctext insert end [mc "Tags:"]
6745 foreach tag $idtags($id) {
6746 $ctext insert end " $tag"
6748 $ctext insert end "\n"
6752 set olds $parents($curview,$id)
6753 if {[llength $olds] > 1} {
6756 if {$np >= $mergemax} {
6761 $ctext insert end "[mc "Parent"]: " $tag
6762 appendwithlinks [commit_descriptor $p] {}
6767 append headers "[mc "Parent"]: [commit_descriptor $p]"
6771 foreach c $children($curview,$id) {
6772 append headers "[mc "Child"]: [commit_descriptor $c]"
6775 # make anything that looks like a SHA1 ID be a clickable link
6776 appendwithlinks $headers {}
6777 if {$showneartags} {
6778 if {![info exists allcommits]} {
6781 $ctext insert end "[mc "Branch"]: "
6782 $ctext mark set branch "end -1c"
6783 $ctext mark gravity branch left
6784 $ctext insert end "\n[mc "Follows"]: "
6785 $ctext mark set follows "end -1c"
6786 $ctext mark gravity follows left
6787 $ctext insert end "\n[mc "Precedes"]: "
6788 $ctext mark set precedes "end -1c"
6789 $ctext mark gravity precedes left
6790 $ctext insert end "\n"
6793 $ctext insert end "\n"
6794 set comment [lindex $info 5]
6795 if {[string first "\r" $comment] >= 0} {
6796 set comment [string map {"\r" "\n "} $comment]
6798 appendwithlinks $comment {comment}
6800 $ctext tag remove found 1.0 end
6801 $ctext conf -state disabled
6802 set commentend [$ctext index "end - 1c"]
6804 set jump_to_here $desired_loc
6805 init_flist [mc "Comments"]
6806 if {$cmitmode eq "tree"} {
6808 } elseif {[llength $olds] <= 1} {
6815 proc selfirstline {} {
6820 proc sellastline {} {
6823 set l [expr {$numcommits - 1}]
6827 proc selnextline {dir} {
6830 if {$selectedline eq {}} return
6831 set l [expr {$selectedline + $dir}]
6836 proc selnextpage {dir} {
6837 global canv linespc selectedline numcommits
6839 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6843 allcanvs yview scroll [expr {$dir * $lpp}] units
6845 if {$selectedline eq {}} return
6846 set l [expr {$selectedline + $dir * $lpp}]
6849 } elseif {$l >= $numcommits} {
6850 set l [expr $numcommits - 1]
6856 proc unselectline {} {
6857 global selectedline currentid
6860 catch {unset currentid}
6861 allcanvs delete secsel
6865 proc reselectline {} {
6868 if {$selectedline ne {}} {
6869 selectline $selectedline 0
6873 proc addtohistory {cmd} {
6874 global history historyindex curview
6876 set elt [list $curview $cmd]
6877 if {$historyindex > 0
6878 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6882 if {$historyindex < [llength $history]} {
6883 set history [lreplace $history $historyindex end $elt]
6885 lappend history $elt
6888 if {$historyindex > 1} {
6889 .tf.bar.leftbut conf -state normal
6891 .tf.bar.leftbut conf -state disabled
6893 .tf.bar.rightbut conf -state disabled
6899 set view [lindex $elt 0]
6900 set cmd [lindex $elt 1]
6901 if {$curview != $view} {
6908 global history historyindex
6911 if {$historyindex > 1} {
6912 incr historyindex -1
6913 godo [lindex $history [expr {$historyindex - 1}]]
6914 .tf.bar.rightbut conf -state normal
6916 if {$historyindex <= 1} {
6917 .tf.bar.leftbut conf -state disabled
6922 global history historyindex
6925 if {$historyindex < [llength $history]} {
6926 set cmd [lindex $history $historyindex]
6929 .tf.bar.leftbut conf -state normal
6931 if {$historyindex >= [llength $history]} {
6932 .tf.bar.rightbut conf -state disabled
6937 global treefilelist treeidlist diffids diffmergeid treepending
6938 global nullid nullid2
6941 catch {unset diffmergeid}
6942 if {![info exists treefilelist($id)]} {
6943 if {![info exists treepending]} {
6944 if {$id eq $nullid} {
6945 set cmd [list | git ls-files]
6946 } elseif {$id eq $nullid2} {
6947 set cmd [list | git ls-files --stage -t]
6949 set cmd [list | git ls-tree -r $id]
6951 if {[catch {set gtf [open $cmd r]}]} {
6955 set treefilelist($id) {}
6956 set treeidlist($id) {}
6957 fconfigure $gtf -blocking 0 -encoding binary
6958 filerun $gtf [list gettreeline $gtf $id]
6965 proc gettreeline {gtf id} {
6966 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6969 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6970 if {$diffids eq $nullid} {
6973 set i [string first "\t" $line]
6974 if {$i < 0} continue
6975 set fname [string range $line [expr {$i+1}] end]
6976 set line [string range $line 0 [expr {$i-1}]]
6977 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6978 set sha1 [lindex $line 2]
6979 lappend treeidlist($id) $sha1
6981 if {[string index $fname 0] eq "\""} {
6982 set fname [lindex $fname 0]
6984 set fname [encoding convertfrom $fname]
6985 lappend treefilelist($id) $fname
6988 return [expr {$nl >= 1000? 2: 1}]
6992 if {$cmitmode ne "tree"} {
6993 if {![info exists diffmergeid]} {
6994 gettreediffs $diffids
6996 } elseif {$id ne $diffids} {
7005 global treefilelist treeidlist diffids nullid nullid2
7006 global ctext_file_names ctext_file_lines
7007 global ctext commentend
7009 set i [lsearch -exact $treefilelist($diffids) $f]
7011 puts "oops, $f not in list for id $diffids"
7014 if {$diffids eq $nullid} {
7015 if {[catch {set bf [open $f r]} err]} {
7016 puts "oops, can't read $f: $err"
7020 set blob [lindex $treeidlist($diffids) $i]
7021 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7022 puts "oops, error reading blob $blob: $err"
7026 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7027 filerun $bf [list getblobline $bf $diffids]
7028 $ctext config -state normal
7029 clear_ctext $commentend
7030 lappend ctext_file_names $f
7031 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7032 $ctext insert end "\n"
7033 $ctext insert end "$f\n" filesep
7034 $ctext config -state disabled
7035 $ctext yview $commentend
7039 proc getblobline {bf id} {
7040 global diffids cmitmode ctext
7042 if {$id ne $diffids || $cmitmode ne "tree"} {
7046 $ctext config -state normal
7048 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7049 $ctext insert end "$line\n"
7052 global jump_to_here ctext_file_names commentend
7054 # delete last newline
7055 $ctext delete "end - 2c" "end - 1c"
7057 if {$jump_to_here ne {} &&
7058 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7059 set lnum [expr {[lindex $jump_to_here 1] +
7060 [lindex [split $commentend .] 0]}]
7061 mark_ctext_line $lnum
7065 $ctext config -state disabled
7066 return [expr {$nl >= 1000? 2: 1}]
7069 proc mark_ctext_line {lnum} {
7070 global ctext markbgcolor
7072 $ctext tag delete omark
7073 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7074 $ctext tag conf omark -background $markbgcolor
7078 proc mergediff {id} {
7080 global diffids treediffs
7081 global parents curview
7085 set treediffs($id) {}
7086 set np [llength $parents($curview,$id)]
7091 proc startdiff {ids} {
7092 global treediffs diffids treepending diffmergeid nullid nullid2
7096 catch {unset diffmergeid}
7097 if {![info exists treediffs($ids)] ||
7098 [lsearch -exact $ids $nullid] >= 0 ||
7099 [lsearch -exact $ids $nullid2] >= 0} {
7100 if {![info exists treepending]} {
7108 proc path_filter {filter name} {
7110 set l [string length $p]
7111 if {[string index $p end] eq "/"} {
7112 if {[string compare -length $l $p $name] == 0} {
7116 if {[string compare -length $l $p $name] == 0 &&
7117 ([string length $name] == $l ||
7118 [string index $name $l] eq "/")} {
7126 proc addtocflist {ids} {
7129 add_flist $treediffs($ids)
7133 proc diffcmd {ids flags} {
7134 global nullid nullid2
7136 set i [lsearch -exact $ids $nullid]
7137 set j [lsearch -exact $ids $nullid2]
7139 if {[llength $ids] > 1 && $j < 0} {
7140 # comparing working directory with some specific revision
7141 set cmd [concat | git diff-index $flags]
7143 lappend cmd -R [lindex $ids 1]
7145 lappend cmd [lindex $ids 0]
7148 # comparing working directory with index
7149 set cmd [concat | git diff-files $flags]
7154 } elseif {$j >= 0} {
7155 set cmd [concat | git diff-index --cached $flags]
7156 if {[llength $ids] > 1} {
7157 # comparing index with specific revision
7159 lappend cmd -R [lindex $ids 1]
7161 lappend cmd [lindex $ids 0]
7164 # comparing index with HEAD
7168 set cmd [concat | git diff-tree -r $flags $ids]
7173 proc gettreediffs {ids} {
7174 global treediff treepending
7176 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7178 set treepending $ids
7180 fconfigure $gdtf -blocking 0 -encoding binary
7181 filerun $gdtf [list gettreediffline $gdtf $ids]
7184 proc gettreediffline {gdtf ids} {
7185 global treediff treediffs treepending diffids diffmergeid
7186 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7191 if {$perfile_attrs} {
7192 # cache_gitattr is slow, and even slower on win32 where we
7193 # have to invoke it for only about 30 paths at a time
7195 if {[tk windowingsystem] == "win32"} {
7199 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7200 set i [string first "\t" $line]
7202 set file [string range $line [expr {$i+1}] end]
7203 if {[string index $file 0] eq "\""} {
7204 set file [lindex $file 0]
7206 set file [encoding convertfrom $file]
7207 if {$file ne [lindex $treediff end]} {
7208 lappend treediff $file
7209 lappend sublist $file
7213 if {$perfile_attrs} {
7214 cache_gitattr encoding $sublist
7217 return [expr {$nr >= $max? 2: 1}]
7220 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7222 foreach f $treediff {
7223 if {[path_filter $vfilelimit($curview) $f]} {
7227 set treediffs($ids) $flist
7229 set treediffs($ids) $treediff
7232 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7234 } elseif {$ids != $diffids} {
7235 if {![info exists diffmergeid]} {
7236 gettreediffs $diffids
7244 # empty string or positive integer
7245 proc diffcontextvalidate {v} {
7246 return [regexp {^(|[1-9][0-9]*)$} $v]
7249 proc diffcontextchange {n1 n2 op} {
7250 global diffcontextstring diffcontext
7252 if {[string is integer -strict $diffcontextstring]} {
7253 if {$diffcontextstring > 0} {
7254 set diffcontext $diffcontextstring
7260 proc changeignorespace {} {
7264 proc getblobdiffs {ids} {
7265 global blobdifffd diffids env
7266 global diffinhdr treediffs
7269 global limitdiffs vfilelimit curview
7270 global diffencoding targetline diffnparents
7272 set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
7276 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7277 set cmd [concat $cmd -- $vfilelimit($curview)]
7279 if {[catch {set bdf [open $cmd r]} err]} {
7280 error_popup [mc "Error getting diffs: %s" $err]
7286 set diffencoding [get_path_encoding {}]
7287 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7288 set blobdifffd($ids) $bdf
7289 filerun $bdf [list getblobdiffline $bdf $diffids]
7292 proc setinlist {var i val} {
7295 while {[llength [set $var]] < $i} {
7298 if {[llength [set $var]] == $i} {
7305 proc makediffhdr {fname ids} {
7306 global ctext curdiffstart treediffs diffencoding
7307 global ctext_file_names jump_to_here targetline diffline
7309 set fname [encoding convertfrom $fname]
7310 set diffencoding [get_path_encoding $fname]
7311 set i [lsearch -exact $treediffs($ids) $fname]
7313 setinlist difffilestart $i $curdiffstart
7315 lset ctext_file_names end $fname
7316 set l [expr {(78 - [string length $fname]) / 2}]
7317 set pad [string range "----------------------------------------" 1 $l]
7318 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7320 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7321 set targetline [lindex $jump_to_here 1]
7326 proc getblobdiffline {bdf ids} {
7327 global diffids blobdifffd ctext curdiffstart
7328 global diffnexthead diffnextnote difffilestart
7329 global ctext_file_names ctext_file_lines
7330 global diffinhdr treediffs mergemax diffnparents
7331 global diffencoding jump_to_here targetline diffline
7334 $ctext conf -state normal
7335 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7336 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7340 if {![string compare -length 5 "diff " $line]} {
7341 if {![regexp {^diff (--cc|--git) } $line m type]} {
7342 set line [encoding convertfrom $line]
7343 $ctext insert end "$line\n" hunksep
7346 # start of a new file
7348 $ctext insert end "\n"
7349 set curdiffstart [$ctext index "end - 1c"]
7350 lappend ctext_file_names ""
7351 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7352 $ctext insert end "\n" filesep
7354 if {$type eq "--cc"} {
7355 # start of a new file in a merge diff
7356 set fname [string range $line 10 end]
7357 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7358 lappend treediffs($ids) $fname
7359 add_flist [list $fname]
7363 set line [string range $line 11 end]
7364 # If the name hasn't changed the length will be odd,
7365 # the middle char will be a space, and the two bits either
7366 # side will be a/name and b/name, or "a/name" and "b/name".
7367 # If the name has changed we'll get "rename from" and
7368 # "rename to" or "copy from" and "copy to" lines following
7369 # this, and we'll use them to get the filenames.
7370 # This complexity is necessary because spaces in the
7371 # filename(s) don't get escaped.
7372 set l [string length $line]
7373 set i [expr {$l / 2}]
7374 if {!(($l & 1) && [string index $line $i] eq " " &&
7375 [string range $line 2 [expr {$i - 1}]] eq \
7376 [string range $line [expr {$i + 3}] end])} {
7379 # unescape if quoted and chop off the a/ from the front
7380 if {[string index $line 0] eq "\""} {
7381 set fname [string range [lindex $line 0] 2 end]
7383 set fname [string range $line 2 [expr {$i - 1}]]
7386 makediffhdr $fname $ids
7388 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7389 set fname [encoding convertfrom [string range $line 16 end]]
7390 $ctext insert end "\n"
7391 set curdiffstart [$ctext index "end - 1c"]
7392 lappend ctext_file_names $fname
7393 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7394 $ctext insert end "$line\n" filesep
7395 set i [lsearch -exact $treediffs($ids) $fname]
7397 setinlist difffilestart $i $curdiffstart
7400 } elseif {![string compare -length 2 "@@" $line]} {
7401 regexp {^@@+} $line ats
7402 set line [encoding convertfrom $diffencoding $line]
7403 $ctext insert end "$line\n" hunksep
7404 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7407 set diffnparents [expr {[string length $ats] - 1}]
7410 } elseif {$diffinhdr} {
7411 if {![string compare -length 12 "rename from " $line]} {
7412 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7413 if {[string index $fname 0] eq "\""} {
7414 set fname [lindex $fname 0]
7416 set fname [encoding convertfrom $fname]
7417 set i [lsearch -exact $treediffs($ids) $fname]
7419 setinlist difffilestart $i $curdiffstart
7421 } elseif {![string compare -length 10 $line "rename to "] ||
7422 ![string compare -length 8 $line "copy to "]} {
7423 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7424 if {[string index $fname 0] eq "\""} {
7425 set fname [lindex $fname 0]
7427 makediffhdr $fname $ids
7428 } elseif {[string compare -length 3 $line "---"] == 0} {
7431 } elseif {[string compare -length 3 $line "+++"] == 0} {
7435 $ctext insert end "$line\n" filesep
7438 set line [string map {\x1A ^Z} \
7439 [encoding convertfrom $diffencoding $line]]
7440 # parse the prefix - one ' ', '-' or '+' for each parent
7441 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7442 set tag [expr {$diffnparents > 1? "m": "d"}]
7443 if {[string trim $prefix " -+"] eq {}} {
7444 # prefix only has " ", "-" and "+" in it: normal diff line
7445 set num [string first "-" $prefix]
7447 # removed line, first parent with line is $num
7448 if {$num >= $mergemax} {
7451 $ctext insert end "$line\n" $tag$num
7454 if {[string first "+" $prefix] >= 0} {
7456 lappend tags ${tag}result
7457 if {$diffnparents > 1} {
7458 set num [string first " " $prefix]
7460 if {$num >= $mergemax} {
7467 if {$targetline ne {}} {
7468 if {$diffline == $targetline} {
7469 set seehere [$ctext index "end - 1 chars"]
7475 $ctext insert end "$line\n" $tags
7478 # "\ No newline at end of file",
7479 # or something else we don't recognize
7480 $ctext insert end "$line\n" hunksep
7484 if {[info exists seehere]} {
7485 mark_ctext_line [lindex [split $seehere .] 0]
7487 $ctext conf -state disabled
7492 return [expr {$nr >= 1000? 2: 1}]
7495 proc changediffdisp {} {
7496 global ctext diffelide
7498 $ctext tag conf d0 -elide [lindex $diffelide 0]
7499 $ctext tag conf dresult -elide [lindex $diffelide 1]
7502 proc highlightfile {loc cline} {
7503 global ctext cflist cflist_top
7506 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7507 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7508 $cflist see $cline.0
7509 set cflist_top $cline
7513 global difffilestart ctext cmitmode
7515 if {$cmitmode eq "tree"} return
7518 set here [$ctext index @0,0]
7519 foreach loc $difffilestart {
7520 if {[$ctext compare $loc >= $here]} {
7521 highlightfile $prev $prevline
7527 highlightfile $prev $prevline
7531 global difffilestart ctext cmitmode
7533 if {$cmitmode eq "tree"} return
7534 set here [$ctext index @0,0]
7536 foreach loc $difffilestart {
7538 if {[$ctext compare $loc > $here]} {
7539 highlightfile $loc $line
7545 proc clear_ctext {{first 1.0}} {
7546 global ctext smarktop smarkbot
7547 global ctext_file_names ctext_file_lines
7550 set l [lindex [split $first .] 0]
7551 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7554 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7557 $ctext delete $first end
7558 if {$first eq "1.0"} {
7559 catch {unset pendinglinks}
7561 set ctext_file_names {}
7562 set ctext_file_lines {}
7565 proc settabs {{firstab {}}} {
7566 global firsttabstop tabstop ctext have_tk85
7568 if {$firstab ne {} && $have_tk85} {
7569 set firsttabstop $firstab
7571 set w [font measure textfont "0"]
7572 if {$firsttabstop != 0} {
7573 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7574 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7575 } elseif {$have_tk85 || $tabstop != 8} {
7576 $ctext conf -tabs [expr {$tabstop * $w}]
7578 $ctext conf -tabs {}
7582 proc incrsearch {name ix op} {
7583 global ctext searchstring searchdirn
7585 $ctext tag remove found 1.0 end
7586 if {[catch {$ctext index anchor}]} {
7587 # no anchor set, use start of selection, or of visible area
7588 set sel [$ctext tag ranges sel]
7590 $ctext mark set anchor [lindex $sel 0]
7591 } elseif {$searchdirn eq "-forwards"} {
7592 $ctext mark set anchor @0,0
7594 $ctext mark set anchor @0,[winfo height $ctext]
7597 if {$searchstring ne {}} {
7598 set here [$ctext search $searchdirn -- $searchstring anchor]
7607 global sstring ctext searchstring searchdirn
7610 $sstring icursor end
7611 set searchdirn -forwards
7612 if {$searchstring ne {}} {
7613 set sel [$ctext tag ranges sel]
7615 set start "[lindex $sel 0] + 1c"
7616 } elseif {[catch {set start [$ctext index anchor]}]} {
7619 set match [$ctext search -count mlen -- $searchstring $start]
7620 $ctext tag remove sel 1.0 end
7626 set mend "$match + $mlen c"
7627 $ctext tag add sel $match $mend
7628 $ctext mark unset anchor
7632 proc dosearchback {} {
7633 global sstring ctext searchstring searchdirn
7636 $sstring icursor end
7637 set searchdirn -backwards
7638 if {$searchstring ne {}} {
7639 set sel [$ctext tag ranges sel]
7641 set start [lindex $sel 0]
7642 } elseif {[catch {set start [$ctext index anchor]}]} {
7643 set start @0,[winfo height $ctext]
7645 set match [$ctext search -backwards -count ml -- $searchstring $start]
7646 $ctext tag remove sel 1.0 end
7652 set mend "$match + $ml c"
7653 $ctext tag add sel $match $mend
7654 $ctext mark unset anchor
7658 proc searchmark {first last} {
7659 global ctext searchstring
7663 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7664 if {$match eq {}} break
7665 set mend "$match + $mlen c"
7666 $ctext tag add found $match $mend
7670 proc searchmarkvisible {doall} {
7671 global ctext smarktop smarkbot
7673 set topline [lindex [split [$ctext index @0,0] .] 0]
7674 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7675 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7676 # no overlap with previous
7677 searchmark $topline $botline
7678 set smarktop $topline
7679 set smarkbot $botline
7681 if {$topline < $smarktop} {
7682 searchmark $topline [expr {$smarktop-1}]
7683 set smarktop $topline
7685 if {$botline > $smarkbot} {
7686 searchmark [expr {$smarkbot+1}] $botline
7687 set smarkbot $botline
7692 proc scrolltext {f0 f1} {
7695 .bleft.bottom.sb set $f0 $f1
7696 if {$searchstring ne {}} {
7702 global linespc charspc canvx0 canvy0
7703 global xspc1 xspc2 lthickness
7705 set linespc [font metrics mainfont -linespace]
7706 set charspc [font measure mainfont "m"]
7707 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7708 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7709 set lthickness [expr {int($linespc / 9) + 1}]
7710 set xspc1(0) $linespc
7718 set ymax [lindex [$canv cget -scrollregion] 3]
7719 if {$ymax eq {} || $ymax == 0} return
7720 set span [$canv yview]
7723 allcanvs yview moveto [lindex $span 0]
7725 if {$selectedline ne {}} {
7726 selectline $selectedline 0
7727 allcanvs yview moveto [lindex $span 0]
7731 proc parsefont {f n} {
7734 set fontattr($f,family) [lindex $n 0]
7736 if {$s eq {} || $s == 0} {
7739 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7741 set fontattr($f,size) $s
7742 set fontattr($f,weight) normal
7743 set fontattr($f,slant) roman
7744 foreach style [lrange $n 2 end] {
7747 "bold" {set fontattr($f,weight) $style}
7749 "italic" {set fontattr($f,slant) $style}
7754 proc fontflags {f {isbold 0}} {
7757 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7758 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7759 -slant $fontattr($f,slant)]
7765 set n [list $fontattr($f,family) $fontattr($f,size)]
7766 if {$fontattr($f,weight) eq "bold"} {
7769 if {$fontattr($f,slant) eq "italic"} {
7775 proc incrfont {inc} {
7776 global mainfont textfont ctext canv cflist showrefstop
7777 global stopped entries fontattr
7780 set s $fontattr(mainfont,size)
7785 set fontattr(mainfont,size) $s
7786 font config mainfont -size $s
7787 font config mainfontbold -size $s
7788 set mainfont [fontname mainfont]
7789 set s $fontattr(textfont,size)
7794 set fontattr(textfont,size) $s
7795 font config textfont -size $s
7796 font config textfontbold -size $s
7797 set textfont [fontname textfont]
7804 global sha1entry sha1string
7805 if {[string length $sha1string] == 40} {
7806 $sha1entry delete 0 end
7810 proc sha1change {n1 n2 op} {
7811 global sha1string currentid sha1but
7812 if {$sha1string == {}
7813 || ([info exists currentid] && $sha1string == $currentid)} {
7818 if {[$sha1but cget -state] == $state} return
7819 if {$state == "normal"} {
7820 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7822 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7826 proc gotocommit {} {
7827 global sha1string tagids headids curview varcid
7829 if {$sha1string == {}
7830 || ([info exists currentid] && $sha1string == $currentid)} return
7831 if {[info exists tagids($sha1string)]} {
7832 set id $tagids($sha1string)
7833 } elseif {[info exists headids($sha1string)]} {
7834 set id $headids($sha1string)
7836 set id [string tolower $sha1string]
7837 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7838 set matches [longid $id]
7839 if {$matches ne {}} {
7840 if {[llength $matches] > 1} {
7841 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7844 set id [lindex $matches 0]
7848 if {[commitinview $id $curview]} {
7849 selectline [rowofcommit $id] 1
7852 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7853 set msg [mc "SHA1 id %s is not known" $sha1string]
7855 set msg [mc "Tag/Head %s is not known" $sha1string]
7860 proc lineenter {x y id} {
7861 global hoverx hovery hoverid hovertimer
7862 global commitinfo canv
7864 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7868 if {[info exists hovertimer]} {
7869 after cancel $hovertimer
7871 set hovertimer [after 500 linehover]
7875 proc linemotion {x y id} {
7876 global hoverx hovery hoverid hovertimer
7878 if {[info exists hoverid] && $id == $hoverid} {
7881 if {[info exists hovertimer]} {
7882 after cancel $hovertimer
7884 set hovertimer [after 500 linehover]
7888 proc lineleave {id} {
7889 global hoverid hovertimer canv
7891 if {[info exists hoverid] && $id == $hoverid} {
7893 if {[info exists hovertimer]} {
7894 after cancel $hovertimer
7902 global hoverx hovery hoverid hovertimer
7903 global canv linespc lthickness
7906 set text [lindex $commitinfo($hoverid) 0]
7907 set ymax [lindex [$canv cget -scrollregion] 3]
7908 if {$ymax == {}} return
7909 set yfrac [lindex [$canv yview] 0]
7910 set x [expr {$hoverx + 2 * $linespc}]
7911 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7912 set x0 [expr {$x - 2 * $lthickness}]
7913 set y0 [expr {$y - 2 * $lthickness}]
7914 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7915 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7916 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7917 -fill \#ffff80 -outline black -width 1 -tags hover]
7919 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7924 proc clickisonarrow {id y} {
7927 set ranges [rowranges $id]
7928 set thresh [expr {2 * $lthickness + 6}]
7929 set n [expr {[llength $ranges] - 1}]
7930 for {set i 1} {$i < $n} {incr i} {
7931 set row [lindex $ranges $i]
7932 if {abs([yc $row] - $y) < $thresh} {
7939 proc arrowjump {id n y} {
7942 # 1 <-> 2, 3 <-> 4, etc...
7943 set n [expr {(($n - 1) ^ 1) + 1}]
7944 set row [lindex [rowranges $id] $n]
7946 set ymax [lindex [$canv cget -scrollregion] 3]
7947 if {$ymax eq {} || $ymax <= 0} return
7948 set view [$canv yview]
7949 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7950 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7954 allcanvs yview moveto $yfrac
7957 proc lineclick {x y id isnew} {
7958 global ctext commitinfo children canv thickerline curview
7960 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7965 # draw this line thicker than normal
7969 set ymax [lindex [$canv cget -scrollregion] 3]
7970 if {$ymax eq {}} return
7971 set yfrac [lindex [$canv yview] 0]
7972 set y [expr {$y + $yfrac * $ymax}]
7974 set dirn [clickisonarrow $id $y]
7976 arrowjump $id $dirn $y
7981 addtohistory [list lineclick $x $y $id 0]
7983 # fill the details pane with info about this line
7984 $ctext conf -state normal
7987 $ctext insert end "[mc "Parent"]:\t"
7988 $ctext insert end $id link0
7990 set info $commitinfo($id)
7991 $ctext insert end "\n\t[lindex $info 0]\n"
7992 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7993 set date [formatdate [lindex $info 2]]
7994 $ctext insert end "\t[mc "Date"]:\t$date\n"
7995 set kids $children($curview,$id)
7997 $ctext insert end "\n[mc "Children"]:"
7999 foreach child $kids {
8001 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8002 set info $commitinfo($child)
8003 $ctext insert end "\n\t"
8004 $ctext insert end $child link$i
8005 setlink $child link$i
8006 $ctext insert end "\n\t[lindex $info 0]"
8007 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8008 set date [formatdate [lindex $info 2]]
8009 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8012 $ctext conf -state disabled
8016 proc normalline {} {
8018 if {[info exists thickerline]} {
8027 if {[commitinview $id $curview]} {
8028 selectline [rowofcommit $id] 1
8034 if {![info exists startmstime]} {
8035 set startmstime [clock clicks -milliseconds]
8037 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8040 proc rowmenu {x y id} {
8041 global rowctxmenu selectedline rowmenuid curview
8042 global nullid nullid2 fakerowmenu mainhead markedid
8046 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8051 if {$id ne $nullid && $id ne $nullid2} {
8052 set menu $rowctxmenu
8053 if {$mainhead ne {}} {
8054 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8056 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8058 if {[info exists markedid] && $markedid ne $id} {
8059 $menu entryconfigure 9 -state normal
8060 $menu entryconfigure 10 -state normal
8061 $menu entryconfigure 11 -state normal
8063 $menu entryconfigure 9 -state disabled
8064 $menu entryconfigure 10 -state disabled
8065 $menu entryconfigure 11 -state disabled
8068 set menu $fakerowmenu
8070 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8071 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8072 $menu entryconfigure [mca "Make patch"] -state $state
8073 tk_popup $menu $x $y
8077 global rowmenuid markedid canv
8079 set markedid $rowmenuid
8080 make_idmark $markedid
8086 if {[info exists markedid]} {
8091 proc replace_by_kids {l r} {
8092 global curview children
8094 set id [commitonrow $r]
8095 set l [lreplace $l 0 0]
8096 foreach kid $children($curview,$id) {
8097 lappend l [rowofcommit $kid]
8099 return [lsort -integer -decreasing -unique $l]
8102 proc find_common_desc {} {
8103 global markedid rowmenuid curview children
8105 if {![info exists markedid]} return
8106 if {![commitinview $markedid $curview] ||
8107 ![commitinview $rowmenuid $curview]} return
8108 #set t1 [clock clicks -milliseconds]
8109 set l1 [list [rowofcommit $markedid]]
8110 set l2 [list [rowofcommit $rowmenuid]]
8112 set r1 [lindex $l1 0]
8113 set r2 [lindex $l2 0]
8114 if {$r1 eq {} || $r2 eq {}} break
8120 set l1 [replace_by_kids $l1 $r1]
8122 set l2 [replace_by_kids $l2 $r2]
8125 #set t2 [clock clicks -milliseconds]
8126 #puts "took [expr {$t2-$t1}]ms"
8129 proc compare_commits {} {
8130 global markedid rowmenuid curview children
8132 if {![info exists markedid]} return
8133 if {![commitinview $markedid $curview]} return
8134 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8135 do_cmp_commits $markedid $rowmenuid
8138 proc getpatchid {id} {
8141 if {![info exists patchids($id)]} {
8142 set cmd [diffcmd [list $id] {-p --root}]
8143 # trim off the initial "|"
8144 set cmd [lrange $cmd 1 end]
8146 set x [eval exec $cmd | git patch-id]
8147 set patchids($id) [lindex $x 0]
8149 set patchids($id) "error"
8152 return $patchids($id)
8155 proc do_cmp_commits {a b} {
8156 global ctext curview parents children patchids commitinfo
8158 $ctext conf -state normal
8161 for {set i 0} {$i < 100} {incr i} {
8164 if {[llength $parents($curview,$a)] > 1} {
8165 appendshortlink $a [mc "Skipping merge commit "] "\n"
8168 set patcha [getpatchid $a]
8170 if {[llength $parents($curview,$b)] > 1} {
8171 appendshortlink $b [mc "Skipping merge commit "] "\n"
8174 set patchb [getpatchid $b]
8176 if {!$skipa && !$skipb} {
8177 set heada [lindex $commitinfo($a) 0]
8178 set headb [lindex $commitinfo($b) 0]
8179 if {$patcha eq "error"} {
8180 appendshortlink $a [mc "Error getting patch ID for "] \
8181 [mc " - stopping\n"]
8184 if {$patchb eq "error"} {
8185 appendshortlink $b [mc "Error getting patch ID for "] \
8186 [mc " - stopping\n"]
8189 if {$patcha eq $patchb} {
8190 if {$heada eq $headb} {
8191 appendshortlink $a [mc "Commit "]
8192 appendshortlink $b " == " " $heada\n"
8194 appendshortlink $a [mc "Commit "] " $heada\n"
8195 appendshortlink $b [mc " is the same patch as\n "] \
8201 $ctext insert end "\n"
8202 appendshortlink $a [mc "Commit "] " $heada\n"
8203 appendshortlink $b [mc " differs from\n "] \
8205 $ctext insert end [mc "- stopping\n"]
8210 if {[llength $children($curview,$a)] != 1} {
8211 $ctext insert end "\n"
8212 appendshortlink $a [mc "Commit "] \
8213 [mc " has %s children - stopping\n" \
8214 [llength $children($curview,$a)]]
8217 set a [lindex $children($curview,$a) 0]
8220 if {[llength $children($curview,$b)] != 1} {
8221 appendshortlink $b [mc "Commit "] \
8222 [mc " has %s children - stopping\n" \
8223 [llength $children($curview,$b)]]
8226 set b [lindex $children($curview,$b) 0]
8229 $ctext conf -state disabled
8232 proc diffvssel {dirn} {
8233 global rowmenuid selectedline
8235 if {$selectedline eq {}} return
8237 set oldid [commitonrow $selectedline]
8238 set newid $rowmenuid
8240 set oldid $rowmenuid
8241 set newid [commitonrow $selectedline]
8243 addtohistory [list doseldiff $oldid $newid]
8244 doseldiff $oldid $newid
8247 proc doseldiff {oldid newid} {
8251 $ctext conf -state normal
8253 init_flist [mc "Top"]
8254 $ctext insert end "[mc "From"] "
8255 $ctext insert end $oldid link0
8256 setlink $oldid link0
8257 $ctext insert end "\n "
8258 $ctext insert end [lindex $commitinfo($oldid) 0]
8259 $ctext insert end "\n\n[mc "To"] "
8260 $ctext insert end $newid link1
8261 setlink $newid link1
8262 $ctext insert end "\n "
8263 $ctext insert end [lindex $commitinfo($newid) 0]
8264 $ctext insert end "\n"
8265 $ctext conf -state disabled
8266 $ctext tag remove found 1.0 end
8267 startdiff [list $oldid $newid]
8271 global rowmenuid currentid commitinfo patchtop patchnum
8273 if {![info exists currentid]} return
8274 set oldid $currentid
8275 set oldhead [lindex $commitinfo($oldid) 0]
8276 set newid $rowmenuid
8277 set newhead [lindex $commitinfo($newid) 0]
8280 catch {destroy $top}
8282 make_transient $top .
8283 label $top.title -text [mc "Generate patch"]
8284 grid $top.title - -pady 10
8285 label $top.from -text [mc "From:"]
8286 entry $top.fromsha1 -width 40 -relief flat
8287 $top.fromsha1 insert 0 $oldid
8288 $top.fromsha1 conf -state readonly
8289 grid $top.from $top.fromsha1 -sticky w
8290 entry $top.fromhead -width 60 -relief flat
8291 $top.fromhead insert 0 $oldhead
8292 $top.fromhead conf -state readonly
8293 grid x $top.fromhead -sticky w
8294 label $top.to -text [mc "To:"]
8295 entry $top.tosha1 -width 40 -relief flat
8296 $top.tosha1 insert 0 $newid
8297 $top.tosha1 conf -state readonly
8298 grid $top.to $top.tosha1 -sticky w
8299 entry $top.tohead -width 60 -relief flat
8300 $top.tohead insert 0 $newhead
8301 $top.tohead conf -state readonly
8302 grid x $top.tohead -sticky w
8303 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
8304 grid $top.rev x -pady 10
8305 label $top.flab -text [mc "Output file:"]
8306 entry $top.fname -width 60
8307 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8309 grid $top.flab $top.fname -sticky w
8311 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8312 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8313 bind $top <Key-Return> mkpatchgo
8314 bind $top <Key-Escape> mkpatchcan
8315 grid $top.buts.gen $top.buts.can
8316 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8317 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8318 grid $top.buts - -pady 10 -sticky ew
8322 proc mkpatchrev {} {
8325 set oldid [$patchtop.fromsha1 get]
8326 set oldhead [$patchtop.fromhead get]
8327 set newid [$patchtop.tosha1 get]
8328 set newhead [$patchtop.tohead get]
8329 foreach e [list fromsha1 fromhead tosha1 tohead] \
8330 v [list $newid $newhead $oldid $oldhead] {
8331 $patchtop.$e conf -state normal
8332 $patchtop.$e delete 0 end
8333 $patchtop.$e insert 0 $v
8334 $patchtop.$e conf -state readonly
8339 global patchtop nullid nullid2
8341 set oldid [$patchtop.fromsha1 get]
8342 set newid [$patchtop.tosha1 get]
8343 set fname [$patchtop.fname get]
8344 set cmd [diffcmd [list $oldid $newid] -p]
8345 # trim off the initial "|"
8346 set cmd [lrange $cmd 1 end]
8347 lappend cmd >$fname &
8348 if {[catch {eval exec $cmd} err]} {
8349 error_popup "[mc "Error creating patch:"] $err" $patchtop
8351 catch {destroy $patchtop}
8355 proc mkpatchcan {} {
8358 catch {destroy $patchtop}
8363 global rowmenuid mktagtop commitinfo
8367 catch {destroy $top}
8369 make_transient $top .
8370 label $top.title -text [mc "Create tag"]
8371 grid $top.title - -pady 10
8372 label $top.id -text [mc "ID:"]
8373 entry $top.sha1 -width 40 -relief flat
8374 $top.sha1 insert 0 $rowmenuid
8375 $top.sha1 conf -state readonly
8376 grid $top.id $top.sha1 -sticky w
8377 entry $top.head -width 60 -relief flat
8378 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8379 $top.head conf -state readonly
8380 grid x $top.head -sticky w
8381 label $top.tlab -text [mc "Tag name:"]
8382 entry $top.tag -width 60
8383 grid $top.tlab $top.tag -sticky w
8385 button $top.buts.gen -text [mc "Create"] -command mktaggo
8386 button $top.buts.can -text [mc "Cancel"] -command mktagcan
8387 bind $top <Key-Return> mktaggo
8388 bind $top <Key-Escape> mktagcan
8389 grid $top.buts.gen $top.buts.can
8390 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8391 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8392 grid $top.buts - -pady 10 -sticky ew
8397 global mktagtop env tagids idtags
8399 set id [$mktagtop.sha1 get]
8400 set tag [$mktagtop.tag get]
8402 error_popup [mc "No tag name specified"] $mktagtop
8405 if {[info exists tagids($tag)]} {
8406 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8410 exec git tag $tag $id
8412 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8416 set tagids($tag) $id
8417 lappend idtags($id) $tag
8425 proc redrawtags {id} {
8426 global canv linehtag idpos currentid curview cmitlisted markedid
8427 global canvxmax iddrawn circleitem mainheadid circlecolors
8429 if {![commitinview $id $curview]} return
8430 if {![info exists iddrawn($id)]} return
8431 set row [rowofcommit $id]
8432 if {$id eq $mainheadid} {
8435 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8437 $canv itemconf $circleitem($row) -fill $ofill
8438 $canv delete tag.$id
8439 set xt [eval drawtags $id $idpos($id)]
8440 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8441 set text [$canv itemcget $linehtag($id) -text]
8442 set font [$canv itemcget $linehtag($id) -font]
8443 set xr [expr {$xt + [font measure $font $text]}]
8444 if {$xr > $canvxmax} {
8448 if {[info exists currentid] && $currentid == $id} {
8451 if {[info exists markedid] && $markedid eq $id} {
8459 catch {destroy $mktagtop}
8464 if {![domktag]} return
8468 proc writecommit {} {
8469 global rowmenuid wrcomtop commitinfo wrcomcmd
8471 set top .writecommit
8473 catch {destroy $top}
8475 make_transient $top .
8476 label $top.title -text [mc "Write commit to file"]
8477 grid $top.title - -pady 10
8478 label $top.id -text [mc "ID:"]
8479 entry $top.sha1 -width 40 -relief flat
8480 $top.sha1 insert 0 $rowmenuid
8481 $top.sha1 conf -state readonly
8482 grid $top.id $top.sha1 -sticky w
8483 entry $top.head -width 60 -relief flat
8484 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8485 $top.head conf -state readonly
8486 grid x $top.head -sticky w
8487 label $top.clab -text [mc "Command:"]
8488 entry $top.cmd -width 60 -textvariable wrcomcmd
8489 grid $top.clab $top.cmd -sticky w -pady 10
8490 label $top.flab -text [mc "Output file:"]
8491 entry $top.fname -width 60
8492 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8493 grid $top.flab $top.fname -sticky w
8495 button $top.buts.gen -text [mc "Write"] -command wrcomgo
8496 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8497 bind $top <Key-Return> wrcomgo
8498 bind $top <Key-Escape> wrcomcan
8499 grid $top.buts.gen $top.buts.can
8500 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8501 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8502 grid $top.buts - -pady 10 -sticky ew
8509 set id [$wrcomtop.sha1 get]
8510 set cmd "echo $id | [$wrcomtop.cmd get]"
8511 set fname [$wrcomtop.fname get]
8512 if {[catch {exec sh -c $cmd >$fname &} err]} {
8513 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8515 catch {destroy $wrcomtop}
8522 catch {destroy $wrcomtop}
8527 global rowmenuid mkbrtop
8530 catch {destroy $top}
8532 make_transient $top .
8533 label $top.title -text [mc "Create new branch"]
8534 grid $top.title - -pady 10
8535 label $top.id -text [mc "ID:"]
8536 entry $top.sha1 -width 40 -relief flat
8537 $top.sha1 insert 0 $rowmenuid
8538 $top.sha1 conf -state readonly
8539 grid $top.id $top.sha1 -sticky w
8540 label $top.nlab -text [mc "Name:"]
8541 entry $top.name -width 40
8542 grid $top.nlab $top.name -sticky w
8544 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8545 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8546 bind $top <Key-Return> [list mkbrgo $top]
8547 bind $top <Key-Escape> "catch {destroy $top}"
8548 grid $top.buts.go $top.buts.can
8549 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8550 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8551 grid $top.buts - -pady 10 -sticky ew
8556 global headids idheads
8558 set name [$top.name get]
8559 set id [$top.sha1 get]
8563 error_popup [mc "Please specify a name for the new branch"] $top
8566 if {[info exists headids($name)]} {
8567 if {![confirm_popup [mc \
8568 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8571 set old_id $headids($name)
8574 catch {destroy $top}
8575 lappend cmdargs $name $id
8579 eval exec git branch $cmdargs
8585 if {$old_id ne {}} {
8591 set headids($name) $id
8592 lappend idheads($id) $name
8601 proc exec_citool {tool_args {baseid {}}} {
8602 global commitinfo env
8604 set save_env [array get env GIT_AUTHOR_*]
8606 if {$baseid ne {}} {
8607 if {![info exists commitinfo($baseid)]} {
8610 set author [lindex $commitinfo($baseid) 1]
8611 set date [lindex $commitinfo($baseid) 2]
8612 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8613 $author author name email]
8615 set env(GIT_AUTHOR_NAME) $name
8616 set env(GIT_AUTHOR_EMAIL) $email
8617 set env(GIT_AUTHOR_DATE) $date
8621 eval exec git citool $tool_args &
8623 array unset env GIT_AUTHOR_*
8624 array set env $save_env
8627 proc cherrypick {} {
8628 global rowmenuid curview
8629 global mainhead mainheadid
8631 set oldhead [exec git rev-parse HEAD]
8632 set dheads [descheads $rowmenuid]
8633 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8634 set ok [confirm_popup [mc "Commit %s is already\
8635 included in branch %s -- really re-apply it?" \
8636 [string range $rowmenuid 0 7] $mainhead]]
8639 nowbusy cherrypick [mc "Cherry-picking"]
8641 # Unfortunately git-cherry-pick writes stuff to stderr even when
8642 # no error occurs, and exec takes that as an indication of error...
8643 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8646 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8648 error_popup [mc "Cherry-pick failed because of local changes\
8649 to file '%s'.\nPlease commit, reset or stash\
8650 your changes and try again." $fname]
8651 } elseif {[regexp -line \
8652 {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8654 if {[confirm_popup [mc "Cherry-pick failed because of merge\
8655 conflict.\nDo you wish to run git citool to\
8657 # Force citool to read MERGE_MSG
8658 file delete [file join [gitdir] "GITGUI_MSG"]
8659 exec_citool {} $rowmenuid
8667 set newhead [exec git rev-parse HEAD]
8668 if {$newhead eq $oldhead} {
8670 error_popup [mc "No changes committed"]
8673 addnewchild $newhead $oldhead
8674 if {[commitinview $oldhead $curview]} {
8675 # XXX this isn't right if we have a path limit...
8676 insertrow $newhead $oldhead $curview
8677 if {$mainhead ne {}} {
8678 movehead $newhead $mainhead
8679 movedhead $newhead $mainhead
8681 set mainheadid $newhead
8690 global mainhead rowmenuid confirm_ok resettype
8693 set w ".confirmreset"
8696 wm title $w [mc "Confirm reset"]
8697 message $w.m -text \
8698 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8699 -justify center -aspect 1000
8700 pack $w.m -side top -fill x -padx 20 -pady 20
8701 frame $w.f -relief sunken -border 2
8702 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8703 grid $w.f.rt -sticky w
8705 radiobutton $w.f.soft -value soft -variable resettype -justify left \
8706 -text [mc "Soft: Leave working tree and index untouched"]
8707 grid $w.f.soft -sticky w
8708 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8709 -text [mc "Mixed: Leave working tree untouched, reset index"]
8710 grid $w.f.mixed -sticky w
8711 radiobutton $w.f.hard -value hard -variable resettype -justify left \
8712 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8713 grid $w.f.hard -sticky w
8714 pack $w.f -side top -fill x
8715 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8716 pack $w.ok -side left -fill x -padx 20 -pady 20
8717 button $w.cancel -text [mc Cancel] -command "destroy $w"
8718 bind $w <Key-Escape> [list destroy $w]
8719 pack $w.cancel -side right -fill x -padx 20 -pady 20
8720 bind $w <Visibility> "grab $w; focus $w"
8722 if {!$confirm_ok} return
8723 if {[catch {set fd [open \
8724 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8728 filerun $fd [list readresetstat $fd]
8729 nowbusy reset [mc "Resetting"]
8734 proc readresetstat {fd} {
8735 global mainhead mainheadid showlocalchanges rprogcoord
8737 if {[gets $fd line] >= 0} {
8738 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8739 set rprogcoord [expr {1.0 * $m / $n}]
8747 if {[catch {close $fd} err]} {
8750 set oldhead $mainheadid
8751 set newhead [exec git rev-parse HEAD]
8752 if {$newhead ne $oldhead} {
8753 movehead $newhead $mainhead
8754 movedhead $newhead $mainhead
8755 set mainheadid $newhead
8759 if {$showlocalchanges} {
8765 # context menu for a head
8766 proc headmenu {x y id head} {
8767 global headmenuid headmenuhead headctxmenu mainhead
8771 set headmenuhead $head
8773 if {$head eq $mainhead} {
8776 $headctxmenu entryconfigure 0 -state $state
8777 $headctxmenu entryconfigure 1 -state $state
8778 tk_popup $headctxmenu $x $y
8782 global headmenuid headmenuhead headids
8783 global showlocalchanges
8785 # check the tree is clean first??
8786 nowbusy checkout [mc "Checking out"]
8790 set fd [open [list | git checkout $headmenuhead 2>@1] r]
8794 if {$showlocalchanges} {
8798 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8802 proc readcheckoutstat {fd newhead newheadid} {
8803 global mainhead mainheadid headids showlocalchanges progresscoords
8804 global viewmainheadid curview
8806 if {[gets $fd line] >= 0} {
8807 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8808 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8813 set progresscoords {0 0}
8816 if {[catch {close $fd} err]} {
8819 set oldmainid $mainheadid
8820 set mainhead $newhead
8821 set mainheadid $newheadid
8822 set viewmainheadid($curview) $newheadid
8823 redrawtags $oldmainid
8824 redrawtags $newheadid
8826 if {$showlocalchanges} {
8832 global headmenuid headmenuhead mainhead
8835 set head $headmenuhead
8837 # this check shouldn't be needed any more...
8838 if {$head eq $mainhead} {
8839 error_popup [mc "Cannot delete the currently checked-out branch"]
8842 set dheads [descheads $id]
8843 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8844 # the stuff on this branch isn't on any other branch
8845 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8846 branch.\nReally delete branch %s?" $head $head]]} return
8850 if {[catch {exec git branch -D $head} err]} {
8855 removehead $id $head
8856 removedhead $id $head
8863 # Display a list of tags and heads
8865 global showrefstop bgcolor fgcolor selectbgcolor
8866 global bglist fglist reflistfilter reflist maincursor
8869 set showrefstop $top
8870 if {[winfo exists $top]} {
8876 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8877 make_transient $top .
8878 text $top.list -background $bgcolor -foreground $fgcolor \
8879 -selectbackground $selectbgcolor -font mainfont \
8880 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8881 -width 30 -height 20 -cursor $maincursor \
8882 -spacing1 1 -spacing3 1 -state disabled
8883 $top.list tag configure highlight -background $selectbgcolor
8884 lappend bglist $top.list
8885 lappend fglist $top.list
8886 scrollbar $top.ysb -command "$top.list yview" -orient vertical
8887 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8888 grid $top.list $top.ysb -sticky nsew
8889 grid $top.xsb x -sticky ew
8891 label $top.f.l -text "[mc "Filter"]: "
8892 entry $top.f.e -width 20 -textvariable reflistfilter
8893 set reflistfilter "*"
8894 trace add variable reflistfilter write reflistfilter_change
8895 pack $top.f.e -side right -fill x -expand 1
8896 pack $top.f.l -side left
8897 grid $top.f - -sticky ew -pady 2
8898 button $top.close -command [list destroy $top] -text [mc "Close"]
8899 bind $top <Key-Escape> [list destroy $top]
8901 grid columnconfigure $top 0 -weight 1
8902 grid rowconfigure $top 0 -weight 1
8903 bind $top.list <1> {break}
8904 bind $top.list <B1-Motion> {break}
8905 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8910 proc sel_reflist {w x y} {
8911 global showrefstop reflist headids tagids otherrefids
8913 if {![winfo exists $showrefstop]} return
8914 set l [lindex [split [$w index "@$x,$y"] "."] 0]
8915 set ref [lindex $reflist [expr {$l-1}]]
8916 set n [lindex $ref 0]
8917 switch -- [lindex $ref 1] {
8918 "H" {selbyid $headids($n)}
8919 "T" {selbyid $tagids($n)}
8920 "o" {selbyid $otherrefids($n)}
8922 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8925 proc unsel_reflist {} {
8928 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8929 $showrefstop.list tag remove highlight 0.0 end
8932 proc reflistfilter_change {n1 n2 op} {
8933 global reflistfilter
8935 after cancel refill_reflist
8936 after 200 refill_reflist
8939 proc refill_reflist {} {
8940 global reflist reflistfilter showrefstop headids tagids otherrefids
8943 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8945 foreach n [array names headids] {
8946 if {[string match $reflistfilter $n]} {
8947 if {[commitinview $headids($n) $curview]} {
8948 lappend refs [list $n H]
8950 interestedin $headids($n) {run refill_reflist}
8954 foreach n [array names tagids] {
8955 if {[string match $reflistfilter $n]} {
8956 if {[commitinview $tagids($n) $curview]} {
8957 lappend refs [list $n T]
8959 interestedin $tagids($n) {run refill_reflist}
8963 foreach n [array names otherrefids] {
8964 if {[string match $reflistfilter $n]} {
8965 if {[commitinview $otherrefids($n) $curview]} {
8966 lappend refs [list $n o]
8968 interestedin $otherrefids($n) {run refill_reflist}
8972 set refs [lsort -index 0 $refs]
8973 if {$refs eq $reflist} return
8975 # Update the contents of $showrefstop.list according to the
8976 # differences between $reflist (old) and $refs (new)
8977 $showrefstop.list conf -state normal
8978 $showrefstop.list insert end "\n"
8981 while {$i < [llength $reflist] || $j < [llength $refs]} {
8982 if {$i < [llength $reflist]} {
8983 if {$j < [llength $refs]} {
8984 set cmp [string compare [lindex $reflist $i 0] \
8985 [lindex $refs $j 0]]
8987 set cmp [string compare [lindex $reflist $i 1] \
8988 [lindex $refs $j 1]]
8998 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9006 set l [expr {$j + 1}]
9007 $showrefstop.list image create $l.0 -align baseline \
9008 -image reficon-[lindex $refs $j 1] -padx 2
9009 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9015 # delete last newline
9016 $showrefstop.list delete end-2c end-1c
9017 $showrefstop.list conf -state disabled
9020 # Stuff for finding nearby tags
9021 proc getallcommits {} {
9022 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9023 global idheads idtags idotherrefs allparents tagobjid
9025 if {![info exists allcommits]} {
9031 set allccache [file join [gitdir] "gitk.cache"]
9033 set f [open $allccache r]
9042 set cmd [list | git rev-list --parents]
9043 set allcupdate [expr {$seeds ne {}}]
9047 set refs [concat [array names idheads] [array names idtags] \
9048 [array names idotherrefs]]
9051 foreach name [array names tagobjid] {
9052 lappend tagobjs $tagobjid($name)
9054 foreach id [lsort -unique $refs] {
9055 if {![info exists allparents($id)] &&
9056 [lsearch -exact $tagobjs $id] < 0} {
9067 set fd [open [concat $cmd $ids] r]
9068 fconfigure $fd -blocking 0
9071 filerun $fd [list getallclines $fd]
9077 # Since most commits have 1 parent and 1 child, we group strings of
9078 # such commits into "arcs" joining branch/merge points (BMPs), which
9079 # are commits that either don't have 1 parent or don't have 1 child.
9081 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9082 # arcout(id) - outgoing arcs for BMP
9083 # arcids(a) - list of IDs on arc including end but not start
9084 # arcstart(a) - BMP ID at start of arc
9085 # arcend(a) - BMP ID at end of arc
9086 # growing(a) - arc a is still growing
9087 # arctags(a) - IDs out of arcids (excluding end) that have tags
9088 # archeads(a) - IDs out of arcids (excluding end) that have heads
9089 # The start of an arc is at the descendent end, so "incoming" means
9090 # coming from descendents, and "outgoing" means going towards ancestors.
9092 proc getallclines {fd} {
9093 global allparents allchildren idtags idheads nextarc
9094 global arcnos arcids arctags arcout arcend arcstart archeads growing
9095 global seeds allcommits cachedarcs allcupdate
9098 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9099 set id [lindex $line 0]
9100 if {[info exists allparents($id)]} {
9105 set olds [lrange $line 1 end]
9106 set allparents($id) $olds
9107 if {![info exists allchildren($id)]} {
9108 set allchildren($id) {}
9113 if {[llength $olds] == 1 && [llength $a] == 1} {
9114 lappend arcids($a) $id
9115 if {[info exists idtags($id)]} {
9116 lappend arctags($a) $id
9118 if {[info exists idheads($id)]} {
9119 lappend archeads($a) $id
9121 if {[info exists allparents($olds)]} {
9122 # seen parent already
9123 if {![info exists arcout($olds)]} {
9126 lappend arcids($a) $olds
9127 set arcend($a) $olds
9130 lappend allchildren($olds) $id
9131 lappend arcnos($olds) $a
9135 foreach a $arcnos($id) {
9136 lappend arcids($a) $id
9143 lappend allchildren($p) $id
9144 set a [incr nextarc]
9145 set arcstart($a) $id
9152 if {[info exists allparents($p)]} {
9153 # seen it already, may need to make a new branch
9154 if {![info exists arcout($p)]} {
9157 lappend arcids($a) $p
9161 lappend arcnos($p) $a
9166 global cached_dheads cached_dtags cached_atags
9167 catch {unset cached_dheads}
9168 catch {unset cached_dtags}
9169 catch {unset cached_atags}
9172 return [expr {$nid >= 1000? 2: 1}]
9176 fconfigure $fd -blocking 1
9179 # got an error reading the list of commits
9180 # if we were updating, try rereading the whole thing again
9186 error_popup "[mc "Error reading commit topology information;\
9187 branch and preceding/following tag information\
9188 will be incomplete."]\n($err)"
9191 if {[incr allcommits -1] == 0} {
9201 proc recalcarc {a} {
9202 global arctags archeads arcids idtags idheads
9206 foreach id [lrange $arcids($a) 0 end-1] {
9207 if {[info exists idtags($id)]} {
9210 if {[info exists idheads($id)]} {
9215 set archeads($a) $ah
9219 global arcnos arcids nextarc arctags archeads idtags idheads
9220 global arcstart arcend arcout allparents growing
9223 if {[llength $a] != 1} {
9224 puts "oops splitarc called but [llength $a] arcs already"
9228 set i [lsearch -exact $arcids($a) $p]
9230 puts "oops splitarc $p not in arc $a"
9233 set na [incr nextarc]
9234 if {[info exists arcend($a)]} {
9235 set arcend($na) $arcend($a)
9237 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9238 set j [lsearch -exact $arcnos($l) $a]
9239 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9241 set tail [lrange $arcids($a) [expr {$i+1}] end]
9242 set arcids($a) [lrange $arcids($a) 0 $i]
9244 set arcstart($na) $p
9246 set arcids($na) $tail
9247 if {[info exists growing($a)]} {
9253 if {[llength $arcnos($id)] == 1} {
9256 set j [lsearch -exact $arcnos($id) $a]
9257 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9261 # reconstruct tags and heads lists
9262 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9267 set archeads($na) {}
9271 # Update things for a new commit added that is a child of one
9272 # existing commit. Used when cherry-picking.
9273 proc addnewchild {id p} {
9274 global allparents allchildren idtags nextarc
9275 global arcnos arcids arctags arcout arcend arcstart archeads growing
9276 global seeds allcommits
9278 if {![info exists allcommits] || ![info exists arcnos($p)]} return
9279 set allparents($id) [list $p]
9280 set allchildren($id) {}
9283 lappend allchildren($p) $id
9284 set a [incr nextarc]
9285 set arcstart($a) $id
9288 set arcids($a) [list $p]
9290 if {![info exists arcout($p)]} {
9293 lappend arcnos($p) $a
9294 set arcout($id) [list $a]
9297 # This implements a cache for the topology information.
9298 # The cache saves, for each arc, the start and end of the arc,
9299 # the ids on the arc, and the outgoing arcs from the end.
9300 proc readcache {f} {
9301 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9302 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9307 if {$lim - $a > 500} {
9308 set lim [expr {$a + 500}]
9312 # finish reading the cache and setting up arctags, etc.
9314 if {$line ne "1"} {error "bad final version"}
9316 foreach id [array names idtags] {
9317 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9318 [llength $allparents($id)] == 1} {
9319 set a [lindex $arcnos($id) 0]
9320 if {$arctags($a) eq {}} {
9325 foreach id [array names idheads] {
9326 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9327 [llength $allparents($id)] == 1} {
9328 set a [lindex $arcnos($id) 0]
9329 if {$archeads($a) eq {}} {
9334 foreach id [lsort -unique $possible_seeds] {
9335 if {$arcnos($id) eq {}} {
9341 while {[incr a] <= $lim} {
9343 if {[llength $line] != 3} {error "bad line"}
9344 set s [lindex $line 0]
9346 lappend arcout($s) $a
9347 if {![info exists arcnos($s)]} {
9348 lappend possible_seeds $s
9351 set e [lindex $line 1]
9356 if {![info exists arcout($e)]} {
9360 set arcids($a) [lindex $line 2]
9361 foreach id $arcids($a) {
9362 lappend allparents($s) $id
9364 lappend arcnos($id) $a
9366 if {![info exists allparents($s)]} {
9367 set allparents($s) {}
9372 set nextarc [expr {$a - 1}]
9385 global nextarc cachedarcs possible_seeds
9389 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9390 # make sure it's an integer
9391 set cachedarcs [expr {int([lindex $line 1])}]
9392 if {$cachedarcs < 0} {error "bad number of arcs"}
9394 set possible_seeds {}
9402 proc dropcache {err} {
9403 global allcwait nextarc cachedarcs seeds
9405 #puts "dropping cache ($err)"
9406 foreach v {arcnos arcout arcids arcstart arcend growing \
9407 arctags archeads allparents allchildren} {
9418 proc writecache {f} {
9419 global cachearc cachedarcs allccache
9420 global arcstart arcend arcnos arcids arcout
9424 if {$lim - $a > 1000} {
9425 set lim [expr {$a + 1000}]
9428 while {[incr a] <= $lim} {
9429 if {[info exists arcend($a)]} {
9430 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9432 puts $f [list $arcstart($a) {} $arcids($a)]
9437 catch {file delete $allccache}
9438 #puts "writing cache failed ($err)"
9441 set cachearc [expr {$a - 1}]
9442 if {$a > $cachedarcs} {
9451 global nextarc cachedarcs cachearc allccache
9453 if {$nextarc == $cachedarcs} return
9455 set cachedarcs $nextarc
9457 set f [open $allccache w]
9458 puts $f [list 1 $cachedarcs]
9463 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9464 # or 0 if neither is true.
9465 proc anc_or_desc {a b} {
9466 global arcout arcstart arcend arcnos cached_isanc
9468 if {$arcnos($a) eq $arcnos($b)} {
9469 # Both are on the same arc(s); either both are the same BMP,
9470 # or if one is not a BMP, the other is also not a BMP or is
9471 # the BMP at end of the arc (and it only has 1 incoming arc).
9472 # Or both can be BMPs with no incoming arcs.
9473 if {$a eq $b || $arcnos($a) eq {}} {
9476 # assert {[llength $arcnos($a)] == 1}
9477 set arc [lindex $arcnos($a) 0]
9478 set i [lsearch -exact $arcids($arc) $a]
9479 set j [lsearch -exact $arcids($arc) $b]
9480 if {$i < 0 || $i > $j} {
9487 if {![info exists arcout($a)]} {
9488 set arc [lindex $arcnos($a) 0]
9489 if {[info exists arcend($arc)]} {
9490 set aend $arcend($arc)
9494 set a $arcstart($arc)
9498 if {![info exists arcout($b)]} {
9499 set arc [lindex $arcnos($b) 0]
9500 if {[info exists arcend($arc)]} {
9501 set bend $arcend($arc)
9505 set b $arcstart($arc)
9515 if {[info exists cached_isanc($a,$bend)]} {
9516 if {$cached_isanc($a,$bend)} {
9520 if {[info exists cached_isanc($b,$aend)]} {
9521 if {$cached_isanc($b,$aend)} {
9524 if {[info exists cached_isanc($a,$bend)]} {
9529 set todo [list $a $b]
9532 for {set i 0} {$i < [llength $todo]} {incr i} {
9533 set x [lindex $todo $i]
9534 if {$anc($x) eq {}} {
9537 foreach arc $arcnos($x) {
9538 set xd $arcstart($arc)
9540 set cached_isanc($a,$bend) 1
9541 set cached_isanc($b,$aend) 0
9543 } elseif {$xd eq $aend} {
9544 set cached_isanc($b,$aend) 1
9545 set cached_isanc($a,$bend) 0
9548 if {![info exists anc($xd)]} {
9549 set anc($xd) $anc($x)
9551 } elseif {$anc($xd) ne $anc($x)} {
9556 set cached_isanc($a,$bend) 0
9557 set cached_isanc($b,$aend) 0
9561 # This identifies whether $desc has an ancestor that is
9562 # a growing tip of the graph and which is not an ancestor of $anc
9563 # and returns 0 if so and 1 if not.
9564 # If we subsequently discover a tag on such a growing tip, and that
9565 # turns out to be a descendent of $anc (which it could, since we
9566 # don't necessarily see children before parents), then $desc
9567 # isn't a good choice to display as a descendent tag of
9568 # $anc (since it is the descendent of another tag which is
9569 # a descendent of $anc). Similarly, $anc isn't a good choice to
9570 # display as a ancestor tag of $desc.
9572 proc is_certain {desc anc} {
9573 global arcnos arcout arcstart arcend growing problems
9576 if {[llength $arcnos($anc)] == 1} {
9577 # tags on the same arc are certain
9578 if {$arcnos($desc) eq $arcnos($anc)} {
9581 if {![info exists arcout($anc)]} {
9582 # if $anc is partway along an arc, use the start of the arc instead
9583 set a [lindex $arcnos($anc) 0]
9584 set anc $arcstart($a)
9587 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9590 set a [lindex $arcnos($desc) 0]
9596 set anclist [list $x]
9600 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9601 set x [lindex $anclist $i]
9606 foreach a $arcout($x) {
9607 if {[info exists growing($a)]} {
9608 if {![info exists growanc($x)] && $dl($x)} {
9614 if {[info exists dl($y)]} {
9618 if {![info exists done($y)]} {
9621 if {[info exists growanc($x)]} {
9625 for {set k 0} {$k < [llength $xl]} {incr k} {
9626 set z [lindex $xl $k]
9627 foreach c $arcout($z) {
9628 if {[info exists arcend($c)]} {
9630 if {[info exists dl($v)] && $dl($v)} {
9632 if {![info exists done($v)]} {
9635 if {[info exists growanc($v)]} {
9645 } elseif {$y eq $anc || !$dl($x)} {
9656 foreach x [array names growanc] {
9665 proc validate_arctags {a} {
9666 global arctags idtags
9670 foreach id $arctags($a) {
9672 if {![info exists idtags($id)]} {
9673 set na [lreplace $na $i $i]
9680 proc validate_archeads {a} {
9681 global archeads idheads
9684 set na $archeads($a)
9685 foreach id $archeads($a) {
9687 if {![info exists idheads($id)]} {
9688 set na [lreplace $na $i $i]
9692 set archeads($a) $na
9695 # Return the list of IDs that have tags that are descendents of id,
9696 # ignoring IDs that are descendents of IDs already reported.
9697 proc desctags {id} {
9698 global arcnos arcstart arcids arctags idtags allparents
9699 global growing cached_dtags
9701 if {![info exists allparents($id)]} {
9704 set t1 [clock clicks -milliseconds]
9706 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9707 # part-way along an arc; check that arc first
9708 set a [lindex $arcnos($id) 0]
9709 if {$arctags($a) ne {}} {
9711 set i [lsearch -exact $arcids($a) $id]
9713 foreach t $arctags($a) {
9714 set j [lsearch -exact $arcids($a) $t]
9722 set id $arcstart($a)
9723 if {[info exists idtags($id)]} {
9727 if {[info exists cached_dtags($id)]} {
9728 return $cached_dtags($id)
9735 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9736 set id [lindex $todo $i]
9738 set ta [info exists hastaggedancestor($id)]
9742 # ignore tags on starting node
9743 if {!$ta && $i > 0} {
9744 if {[info exists idtags($id)]} {
9747 } elseif {[info exists cached_dtags($id)]} {
9748 set tagloc($id) $cached_dtags($id)
9752 foreach a $arcnos($id) {
9754 if {!$ta && $arctags($a) ne {}} {
9756 if {$arctags($a) ne {}} {
9757 lappend tagloc($id) [lindex $arctags($a) end]
9760 if {$ta || $arctags($a) ne {}} {
9761 set tomark [list $d]
9762 for {set j 0} {$j < [llength $tomark]} {incr j} {
9763 set dd [lindex $tomark $j]
9764 if {![info exists hastaggedancestor($dd)]} {
9765 if {[info exists done($dd)]} {
9766 foreach b $arcnos($dd) {
9767 lappend tomark $arcstart($b)
9769 if {[info exists tagloc($dd)]} {
9772 } elseif {[info exists queued($dd)]} {
9775 set hastaggedancestor($dd) 1
9779 if {![info exists queued($d)]} {
9782 if {![info exists hastaggedancestor($d)]} {
9789 foreach id [array names tagloc] {
9790 if {![info exists hastaggedancestor($id)]} {
9791 foreach t $tagloc($id) {
9792 if {[lsearch -exact $tags $t] < 0} {
9798 set t2 [clock clicks -milliseconds]
9801 # remove tags that are descendents of other tags
9802 for {set i 0} {$i < [llength $tags]} {incr i} {
9803 set a [lindex $tags $i]
9804 for {set j 0} {$j < $i} {incr j} {
9805 set b [lindex $tags $j]
9806 set r [anc_or_desc $a $b]
9808 set tags [lreplace $tags $j $j]
9811 } elseif {$r == -1} {
9812 set tags [lreplace $tags $i $i]
9819 if {[array names growing] ne {}} {
9820 # graph isn't finished, need to check if any tag could get
9821 # eclipsed by another tag coming later. Simply ignore any
9822 # tags that could later get eclipsed.
9825 if {[is_certain $t $origid]} {
9829 if {$tags eq $ctags} {
9830 set cached_dtags($origid) $tags
9835 set cached_dtags($origid) $tags
9837 set t3 [clock clicks -milliseconds]
9838 if {0 && $t3 - $t1 >= 100} {
9839 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9840 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9846 global arcnos arcids arcout arcend arctags idtags allparents
9847 global growing cached_atags
9849 if {![info exists allparents($id)]} {
9852 set t1 [clock clicks -milliseconds]
9854 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9855 # part-way along an arc; check that arc first
9856 set a [lindex $arcnos($id) 0]
9857 if {$arctags($a) ne {}} {
9859 set i [lsearch -exact $arcids($a) $id]
9860 foreach t $arctags($a) {
9861 set j [lsearch -exact $arcids($a) $t]
9867 if {![info exists arcend($a)]} {
9871 if {[info exists idtags($id)]} {
9875 if {[info exists cached_atags($id)]} {
9876 return $cached_atags($id)
9884 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9885 set id [lindex $todo $i]
9887 set td [info exists hastaggeddescendent($id)]
9891 # ignore tags on starting node
9892 if {!$td && $i > 0} {
9893 if {[info exists idtags($id)]} {
9896 } elseif {[info exists cached_atags($id)]} {
9897 set tagloc($id) $cached_atags($id)
9901 foreach a $arcout($id) {
9902 if {!$td && $arctags($a) ne {}} {
9904 if {$arctags($a) ne {}} {
9905 lappend tagloc($id) [lindex $arctags($a) 0]
9908 if {![info exists arcend($a)]} continue
9910 if {$td || $arctags($a) ne {}} {
9911 set tomark [list $d]
9912 for {set j 0} {$j < [llength $tomark]} {incr j} {
9913 set dd [lindex $tomark $j]
9914 if {![info exists hastaggeddescendent($dd)]} {
9915 if {[info exists done($dd)]} {
9916 foreach b $arcout($dd) {
9917 if {[info exists arcend($b)]} {
9918 lappend tomark $arcend($b)
9921 if {[info exists tagloc($dd)]} {
9924 } elseif {[info exists queued($dd)]} {
9927 set hastaggeddescendent($dd) 1
9931 if {![info exists queued($d)]} {
9934 if {![info exists hastaggeddescendent($d)]} {
9940 set t2 [clock clicks -milliseconds]
9943 foreach id [array names tagloc] {
9944 if {![info exists hastaggeddescendent($id)]} {
9945 foreach t $tagloc($id) {
9946 if {[lsearch -exact $tags $t] < 0} {
9953 # remove tags that are ancestors of other tags
9954 for {set i 0} {$i < [llength $tags]} {incr i} {
9955 set a [lindex $tags $i]
9956 for {set j 0} {$j < $i} {incr j} {
9957 set b [lindex $tags $j]
9958 set r [anc_or_desc $a $b]
9960 set tags [lreplace $tags $j $j]
9963 } elseif {$r == 1} {
9964 set tags [lreplace $tags $i $i]
9971 if {[array names growing] ne {}} {
9972 # graph isn't finished, need to check if any tag could get
9973 # eclipsed by another tag coming later. Simply ignore any
9974 # tags that could later get eclipsed.
9977 if {[is_certain $origid $t]} {
9981 if {$tags eq $ctags} {
9982 set cached_atags($origid) $tags
9987 set cached_atags($origid) $tags
9989 set t3 [clock clicks -milliseconds]
9990 if {0 && $t3 - $t1 >= 100} {
9991 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9992 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9997 # Return the list of IDs that have heads that are descendents of id,
9998 # including id itself if it has a head.
9999 proc descheads {id} {
10000 global arcnos arcstart arcids archeads idheads cached_dheads
10003 if {![info exists allparents($id)]} {
10007 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10008 # part-way along an arc; check it first
10009 set a [lindex $arcnos($id) 0]
10010 if {$archeads($a) ne {}} {
10011 validate_archeads $a
10012 set i [lsearch -exact $arcids($a) $id]
10013 foreach t $archeads($a) {
10014 set j [lsearch -exact $arcids($a) $t]
10019 set id $arcstart($a)
10022 set todo [list $id]
10025 for {set i 0} {$i < [llength $todo]} {incr i} {
10026 set id [lindex $todo $i]
10027 if {[info exists cached_dheads($id)]} {
10028 set ret [concat $ret $cached_dheads($id)]
10030 if {[info exists idheads($id)]} {
10033 foreach a $arcnos($id) {
10034 if {$archeads($a) ne {}} {
10035 validate_archeads $a
10036 if {$archeads($a) ne {}} {
10037 set ret [concat $ret $archeads($a)]
10040 set d $arcstart($a)
10041 if {![info exists seen($d)]} {
10048 set ret [lsort -unique $ret]
10049 set cached_dheads($origid) $ret
10050 return [concat $ret $aret]
10053 proc addedtag {id} {
10054 global arcnos arcout cached_dtags cached_atags
10056 if {![info exists arcnos($id)]} return
10057 if {![info exists arcout($id)]} {
10058 recalcarc [lindex $arcnos($id) 0]
10060 catch {unset cached_dtags}
10061 catch {unset cached_atags}
10064 proc addedhead {hid head} {
10065 global arcnos arcout cached_dheads
10067 if {![info exists arcnos($hid)]} return
10068 if {![info exists arcout($hid)]} {
10069 recalcarc [lindex $arcnos($hid) 0]
10071 catch {unset cached_dheads}
10074 proc removedhead {hid head} {
10075 global cached_dheads
10077 catch {unset cached_dheads}
10080 proc movedhead {hid head} {
10081 global arcnos arcout cached_dheads
10083 if {![info exists arcnos($hid)]} return
10084 if {![info exists arcout($hid)]} {
10085 recalcarc [lindex $arcnos($hid) 0]
10087 catch {unset cached_dheads}
10090 proc changedrefs {} {
10091 global cached_dheads cached_dtags cached_atags
10092 global arctags archeads arcnos arcout idheads idtags
10094 foreach id [concat [array names idheads] [array names idtags]] {
10095 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10096 set a [lindex $arcnos($id) 0]
10097 if {![info exists donearc($a)]} {
10103 catch {unset cached_dtags}
10104 catch {unset cached_atags}
10105 catch {unset cached_dheads}
10108 proc rereadrefs {} {
10109 global idtags idheads idotherrefs mainheadid
10111 set refids [concat [array names idtags] \
10112 [array names idheads] [array names idotherrefs]]
10113 foreach id $refids {
10114 if {![info exists ref($id)]} {
10115 set ref($id) [listrefs $id]
10118 set oldmainhead $mainheadid
10121 set refids [lsort -unique [concat $refids [array names idtags] \
10122 [array names idheads] [array names idotherrefs]]]
10123 foreach id $refids {
10124 set v [listrefs $id]
10125 if {![info exists ref($id)] || $ref($id) != $v} {
10129 if {$oldmainhead ne $mainheadid} {
10130 redrawtags $oldmainhead
10131 redrawtags $mainheadid
10136 proc listrefs {id} {
10137 global idtags idheads idotherrefs
10140 if {[info exists idtags($id)]} {
10144 if {[info exists idheads($id)]} {
10145 set y $idheads($id)
10148 if {[info exists idotherrefs($id)]} {
10149 set z $idotherrefs($id)
10151 return [list $x $y $z]
10154 proc showtag {tag isnew} {
10155 global ctext tagcontents tagids linknum tagobjid
10158 addtohistory [list showtag $tag 0]
10160 $ctext conf -state normal
10164 if {![info exists tagcontents($tag)]} {
10166 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
10169 if {[info exists tagcontents($tag)]} {
10170 set text $tagcontents($tag)
10172 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
10174 appendwithlinks $text {}
10175 $ctext conf -state disabled
10187 if {[info exists gitktmpdir]} {
10188 catch {file delete -force $gitktmpdir}
10192 proc mkfontdisp {font top which} {
10193 global fontattr fontpref $font
10195 set fontpref($font) [set $font]
10196 button $top.${font}but -text $which -font optionfont \
10197 -command [list choosefont $font $which]
10198 label $top.$font -relief flat -font $font \
10199 -text $fontattr($font,family) -justify left
10200 grid x $top.${font}but $top.$font -sticky w
10203 proc choosefont {font which} {
10204 global fontparam fontlist fonttop fontattr
10207 set fontparam(which) $which
10208 set fontparam(font) $font
10209 set fontparam(family) [font actual $font -family]
10210 set fontparam(size) $fontattr($font,size)
10211 set fontparam(weight) $fontattr($font,weight)
10212 set fontparam(slant) $fontattr($font,slant)
10215 if {![winfo exists $top]} {
10217 eval font config sample [font actual $font]
10219 make_transient $top $prefstop
10220 wm title $top [mc "Gitk font chooser"]
10221 label $top.l -textvariable fontparam(which)
10222 pack $top.l -side top
10223 set fontlist [lsort [font families]]
10225 listbox $top.f.fam -listvariable fontlist \
10226 -yscrollcommand [list $top.f.sb set]
10227 bind $top.f.fam <<ListboxSelect>> selfontfam
10228 scrollbar $top.f.sb -command [list $top.f.fam yview]
10229 pack $top.f.sb -side right -fill y
10230 pack $top.f.fam -side left -fill both -expand 1
10231 pack $top.f -side top -fill both -expand 1
10233 spinbox $top.g.size -from 4 -to 40 -width 4 \
10234 -textvariable fontparam(size) \
10235 -validatecommand {string is integer -strict %s}
10236 checkbutton $top.g.bold -padx 5 \
10237 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10238 -variable fontparam(weight) -onvalue bold -offvalue normal
10239 checkbutton $top.g.ital -padx 5 \
10240 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
10241 -variable fontparam(slant) -onvalue italic -offvalue roman
10242 pack $top.g.size $top.g.bold $top.g.ital -side left
10243 pack $top.g -side top
10244 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10246 $top.c create text 100 25 -anchor center -text $which -font sample \
10247 -fill black -tags text
10248 bind $top.c <Configure> [list centertext $top.c]
10249 pack $top.c -side top -fill x
10251 button $top.buts.ok -text [mc "OK"] -command fontok -default active
10252 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10253 bind $top <Key-Return> fontok
10254 bind $top <Key-Escape> fontcan
10255 grid $top.buts.ok $top.buts.can
10256 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10257 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10258 pack $top.buts -side bottom -fill x
10259 trace add variable fontparam write chg_fontparam
10262 $top.c itemconf text -text $which
10264 set i [lsearch -exact $fontlist $fontparam(family)]
10266 $top.f.fam selection set $i
10271 proc centertext {w} {
10272 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10276 global fontparam fontpref prefstop
10278 set f $fontparam(font)
10279 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10280 if {$fontparam(weight) eq "bold"} {
10281 lappend fontpref($f) "bold"
10283 if {$fontparam(slant) eq "italic"} {
10284 lappend fontpref($f) "italic"
10287 $w conf -text $fontparam(family) -font $fontpref($f)
10293 global fonttop fontparam
10295 if {[info exists fonttop]} {
10296 catch {destroy $fonttop}
10297 catch {font delete sample}
10303 proc selfontfam {} {
10304 global fonttop fontparam
10306 set i [$fonttop.f.fam curselection]
10308 set fontparam(family) [$fonttop.f.fam get $i]
10312 proc chg_fontparam {v sub op} {
10315 font config sample -$sub $fontparam($sub)
10319 global maxwidth maxgraphpct
10320 global oldprefs prefstop showneartags showlocalchanges
10321 global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10322 global tabstop limitdiffs autoselect extdifftool perfile_attrs
10326 if {[winfo exists $top]} {
10330 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10331 limitdiffs tabstop perfile_attrs} {
10332 set oldprefs($v) [set $v]
10335 wm title $top [mc "Gitk preferences"]
10336 make_transient $top .
10337 label $top.ldisp -text [mc "Commit list display options"]
10338 grid $top.ldisp - -sticky w -pady 10
10339 label $top.spacer -text " "
10340 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10342 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10343 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10344 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10346 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10347 grid x $top.maxpctl $top.maxpct -sticky w
10348 checkbutton $top.showlocal -text [mc "Show local changes"] \
10349 -font optionfont -variable showlocalchanges
10350 grid x $top.showlocal -sticky w
10351 checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10352 -font optionfont -variable autoselect
10353 grid x $top.autoselect -sticky w
10355 label $top.ddisp -text [mc "Diff display options"]
10356 grid $top.ddisp - -sticky w -pady 10
10357 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10358 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10359 grid x $top.tabstopl $top.tabstop -sticky w
10360 checkbutton $top.ntag -text [mc "Display nearby tags"] \
10361 -font optionfont -variable showneartags
10362 grid x $top.ntag -sticky w
10363 checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10364 -font optionfont -variable limitdiffs
10365 grid x $top.ldiff -sticky w
10366 checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10367 -font optionfont -variable perfile_attrs
10368 grid x $top.lattr -sticky w
10370 entry $top.extdifft -textvariable extdifftool
10371 frame $top.extdifff
10372 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10374 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10375 -command choose_extdiff
10376 pack $top.extdifff.l $top.extdifff.b -side left
10377 grid x $top.extdifff $top.extdifft -sticky w
10379 label $top.cdisp -text [mc "Colors: press to choose"]
10380 grid $top.cdisp - -sticky w -pady 10
10381 label $top.bg -padx 40 -relief sunk -background $bgcolor
10382 button $top.bgbut -text [mc "Background"] -font optionfont \
10383 -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10384 grid x $top.bgbut $top.bg -sticky w
10385 label $top.fg -padx 40 -relief sunk -background $fgcolor
10386 button $top.fgbut -text [mc "Foreground"] -font optionfont \
10387 -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10388 grid x $top.fgbut $top.fg -sticky w
10389 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10390 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10391 -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10392 [list $ctext tag conf d0 -foreground]]
10393 grid x $top.diffoldbut $top.diffold -sticky w
10394 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10395 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10396 -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10397 [list $ctext tag conf dresult -foreground]]
10398 grid x $top.diffnewbut $top.diffnew -sticky w
10399 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10400 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10401 -command [list choosecolor diffcolors 2 $top.hunksep \
10402 [mc "diff hunk header"] \
10403 [list $ctext tag conf hunksep -foreground]]
10404 grid x $top.hunksepbut $top.hunksep -sticky w
10405 label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10406 button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10407 -command [list choosecolor markbgcolor {} $top.markbgsep \
10408 [mc "marked line background"] \
10409 [list $ctext tag conf omark -background]]
10410 grid x $top.markbgbut $top.markbgsep -sticky w
10411 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10412 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10413 -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10414 grid x $top.selbgbut $top.selbgsep -sticky w
10416 label $top.cfont -text [mc "Fonts: press to choose"]
10417 grid $top.cfont - -sticky w -pady 10
10418 mkfontdisp mainfont $top [mc "Main font"]
10419 mkfontdisp textfont $top [mc "Diff display font"]
10420 mkfontdisp uifont $top [mc "User interface font"]
10423 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10424 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10425 bind $top <Key-Return> prefsok
10426 bind $top <Key-Escape> prefscan
10427 grid $top.buts.ok $top.buts.can
10428 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10429 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10430 grid $top.buts - - -pady 10 -sticky ew
10431 bind $top <Visibility> "focus $top.buts.ok"
10434 proc choose_extdiff {} {
10437 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10439 set extdifftool $prog
10443 proc choosecolor {v vi w x cmd} {
10446 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10447 -title [mc "Gitk: choose color for %s" $x]]
10448 if {$c eq {}} return
10449 $w conf -background $c
10454 proc setselbg {c} {
10455 global bglist cflist
10456 foreach w $bglist {
10457 $w configure -selectbackground $c
10459 $cflist tag configure highlight \
10460 -background [$cflist cget -selectbackground]
10461 allcanvs itemconf secsel -fill $c
10467 foreach w $bglist {
10468 $w conf -background $c
10475 foreach w $fglist {
10476 $w conf -foreground $c
10478 allcanvs itemconf text -fill $c
10479 $canv itemconf circle -outline $c
10480 $canv itemconf markid -outline $c
10484 global oldprefs prefstop
10486 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10487 limitdiffs tabstop perfile_attrs} {
10489 set $v $oldprefs($v)
10491 catch {destroy $prefstop}
10497 global maxwidth maxgraphpct
10498 global oldprefs prefstop showneartags showlocalchanges
10499 global fontpref mainfont textfont uifont
10500 global limitdiffs treediffs perfile_attrs
10502 catch {destroy $prefstop}
10506 if {$mainfont ne $fontpref(mainfont)} {
10507 set mainfont $fontpref(mainfont)
10508 parsefont mainfont $mainfont
10509 eval font configure mainfont [fontflags mainfont]
10510 eval font configure mainfontbold [fontflags mainfont 1]
10514 if {$textfont ne $fontpref(textfont)} {
10515 set textfont $fontpref(textfont)
10516 parsefont textfont $textfont
10517 eval font configure textfont [fontflags textfont]
10518 eval font configure textfontbold [fontflags textfont 1]
10520 if {$uifont ne $fontpref(uifont)} {
10521 set uifont $fontpref(uifont)
10522 parsefont uifont $uifont
10523 eval font configure uifont [fontflags uifont]
10526 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10527 if {$showlocalchanges} {
10533 if {$limitdiffs != $oldprefs(limitdiffs) ||
10534 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10535 # treediffs elements are limited by path;
10536 # won't have encodings cached if perfile_attrs was just turned on
10537 catch {unset treediffs}
10539 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10540 || $maxgraphpct != $oldprefs(maxgraphpct)} {
10542 } elseif {$showneartags != $oldprefs(showneartags) ||
10543 $limitdiffs != $oldprefs(limitdiffs)} {
10548 proc formatdate {d} {
10549 global datetimeformat
10551 set d [clock format $d -format $datetimeformat]
10556 # This list of encoding names and aliases is distilled from
10557 # http://www.iana.org/assignments/character-sets.
10558 # Not all of them are supported by Tcl.
10559 set encoding_aliases {
10560 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10561 ISO646-US US-ASCII us IBM367 cp367 csASCII }
10562 { ISO-10646-UTF-1 csISO10646UTF1 }
10563 { ISO_646.basic:1983 ref csISO646basic1983 }
10564 { INVARIANT csINVARIANT }
10565 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10566 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10567 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10568 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10569 { NATS-DANO iso-ir-9-1 csNATSDANO }
10570 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10571 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10572 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10573 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10574 { ISO-2022-KR csISO2022KR }
10576 { ISO-2022-JP csISO2022JP }
10577 { ISO-2022-JP-2 csISO2022JP2 }
10578 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10579 csISO13JISC6220jp }
10580 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10581 { IT iso-ir-15 ISO646-IT csISO15Italian }
10582 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10583 { ES iso-ir-17 ISO646-ES csISO17Spanish }
10584 { greek7-old iso-ir-18 csISO18Greek7Old }
10585 { latin-greek iso-ir-19 csISO19LatinGreek }
10586 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10587 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10588 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10589 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10590 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10591 { BS_viewdata iso-ir-47 csISO47BSViewdata }
10592 { INIS iso-ir-49 csISO49INIS }
10593 { INIS-8 iso-ir-50 csISO50INIS8 }
10594 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10595 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10596 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10597 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10598 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10599 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10600 csISO60Norwegian1 }
10601 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10602 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10603 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10604 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10605 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10606 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10607 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10608 { greek7 iso-ir-88 csISO88Greek7 }
10609 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10610 { iso-ir-90 csISO90 }
10611 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10612 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10613 csISO92JISC62991984b }
10614 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10615 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10616 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10617 csISO95JIS62291984handadd }
10618 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10619 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10620 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10621 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10622 CP819 csISOLatin1 }
10623 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10624 { T.61-7bit iso-ir-102 csISO102T617bit }
10625 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10626 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10627 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10628 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10629 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10630 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10631 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10632 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10633 arabic csISOLatinArabic }
10634 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10635 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10636 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10637 greek greek8 csISOLatinGreek }
10638 { T.101-G2 iso-ir-128 csISO128T101G2 }
10639 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10641 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10642 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10643 { CSN_369103 iso-ir-139 csISO139CSN369103 }
10644 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10645 { ISO_6937-2-add iso-ir-142 csISOTextComm }
10646 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10647 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10648 csISOLatinCyrillic }
10649 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10650 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10651 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10652 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10653 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10654 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10655 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10656 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10657 { ISO_10367-box iso-ir-155 csISO10367Box }
10658 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10659 { latin-lap lap iso-ir-158 csISO158Lap }
10660 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10661 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10664 { JIS_X0201 X0201 csHalfWidthKatakana }
10665 { KSC5636 ISO646-KR csKSC5636 }
10666 { ISO-10646-UCS-2 csUnicode }
10667 { ISO-10646-UCS-4 csUCS4 }
10668 { DEC-MCS dec csDECMCS }
10669 { hp-roman8 roman8 r8 csHPRoman8 }
10670 { macintosh mac csMacintosh }
10671 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10673 { IBM038 EBCDIC-INT cp038 csIBM038 }
10674 { IBM273 CP273 csIBM273 }
10675 { IBM274 EBCDIC-BE CP274 csIBM274 }
10676 { IBM275 EBCDIC-BR cp275 csIBM275 }
10677 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10678 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10679 { IBM280 CP280 ebcdic-cp-it csIBM280 }
10680 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10681 { IBM284 CP284 ebcdic-cp-es csIBM284 }
10682 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10683 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10684 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10685 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10686 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10687 { IBM424 cp424 ebcdic-cp-he csIBM424 }
10688 { IBM437 cp437 437 csPC8CodePage437 }
10689 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10690 { IBM775 cp775 csPC775Baltic }
10691 { IBM850 cp850 850 csPC850Multilingual }
10692 { IBM851 cp851 851 csIBM851 }
10693 { IBM852 cp852 852 csPCp852 }
10694 { IBM855 cp855 855 csIBM855 }
10695 { IBM857 cp857 857 csIBM857 }
10696 { IBM860 cp860 860 csIBM860 }
10697 { IBM861 cp861 861 cp-is csIBM861 }
10698 { IBM862 cp862 862 csPC862LatinHebrew }
10699 { IBM863 cp863 863 csIBM863 }
10700 { IBM864 cp864 csIBM864 }
10701 { IBM865 cp865 865 csIBM865 }
10702 { IBM866 cp866 866 csIBM866 }
10703 { IBM868 CP868 cp-ar csIBM868 }
10704 { IBM869 cp869 869 cp-gr csIBM869 }
10705 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10706 { IBM871 CP871 ebcdic-cp-is csIBM871 }
10707 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10708 { IBM891 cp891 csIBM891 }
10709 { IBM903 cp903 csIBM903 }
10710 { IBM904 cp904 904 csIBBM904 }
10711 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10712 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10713 { IBM1026 CP1026 csIBM1026 }
10714 { EBCDIC-AT-DE csIBMEBCDICATDE }
10715 { EBCDIC-AT-DE-A csEBCDICATDEA }
10716 { EBCDIC-CA-FR csEBCDICCAFR }
10717 { EBCDIC-DK-NO csEBCDICDKNO }
10718 { EBCDIC-DK-NO-A csEBCDICDKNOA }
10719 { EBCDIC-FI-SE csEBCDICFISE }
10720 { EBCDIC-FI-SE-A csEBCDICFISEA }
10721 { EBCDIC-FR csEBCDICFR }
10722 { EBCDIC-IT csEBCDICIT }
10723 { EBCDIC-PT csEBCDICPT }
10724 { EBCDIC-ES csEBCDICES }
10725 { EBCDIC-ES-A csEBCDICESA }
10726 { EBCDIC-ES-S csEBCDICESS }
10727 { EBCDIC-UK csEBCDICUK }
10728 { EBCDIC-US csEBCDICUS }
10729 { UNKNOWN-8BIT csUnknown8BiT }
10730 { MNEMONIC csMnemonic }
10732 { VISCII csVISCII }
10735 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10736 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10737 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10738 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10739 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10740 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10741 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10742 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10743 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10744 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10745 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10746 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10747 { IBM1047 IBM-1047 }
10748 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10749 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10750 { UNICODE-1-1 csUnicode11 }
10751 { CESU-8 csCESU-8 }
10752 { BOCU-1 csBOCU-1 }
10753 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10754 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10756 { ISO-8859-15 ISO_8859-15 Latin-9 }
10757 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10758 { GBK CP936 MS936 windows-936 }
10759 { JIS_Encoding csJISEncoding }
10760 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10761 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10763 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10764 { ISO-10646-UCS-Basic csUnicodeASCII }
10765 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10766 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10767 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10768 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10769 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10770 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10771 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10772 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10773 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10774 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10775 { Adobe-Standard-Encoding csAdobeStandardEncoding }
10776 { Ventura-US csVenturaUS }
10777 { Ventura-International csVenturaInternational }
10778 { PC8-Danish-Norwegian csPC8DanishNorwegian }
10779 { PC8-Turkish csPC8Turkish }
10780 { IBM-Symbols csIBMSymbols }
10781 { IBM-Thai csIBMThai }
10782 { HP-Legal csHPLegal }
10783 { HP-Pi-font csHPPiFont }
10784 { HP-Math8 csHPMath8 }
10785 { Adobe-Symbol-Encoding csHPPSMath }
10786 { HP-DeskTop csHPDesktop }
10787 { Ventura-Math csVenturaMath }
10788 { Microsoft-Publishing csMicrosoftPublishing }
10789 { Windows-31J csWindows31J }
10790 { GB2312 csGB2312 }
10794 proc tcl_encoding {enc} {
10795 global encoding_aliases tcl_encoding_cache
10796 if {[info exists tcl_encoding_cache($enc)]} {
10797 return $tcl_encoding_cache($enc)
10799 set names [encoding names]
10800 set lcnames [string tolower $names]
10801 set enc [string tolower $enc]
10802 set i [lsearch -exact $lcnames $enc]
10804 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10805 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10806 set i [lsearch -exact $lcnames $encx]
10810 foreach l $encoding_aliases {
10811 set ll [string tolower $l]
10812 if {[lsearch -exact $ll $enc] < 0} continue
10813 # look through the aliases for one that tcl knows about
10815 set i [lsearch -exact $lcnames $e]
10817 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10818 set i [lsearch -exact $lcnames $ex]
10828 set tclenc [lindex $names $i]
10830 set tcl_encoding_cache($enc) $tclenc
10834 proc gitattr {path attr default} {
10835 global path_attr_cache
10836 if {[info exists path_attr_cache($attr,$path)]} {
10837 set r $path_attr_cache($attr,$path)
10839 set r "unspecified"
10840 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10841 regexp "(.*): encoding: (.*)" $line m f r
10843 set path_attr_cache($attr,$path) $r
10845 if {$r eq "unspecified"} {
10851 proc cache_gitattr {attr pathlist} {
10852 global path_attr_cache
10854 foreach path $pathlist {
10855 if {![info exists path_attr_cache($attr,$path)]} {
10856 lappend newlist $path
10860 if {[tk windowingsystem] == "win32"} {
10861 # windows has a 32k limit on the arguments to a command...
10864 while {$newlist ne {}} {
10865 set head [lrange $newlist 0 [expr {$lim - 1}]]
10866 set newlist [lrange $newlist $lim end]
10867 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10868 foreach row [split $rlist "\n"] {
10869 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10870 if {[string index $path 0] eq "\""} {
10871 set path [encoding convertfrom [lindex $path 0]]
10873 set path_attr_cache($attr,$path) $value
10880 proc get_path_encoding {path} {
10881 global gui_encoding perfile_attrs
10882 set tcl_enc $gui_encoding
10883 if {$path ne {} && $perfile_attrs} {
10884 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10892 # First check that Tcl/Tk is recent enough
10893 if {[catch {package require Tk 8.4} err]} {
10894 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10895 Gitk requires at least Tcl/Tk 8.4."]
10900 set wrcomcmd "git diff-tree --stdin -p --pretty"
10904 set gitencoding [exec git config --get i18n.commitencoding]
10907 set gitencoding [exec git config --get i18n.logoutputencoding]
10909 if {$gitencoding == ""} {
10910 set gitencoding "utf-8"
10912 set tclencoding [tcl_encoding $gitencoding]
10913 if {$tclencoding == {}} {
10914 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10917 set gui_encoding [encoding system]
10919 set enc [exec git config --get gui.encoding]
10921 set tclenc [tcl_encoding $enc]
10922 if {$tclenc ne {}} {
10923 set gui_encoding $tclenc
10925 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10930 if {[tk windowingsystem] eq "aqua"} {
10931 set mainfont {{Lucida Grande} 9}
10932 set textfont {Monaco 9}
10933 set uifont {{Lucida Grande} 9 bold}
10935 set mainfont {Helvetica 9}
10936 set textfont {Courier 9}
10937 set uifont {Helvetica 9 bold}
10940 set findmergefiles 0
10948 set cmitmode "patch"
10949 set wrapcomment "none"
10953 set showlocalchanges 1
10955 set datetimeformat "%Y-%m-%d %H:%M:%S"
10957 set perfile_attrs 0
10959 if {[tk windowingsystem] eq "aqua"} {
10960 set extdifftool "opendiff"
10962 set extdifftool "meld"
10965 set colors {green red blue magenta darkgrey brown orange}
10968 set diffcolors {red "#00a000" blue}
10971 set selectbgcolor gray85
10972 set markbgcolor "#e0e0ff"
10974 set circlecolors {white blue gray blue blue}
10976 # button for popping up context menus
10977 if {[tk windowingsystem] eq "aqua"} {
10978 set ctxbut <Button-2>
10980 set ctxbut <Button-3>
10983 ## For msgcat loading, first locate the installation location.
10984 if { [info exists ::env(GITK_MSGSDIR)] } {
10985 ## Msgsdir was manually set in the environment.
10986 set gitk_msgsdir $::env(GITK_MSGSDIR)
10988 ## Let's guess the prefix from argv0.
10989 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10990 set gitk_libdir [file join $gitk_prefix share gitk lib]
10991 set gitk_msgsdir [file join $gitk_libdir msgs]
10995 ## Internationalization (i18n) through msgcat and gettext. See
10996 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10997 package require msgcat
10998 namespace import ::msgcat::mc
10999 ## And eventually load the actual message catalog
11000 ::msgcat::mcload $gitk_msgsdir
11002 catch {source ~/.gitk}
11004 font create optionfont -family sans-serif -size -12
11006 parsefont mainfont $mainfont
11007 eval font create mainfont [fontflags mainfont]
11008 eval font create mainfontbold [fontflags mainfont 1]
11010 parsefont textfont $textfont
11011 eval font create textfont [fontflags textfont]
11012 eval font create textfontbold [fontflags textfont 1]
11014 parsefont uifont $uifont
11015 eval font create uifont [fontflags uifont]
11019 # check that we can find a .git directory somewhere...
11020 if {[catch {set gitdir [gitdir]}]} {
11021 show_error {} . [mc "Cannot find a git repository here."]
11024 if {![file isdirectory $gitdir]} {
11025 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
11030 set selectheadid {}
11033 set cmdline_files {}
11035 set revtreeargscmd {}
11036 foreach arg $argv {
11037 switch -glob -- $arg {
11040 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11043 "--select-commit=*" {
11044 set selecthead [string range $arg 16 end]
11047 set revtreeargscmd [string range $arg 10 end]
11050 lappend revtreeargs $arg
11056 if {$selecthead eq "HEAD"} {
11060 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11061 # no -- on command line, but some arguments (other than --argscmd)
11063 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11064 set cmdline_files [split $f "\n"]
11065 set n [llength $cmdline_files]
11066 set revtreeargs [lrange $revtreeargs 0 end-$n]
11067 # Unfortunately git rev-parse doesn't produce an error when
11068 # something is both a revision and a filename. To be consistent
11069 # with git log and git rev-list, check revtreeargs for filenames.
11070 foreach arg $revtreeargs {
11071 if {[file exists $arg]} {
11072 show_error {} . [mc "Ambiguous argument '%s': both revision\
11073 and filename" $arg]
11078 # unfortunately we get both stdout and stderr in $err,
11079 # so look for "fatal:".
11080 set i [string first "fatal:" $err]
11082 set err [string range $err [expr {$i + 6}] end]
11084 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11089 set nullid "0000000000000000000000000000000000000000"
11090 set nullid2 "0000000000000000000000000000000000000001"
11091 set nullfile "/dev/null"
11093 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11100 set highlight_paths {}
11102 set searchdirn -forwards
11105 set diffelide {0 0}
11106 set markingmatches 0
11107 set linkentercount 0
11108 set need_redisplay 0
11115 set selectedhlview [mc "None"]
11116 set highlight_related [mc "None"]
11117 set highlight_files {}
11118 set viewfiles(0) {}
11121 set viewargscmd(0) {}
11123 set selectedline {}
11131 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11135 image create photo gitlogo -width 16 -height 16
11137 image create photo gitlogominus -width 4 -height 2
11138 gitlogominus put #C00000 -to 0 0 4 2
11139 gitlogo copy gitlogominus -to 1 5
11140 gitlogo copy gitlogominus -to 6 5
11141 gitlogo copy gitlogominus -to 11 5
11142 image delete gitlogominus
11144 image create photo gitlogoplus -width 4 -height 4
11145 gitlogoplus put #008000 -to 1 0 3 4
11146 gitlogoplus put #008000 -to 0 1 4 3
11147 gitlogo copy gitlogoplus -to 1 9
11148 gitlogo copy gitlogoplus -to 6 9
11149 gitlogo copy gitlogoplus -to 11 9
11150 image delete gitlogoplus
11152 image create photo gitlogo32 -width 32 -height 32
11153 gitlogo32 copy gitlogo -zoom 2 2
11155 wm iconphoto . -default gitlogo gitlogo32
11157 # wait for the window to become visible
11158 tkwait visibility .
11159 wm title . "[file tail $argv0]: [file tail [pwd]]"
11163 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11164 # create a view for the files/dirs specified on the command line
11168 set viewname(1) [mc "Command line"]
11169 set viewfiles(1) $cmdline_files
11170 set viewargs(1) $revtreeargs
11171 set viewargscmd(1) $revtreeargscmd
11175 .bar.view entryconf [mca "Edit view..."] -state normal
11176 .bar.view entryconf [mca "Delete view"] -state normal
11179 if {[info exists permviews]} {
11180 foreach v $permviews {
11183 set viewname($n) [lindex $v 0]
11184 set viewfiles($n) [lindex $v 1]
11185 set viewargs($n) [lindex $v 2]
11186 set viewargscmd($n) [lindex $v 3]
11192 if {[tk windowingsystem] eq "win32"} {