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 {[tk windowingsystem
] eq
{aqua
}} {
2262 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2263 pack .ctop
-fill both
-expand 1
2264 bindall
<1> {selcanvline
%W
%x
%y
}
2265 #bindall <B1-Motion> {selcanvline %W %x %y}
2266 if {[tk windowingsystem
] == "win32"} {
2267 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2268 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2270 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2271 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2272 if {[tk windowingsystem
] eq
"aqua"} {
2273 bindall
<MouseWheel
> {
2274 set delta
[expr {- (%D
)}]
2275 allcanvs yview scroll
$delta units
2277 bindall
<Shift-MouseWheel
> {
2278 set delta
[expr {- (%D
)}]
2279 $canv xview scroll
$delta units
2283 bindall
<$
::BM
> "canvscan mark %W %x %y"
2284 bindall
<B$
::BM-Motion
> "canvscan dragto %W %x %y"
2285 bindkey
<Home
> selfirstline
2286 bindkey
<End
> sellastline
2287 bind .
<Key-Up
> "selnextline -1"
2288 bind .
<Key-Down
> "selnextline 1"
2289 bind .
<Shift-Key-Up
> "dofind -1 0"
2290 bind .
<Shift-Key-Down
> "dofind 1 0"
2291 bindkey
<Key-Right
> "goforw"
2292 bindkey
<Key-Left
> "goback"
2293 bind .
<Key-Prior
> "selnextpage -1"
2294 bind .
<Key-Next
> "selnextpage 1"
2295 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2296 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2297 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2298 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2299 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2300 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2301 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2302 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2303 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2304 bindkey p
"selnextline -1"
2305 bindkey n
"selnextline 1"
2308 bindkey i
"selnextline -1"
2309 bindkey k
"selnextline 1"
2313 bindkey d
"$ctext yview scroll 18 units"
2314 bindkey u
"$ctext yview scroll -18 units"
2315 bindkey
/ {focus
$fstring}
2316 bindkey
<Key-KP_Divide
> {focus
$fstring}
2317 bindkey
<Key-Return
> {dofind
1 1}
2318 bindkey ?
{dofind
-1 1}
2320 bind .
<F5
> updatecommits
2321 bind .
<$M1B-F5> reloadcommits
2322 bind .
<F2
> showrefs
2323 bind .
<Shift-F4
> {newview
0}
2324 catch
{ bind .
<Shift-Key-XF86_Switch_VT_4
> {newview
0} }
2325 bind .
<F4
> edit_or_newview
2326 bind .
<$M1B-q> doquit
2327 bind .
<$M1B-f> {dofind
1 1}
2328 bind .
<$M1B-g> {dofind
1 0}
2329 bind .
<$M1B-r> dosearchback
2330 bind .
<$M1B-s> dosearch
2331 bind .
<$M1B-equal> {incrfont
1}
2332 bind .
<$M1B-plus> {incrfont
1}
2333 bind .
<$M1B-KP_Add> {incrfont
1}
2334 bind .
<$M1B-minus> {incrfont
-1}
2335 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2336 wm protocol . WM_DELETE_WINDOW doquit
2337 bind .
<Destroy
> {stop_backends
}
2338 bind .
<Button-1
> "click %W"
2339 bind $fstring <Key-Return
> {dofind
1 1}
2340 bind $sha1entry <Key-Return
> {gotocommit
; break}
2341 bind $sha1entry <<PasteSelection>> clearsha1
2342 bind $cflist <1> {sel_flist %W %x %y; break}
2343 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2344 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2346 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2347 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2349 set maincursor [. cget -cursor]
2350 set textcursor [$ctext cget -cursor]
2351 set curtextcursor $textcursor
2353 set rowctxmenu .rowctxmenu
2354 makemenu $rowctxmenu {
2355 {mc "Diff this -> selected" command {diffvssel 0}}
2356 {mc "Diff selected -> this" command {diffvssel 1}}
2357 {mc "Make patch" command mkpatch}
2358 {mc "Create tag" command mktag}
2359 {mc "Write commit to file" command writecommit}
2360 {mc "Create new branch" command mkbranch}
2361 {mc "Cherry-pick this commit" command cherrypick}
2362 {mc "Reset HEAD branch to here" command resethead}
2363 {mc "Mark this commit" command markhere}
2364 {mc "Return to mark" command gotomark}
2365 {mc "Find descendant of this and mark" command find_common_desc}
2366 {mc "Compare with marked commit" command compare_commits}
2368 $rowctxmenu configure -tearoff 0
2370 set fakerowmenu .fakerowmenu
2371 makemenu $fakerowmenu {
2372 {mc "Diff this -> selected" command {diffvssel 0}}
2373 {mc "Diff selected -> this" command {diffvssel 1}}
2374 {mc "Make patch" command mkpatch}
2376 $fakerowmenu configure -tearoff 0
2378 set headctxmenu .headctxmenu
2379 makemenu $headctxmenu {
2380 {mc "Check out this branch" command cobranch}
2381 {mc "Remove this branch" command rmbranch}
2383 $headctxmenu configure -tearoff 0
2386 set flist_menu .flistctxmenu
2387 makemenu $flist_menu {
2388 {mc "Highlight this too" command {flist_hl 0}}
2389 {mc "Highlight this only" command {flist_hl 1}}
2390 {mc "External diff" command {external_diff}}
2391 {mc "Blame parent commit" command {external_blame 1}}
2393 $flist_menu configure -tearoff 0
2396 set diff_menu .diffctxmenu
2397 makemenu $diff_menu {
2398 {mc "Show origin of this line" command show_line_source}
2399 {mc "Run git gui blame on this line" command {external_blame_diff}}
2401 $diff_menu configure -tearoff 0
2404 # Windows sends all mouse wheel events to the current focused window, not
2405 # the one where the mouse hovers, so bind those events here and redirect
2406 # to the correct window
2407 proc windows_mousewheel_redirector {W X Y D} {
2408 global canv canv2 canv3
2409 set w [winfo containing -displayof $W $X $Y]
2411 set u [expr {$D < 0 ? 5 : -5}]
2412 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2413 allcanvs yview scroll $u units
2416 $w yview scroll $u units
2422 # Update row number label when selectedline changes
2423 proc selectedline_change {n1 n2 op} {
2424 global selectedline rownumsel
2426 if {$selectedline eq {}} {
2429 set rownumsel [expr {$selectedline + 1}]
2433 # mouse-2 makes all windows scan vertically, but only the one
2434 # the cursor is in scans horizontally
2435 proc canvscan {op w x y} {
2436 global canv canv2 canv3
2437 foreach c [list $canv $canv2 $canv3] {
2446 proc scrollcanv {cscroll f0 f1} {
2447 $cscroll set $f0 $f1
2452 # when we make a key binding for the toplevel, make sure
2453 # it doesn't get triggered when that key is pressed in the
2454 # find string entry widget.
2455 proc bindkey {ev script} {
2458 set escript [bind Entry $ev]
2459 if {$escript == {}} {
2460 set escript [bind Entry <Key>]
2462 foreach e $entries {
2463 bind $e $ev "$escript; break"
2467 # set the focus back to the toplevel for any click outside
2470 global ctext entries
2471 foreach e [concat $entries $ctext] {
2472 if {$w == $e} return
2477 # Adjust the progress bar for a change in requested extent or canvas size
2478 proc adjustprogress {} {
2479 global progresscanv progressitem progresscoords
2480 global fprogitem fprogcoord lastprogupdate progupdatepending
2481 global rprogitem rprogcoord
2483 set w [expr {[winfo width $progresscanv] - 4}]
2484 set x0 [expr {$w * [lindex $progresscoords 0]}]
2485 set x1 [expr {$w * [lindex $progresscoords 1]}]
2486 set h [winfo height $progresscanv]
2487 $progresscanv coords $progressitem $x0 0 $x1 $h
2488 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2489 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2490 set now [clock clicks -milliseconds]
2491 if {$now >= $lastprogupdate + 100} {
2492 set progupdatepending 0
2494 } elseif {!$progupdatepending} {
2495 set progupdatepending 1
2496 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2500 proc doprogupdate {} {
2501 global lastprogupdate progupdatepending
2503 if {$progupdatepending} {
2504 set progupdatepending 0
2505 set lastprogupdate [clock clicks -milliseconds]
2510 proc savestuff {w} {
2511 global canv canv2 canv3 mainfont textfont uifont tabstop
2512 global stuffsaved findmergefiles maxgraphpct
2513 global maxwidth showneartags showlocalchanges
2514 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2515 global cmitmode wrapcomment datetimeformat limitdiffs
2516 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2517 global autoselect extdifftool perfile_attrs markbgcolor
2519 if {$stuffsaved} return
2520 if {![winfo viewable .]} return
2522 set f [open "~/.gitk-new" w]
2523 if {$::tcl_platform(platform) eq {windows}} {
2524 file attributes "~/.gitk-new" -hidden true
2526 puts $f [list set mainfont $mainfont]
2527 puts $f [list set textfont $textfont]
2528 puts $f [list set uifont $uifont]
2529 puts $f [list set tabstop $tabstop]
2530 puts $f [list set findmergefiles $findmergefiles]
2531 puts $f [list set maxgraphpct $maxgraphpct]
2532 puts $f [list set maxwidth $maxwidth]
2533 puts $f [list set cmitmode $cmitmode]
2534 puts $f [list set wrapcomment $wrapcomment]
2535 puts $f [list set autoselect $autoselect]
2536 puts $f [list set showneartags $showneartags]
2537 puts $f [list set showlocalchanges $showlocalchanges]
2538 puts $f [list set datetimeformat $datetimeformat]
2539 puts $f [list set limitdiffs $limitdiffs]
2540 puts $f [list set bgcolor $bgcolor]
2541 puts $f [list set fgcolor $fgcolor]
2542 puts $f [list set colors $colors]
2543 puts $f [list set diffcolors $diffcolors]
2544 puts $f [list set markbgcolor $markbgcolor]
2545 puts $f [list set diffcontext $diffcontext]
2546 puts $f [list set selectbgcolor $selectbgcolor]
2547 puts $f [list set extdifftool $extdifftool]
2548 puts $f [list set perfile_attrs $perfile_attrs]
2550 puts $f "set geometry(main) [wm geometry .]"
2551 puts $f "set geometry(topwidth) [winfo width .tf]"
2552 puts $f "set geometry(topheight) [winfo height .tf]"
2553 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2554 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2555 puts $f "set geometry(botwidth) [winfo width .bleft]"
2556 puts $f "set geometry(botheight) [winfo height .bleft]"
2558 puts -nonewline $f "set permviews {"
2559 for {set v 0} {$v < $nextviewnum} {incr v} {
2560 if {$viewperm($v)} {
2561 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2566 file rename -force "~/.gitk-new" "~/.gitk"
2571 proc resizeclistpanes {win w} {
2573 if {[info exists oldwidth($win)]} {
2574 set s0 [$win sash coord 0]
2575 set s1 [$win sash coord 1]
2577 set sash0 [expr {int($w/2 - 2)}]
2578 set sash1 [expr {int($w*5/6 - 2)}]
2580 set factor [expr {1.0 * $w / $oldwidth($win)}]
2581 set sash0 [expr {int($factor * [lindex $s0 0])}]
2582 set sash1 [expr {int($factor * [lindex $s1 0])}]
2586 if {$sash1 < $sash0 + 20} {
2587 set sash1 [expr {$sash0 + 20}]
2589 if {$sash1 > $w - 10} {
2590 set sash1 [expr {$w - 10}]
2591 if {$sash0 > $sash1 - 20} {
2592 set sash0 [expr {$sash1 - 20}]
2596 $win sash place 0 $sash0 [lindex $s0 1]
2597 $win sash place 1 $sash1 [lindex $s1 1]
2599 set oldwidth($win) $w
2602 proc resizecdetpanes {win w} {
2604 if {[info exists oldwidth($win)]} {
2605 set s0 [$win sash coord 0]
2607 set sash0 [expr {int($w*3/4 - 2)}]
2609 set factor [expr {1.0 * $w / $oldwidth($win)}]
2610 set sash0 [expr {int($factor * [lindex $s0 0])}]
2614 if {$sash0 > $w - 15} {
2615 set sash0 [expr {$w - 15}]
2618 $win sash place 0 $sash0 [lindex $s0 1]
2620 set oldwidth($win) $w
2623 proc allcanvs args {
2624 global canv canv2 canv3
2630 proc bindall {event action} {
2631 global canv canv2 canv3
2632 bind $canv $event $action
2633 bind $canv2 $event $action
2634 bind $canv3 $event $action
2640 if {[winfo exists $w]} {
2645 wm title $w [mc "About gitk"]
2647 message $w.m -text [mc "
2648 Gitk - a commit viewer for git
2650 Copyright © 2005-2008 Paul Mackerras
2652 Use and redistribute under the terms of the GNU General Public License"] \
2653 -justify center -aspect 400 -border 2 -bg white -relief groove
2654 pack $w.m -side top -fill x -padx 2 -pady 2
2655 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2656 pack $w.ok -side bottom
2657 bind $w <Visibility> "focus $w.ok"
2658 bind $w <Key-Escape> "destroy $w"
2659 bind $w <Key-Return> "destroy $w"
2664 if {[winfo exists $w]} {
2668 if {[tk windowingsystem] eq {aqua}} {
2674 wm title $w [mc "Gitk key bindings"]
2676 message $w.m -text "
2677 [mc "Gitk key bindings:"]
2679 [mc "<%s-Q> Quit" $M1T]
2680 [mc "<Home> Move to first commit"]
2681 [mc "<End> Move to last commit"]
2682 [mc "<Up>, p, i Move up one commit"]
2683 [mc "<Down>, n, k Move down one commit"]
2684 [mc "<Left>, z, j Go back in history list"]
2685 [mc "<Right>, x, l Go forward in history list"]
2686 [mc "<PageUp> Move up one page in commit list"]
2687 [mc "<PageDown> Move down one page in commit list"]
2688 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2689 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2690 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2691 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2692 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2693 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2694 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2695 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2696 [mc "<Delete>, b Scroll diff view up one page"]
2697 [mc "<Backspace> Scroll diff view up one page"]
2698 [mc "<Space> Scroll diff view down one page"]
2699 [mc "u Scroll diff view up 18 lines"]
2700 [mc "d Scroll diff view down 18 lines"]
2701 [mc "<%s-F> Find" $M1T]
2702 [mc "<%s-G> Move to next find hit" $M1T]
2703 [mc "<Return> Move to next find hit"]
2704 [mc "/ Focus the search box"]
2705 [mc "? Move to previous find hit"]
2706 [mc "f Scroll diff view to next file"]
2707 [mc "<%s-S> Search for next hit in diff view" $M1T]
2708 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2709 [mc "<%s-KP+> Increase font size" $M1T]
2710 [mc "<%s-plus> Increase font size" $M1T]
2711 [mc "<%s-KP-> Decrease font size" $M1T]
2712 [mc "<%s-minus> Decrease font size" $M1T]
2715 -justify left -bg white -border 2 -relief groove
2716 pack $w.m -side top -fill both -padx 2 -pady 2
2717 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2718 bind $w <Key-Escape> [list destroy $w]
2719 pack $w.ok -side bottom
2720 bind $w <Visibility> "focus $w.ok"
2721 bind $w <Key-Escape> "destroy $w"
2722 bind $w <Key-Return> "destroy $w"
2725 # Procedures for manipulating the file list window at the
2726 # bottom right of the overall window.
2728 proc treeview {w l openlevs} {
2729 global treecontents treediropen treeheight treeparent treeindex
2739 set treecontents() {}
2740 $w conf -state normal
2742 while {[string range $f 0 $prefixend] ne $prefix} {
2743 if {$lev <= $openlevs} {
2744 $w mark set e:$treeindex($prefix) "end -1c"
2745 $w mark gravity e:$treeindex($prefix) left
2747 set treeheight($prefix) $ht
2748 incr ht [lindex $htstack end]
2749 set htstack [lreplace $htstack end end]
2750 set prefixend [lindex $prefendstack end]
2751 set prefendstack [lreplace $prefendstack end end]
2752 set prefix [string range $prefix 0 $prefixend]
2755 set tail [string range $f [expr {$prefixend+1}] end]
2756 while {[set slash [string first "/" $tail]] >= 0} {
2759 lappend prefendstack $prefixend
2760 incr prefixend [expr {$slash + 1}]
2761 set d [string range $tail 0 $slash]
2762 lappend treecontents($prefix) $d
2763 set oldprefix $prefix
2765 set treecontents($prefix) {}
2766 set treeindex($prefix) [incr ix]
2767 set treeparent($prefix) $oldprefix
2768 set tail [string range $tail [expr {$slash+1}] end]
2769 if {$lev <= $openlevs} {
2771 set treediropen($prefix) [expr {$lev < $openlevs}]
2772 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2773 $w mark set d:$ix "end -1c"
2774 $w mark gravity d:$ix left
2776 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2778 $w image create end -align center -image $bm -padx 1 \
2780 $w insert end $d [highlight_tag $prefix]
2781 $w mark set s:$ix "end -1c"
2782 $w mark gravity s:$ix left
2787 if {$lev <= $openlevs} {
2790 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2792 $w insert end $tail [highlight_tag $f]
2794 lappend treecontents($prefix) $tail
2797 while {$htstack ne {}} {
2798 set treeheight($prefix) $ht
2799 incr ht [lindex $htstack end]
2800 set htstack [lreplace $htstack end end]
2801 set prefixend [lindex $prefendstack end]
2802 set prefendstack [lreplace $prefendstack end end]
2803 set prefix [string range $prefix 0 $prefixend]
2805 $w conf -state disabled
2808 proc linetoelt {l} {
2809 global treeheight treecontents
2814 foreach e $treecontents($prefix) {
2819 if {[string index $e end] eq "/"} {
2820 set n $treeheight($prefix$e)
2832 proc highlight_tree {y prefix} {
2833 global treeheight treecontents cflist
2835 foreach e $treecontents($prefix) {
2837 if {[highlight_tag $path] ne {}} {
2838 $cflist tag add bold $y.0 "$y.0 lineend"
2841 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2842 set y [highlight_tree $y $path]
2848 proc treeclosedir {w dir} {
2849 global treediropen treeheight treeparent treeindex
2851 set ix $treeindex($dir)
2852 $w conf -state normal
2853 $w delete s:$ix e:$ix
2854 set treediropen($dir) 0
2855 $w image configure a:$ix -image tri-rt
2856 $w conf -state disabled
2857 set n [expr {1 - $treeheight($dir)}]
2858 while {$dir ne {}} {
2859 incr treeheight($dir) $n
2860 set dir $treeparent($dir)
2864 proc treeopendir {w dir} {
2865 global treediropen treeheight treeparent treecontents treeindex
2867 set ix $treeindex($dir)
2868 $w conf -state normal
2869 $w image configure a:$ix -image tri-dn
2870 $w mark set e:$ix s:$ix
2871 $w mark gravity e:$ix right
2874 set n [llength $treecontents($dir)]
2875 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2878 incr treeheight($x) $n
2880 foreach e $treecontents($dir) {
2882 if {[string index $e end] eq "/"} {
2883 set iy $treeindex($de)
2884 $w mark set d:$iy e:$ix
2885 $w mark gravity d:$iy left
2886 $w insert e:$ix $str
2887 set treediropen($de) 0
2888 $w image create e:$ix -align center -image tri-rt -padx 1 \
2890 $w insert e:$ix $e [highlight_tag $de]
2891 $w mark set s:$iy e:$ix
2892 $w mark gravity s:$iy left
2893 set treeheight($de) 1
2895 $w insert e:$ix $str
2896 $w insert e:$ix $e [highlight_tag $de]
2899 $w mark gravity e:$ix right
2900 $w conf -state disabled
2901 set treediropen($dir) 1
2902 set top [lindex [split [$w index @0,0] .] 0]
2903 set ht [$w cget -height]
2904 set l [lindex [split [$w index s:$ix] .] 0]
2907 } elseif {$l + $n + 1 > $top + $ht} {
2908 set top [expr {$l + $n + 2 - $ht}]
2916 proc treeclick {w x y} {
2917 global treediropen cmitmode ctext cflist cflist_top
2919 if {$cmitmode ne "tree"} return
2920 if {![info exists cflist_top]} return
2921 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2922 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2923 $cflist tag add highlight $l.0 "$l.0 lineend"
2929 set e [linetoelt $l]
2930 if {[string index $e end] ne "/"} {
2932 } elseif {$treediropen($e)} {
2939 proc setfilelist {id} {
2940 global treefilelist cflist jump_to_here
2942 treeview $cflist $treefilelist($id) 0
2943 if {$jump_to_here ne {}} {
2944 set f [lindex $jump_to_here 0]
2945 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
2951 image create bitmap tri-rt -background black -foreground blue -data {
2952 #define tri-rt_width 13
2953 #define tri-rt_height 13
2954 static unsigned char tri-rt_bits[] = {
2955 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2956 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2959 #define tri-rt-mask_width 13
2960 #define tri-rt-mask_height 13
2961 static unsigned char tri-rt-mask_bits[] = {
2962 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2963 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2966 image create bitmap tri-dn -background black -foreground blue -data {
2967 #define tri-dn_width 13
2968 #define tri-dn_height 13
2969 static unsigned char tri-dn_bits[] = {
2970 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2971 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2974 #define tri-dn-mask_width 13
2975 #define tri-dn-mask_height 13
2976 static unsigned char tri-dn-mask_bits[] = {
2977 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2978 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2982 image create bitmap reficon-T -background black -foreground yellow -data {
2983 #define tagicon_width 13
2984 #define tagicon_height 9
2985 static unsigned char tagicon_bits[] = {
2986 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2987 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2989 #define tagicon-mask_width 13
2990 #define tagicon-mask_height 9
2991 static unsigned char tagicon-mask_bits[] = {
2992 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2993 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2996 #define headicon_width 13
2997 #define headicon_height 9
2998 static unsigned char headicon_bits[] = {
2999 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3000 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3003 #define headicon-mask_width 13
3004 #define headicon-mask_height 9
3005 static unsigned char headicon-mask_bits[] = {
3006 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3007 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3009 image create bitmap reficon-H -background black -foreground green \
3010 -data $rectdata -maskdata $rectmask
3011 image create bitmap reficon-o -background black -foreground "#ddddff" \
3012 -data $rectdata -maskdata $rectmask
3014 proc init_flist {first} {
3015 global cflist cflist_top difffilestart
3017 $cflist conf -state normal
3018 $cflist delete 0.0 end
3020 $cflist insert end $first
3022 $cflist tag add highlight 1.0 "1.0 lineend"
3024 catch {unset cflist_top}
3026 $cflist conf -state disabled
3027 set difffilestart {}
3030 proc highlight_tag {f} {
3031 global highlight_paths
3033 foreach p $highlight_paths {
3034 if {[string match $p $f]} {
3041 proc highlight_filelist {} {
3042 global cmitmode cflist
3044 $cflist conf -state normal
3045 if {$cmitmode ne "tree"} {
3046 set end [lindex [split [$cflist index end] .] 0]
3047 for {set l 2} {$l < $end} {incr l} {
3048 set line [$cflist get $l.0 "$l.0 lineend"]
3049 if {[highlight_tag $line] ne {}} {
3050 $cflist tag add bold $l.0 "$l.0 lineend"
3056 $cflist conf -state disabled
3059 proc unhighlight_filelist {} {
3062 $cflist conf -state normal
3063 $cflist tag remove bold 1.0 end
3064 $cflist conf -state disabled
3067 proc add_flist {fl} {
3070 $cflist conf -state normal
3072 $cflist insert end "\n"
3073 $cflist insert end $f [highlight_tag $f]
3075 $cflist conf -state disabled
3078 proc sel_flist {w x y} {
3079 global ctext difffilestart cflist cflist_top cmitmode
3081 if {$cmitmode eq "tree"} return
3082 if {![info exists cflist_top]} return
3083 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3084 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3085 $cflist tag add highlight $l.0 "$l.0 lineend"
3090 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3094 proc pop_flist_menu {w X Y x y} {
3095 global ctext cflist cmitmode flist_menu flist_menu_file
3096 global treediffs diffids
3099 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3101 if {$cmitmode eq "tree"} {
3102 set e [linetoelt $l]
3103 if {[string index $e end] eq "/"} return
3105 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3107 set flist_menu_file $e
3108 set xdiffstate "normal"
3109 if {$cmitmode eq "tree"} {
3110 set xdiffstate "disabled"
3112 # Disable "External diff" item in tree mode
3113 $flist_menu entryconf 2 -state $xdiffstate
3114 tk_popup $flist_menu $X $Y
3117 proc find_ctext_fileinfo {line} {
3118 global ctext_file_names ctext_file_lines
3120 set ok [bsearch $ctext_file_lines $line]
3121 set tline [lindex $ctext_file_lines $ok]
3123 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3126 return [list [lindex $ctext_file_names $ok] $tline]
3130 proc pop_diff_menu {w X Y x y} {
3131 global ctext diff_menu flist_menu_file
3132 global diff_menu_txtpos diff_menu_line
3133 global diff_menu_filebase
3135 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3136 set diff_menu_line [lindex $diff_menu_txtpos 0]
3137 # don't pop up the menu on hunk-separator or file-separator lines
3138 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3142 set f [find_ctext_fileinfo $diff_menu_line]
3143 if {$f eq {}} return
3144 set flist_menu_file [lindex $f 0]
3145 set diff_menu_filebase [lindex $f 1]
3146 tk_popup $diff_menu $X $Y
3149 proc flist_hl {only} {
3150 global flist_menu_file findstring gdttype
3152 set x [shellquote $flist_menu_file]
3153 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3156 append findstring " " $x
3158 set gdttype [mc "touching paths:"]
3161 proc save_file_from_commit {filename output what} {
3164 if {[catch {exec git show $filename -- > $output} err]} {
3165 if {[string match "fatal: bad revision *" $err]} {
3168 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3174 proc external_diff_get_one_file {diffid filename diffdir} {
3175 global nullid nullid2 nullfile
3178 if {$diffid == $nullid} {
3179 set difffile [file join [file dirname $gitdir] $filename]
3180 if {[file exists $difffile]} {
3185 if {$diffid == $nullid2} {
3186 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3187 return [save_file_from_commit :$filename $difffile index]
3189 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3190 return [save_file_from_commit $diffid:$filename $difffile \
3194 proc external_diff {} {
3195 global gitktmpdir nullid nullid2
3196 global flist_menu_file
3199 global gitdir extdifftool
3201 if {[llength $diffids] == 1} {
3202 # no reference commit given
3203 set diffidto [lindex $diffids 0]
3204 if {$diffidto eq $nullid} {
3205 # diffing working copy with index
3206 set diffidfrom $nullid2
3207 } elseif {$diffidto eq $nullid2} {
3208 # diffing index with HEAD
3209 set diffidfrom "HEAD"
3211 # use first parent commit
3212 global parentlist selectedline
3213 set diffidfrom [lindex $parentlist $selectedline 0]
3216 set diffidfrom [lindex $diffids 0]
3217 set diffidto [lindex $diffids 1]
3220 # make sure that several diffs wont collide
3221 if {![info exists gitktmpdir]} {
3222 set gitktmpdir [file join [file dirname $gitdir] \
3223 [format ".gitk-tmp.%s" [pid]]]
3224 if {[catch {file mkdir $gitktmpdir} err]} {
3225 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3232 set diffdir [file join $gitktmpdir $diffnum]
3233 if {[catch {file mkdir $diffdir} err]} {
3234 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3238 # gather files to diff
3239 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3240 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3242 if {$difffromfile ne {} && $difftofile ne {}} {
3243 set cmd [concat | [shellsplit $extdifftool] \
3244 [list $difffromfile $difftofile]]
3245 if {[catch {set fl [open $cmd r]} err]} {
3246 file delete -force $diffdir
3247 error_popup "$extdifftool: [mc "command failed:"] $err"
3249 fconfigure $fl -blocking 0
3250 filerun $fl [list delete_at_eof $fl $diffdir]
3255 proc find_hunk_blamespec {base line} {
3258 # Find and parse the hunk header
3259 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3260 if {$s_lix eq {}} return
3262 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3263 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3264 s_line old_specs osz osz1 new_line nsz]} {
3268 # base lines for the parents
3269 set base_lines [list $new_line]
3270 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3271 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3272 old_spec old_line osz]} {
3275 lappend base_lines $old_line
3278 # Now scan the lines to determine offset within the hunk
3279 set max_parent [expr {[llength $base_lines]-2}]
3281 set s_lno [lindex [split $s_lix "."] 0]
3283 # Determine if the line is removed
3284 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3285 if {[string match {[-+ ]*} $chunk]} {
3286 set removed_idx [string first "-" $chunk]
3287 # Choose a parent index
3288 if {$removed_idx >= 0} {
3289 set parent $removed_idx
3291 set unchanged_idx [string first " " $chunk]
3292 if {$unchanged_idx >= 0} {
3293 set parent $unchanged_idx
3295 # blame the current commit
3299 # then count other lines that belong to it
3300 for {set i $line} {[incr i -1] > $s_lno} {} {
3301 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3302 # Determine if the line is removed
3303 set removed_idx [string first "-" $chunk]
3305 set code [string index $chunk $parent]
3306 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3310 if {$removed_idx < 0} {
3320 incr dline [lindex $base_lines $parent]
3321 return [list $parent $dline]
3324 proc external_blame_diff {} {
3325 global currentid cmitmode
3326 global diff_menu_txtpos diff_menu_line
3327 global diff_menu_filebase flist_menu_file
3329 if {$cmitmode eq "tree"} {
3331 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3333 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3335 set parent_idx [lindex $hinfo 0]
3336 set line [lindex $hinfo 1]
3343 external_blame $parent_idx $line
3346 # Find the SHA1 ID of the blob for file $fname in the index
3348 proc index_sha1 {fname} {
3349 set f [open [list | git ls-files -s $fname] r]
3350 while {[gets $f line] >= 0} {
3351 set info [lindex [split $line "\t"] 0]
3352 set stage [lindex $info 2]
3353 if {$stage eq "0" || $stage eq "2"} {
3355 return [lindex $info 1]
3362 # Turn an absolute path into one relative to the current directory
3363 proc make_relative {f} {
3364 set elts [file split $f]
3365 set here [file split [pwd]]
3370 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3377 set elts [concat $res [lrange $elts $ei end]]
3378 return [eval file join $elts]
3381 proc external_blame {parent_idx {line {}}} {
3382 global flist_menu_file gitdir
3383 global nullid nullid2
3384 global parentlist selectedline currentid
3386 if {$parent_idx > 0} {
3387 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3389 set base_commit $currentid
3392 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3393 error_popup [mc "No such commit"]
3397 set cmdline [list git gui blame]
3398 if {$line ne {} && $line > 1} {
3399 lappend cmdline "--line=$line"
3401 set f [file join [file dirname $gitdir] $flist_menu_file]
3402 # Unfortunately it seems git gui blame doesn't like
3403 # being given an absolute path...
3404 set f [make_relative $f]
3405 lappend cmdline $base_commit $f
3406 if {[catch {eval exec $cmdline &} err]} {
3407 error_popup "[mc "git gui blame: command failed:"] $err"
3411 proc show_line_source {} {
3412 global cmitmode currentid parents curview blamestuff blameinst
3413 global diff_menu_line diff_menu_filebase flist_menu_file
3414 global nullid nullid2 gitdir
3417 if {$cmitmode eq "tree"} {
3419 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3421 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3422 if {$h eq {}} return
3423 set pi [lindex $h 0]
3425 mark_ctext_line $diff_menu_line
3429 if {$currentid eq $nullid} {
3431 # must be a merge in progress...
3433 # get the last line from .git/MERGE_HEAD
3434 set f [open [file join $gitdir MERGE_HEAD] r]
3435 set id [lindex [split [read $f] "\n"] end-1]
3438 error_popup [mc "Couldn't read merge head: %s" $err]
3441 } elseif {$parents($curview,$currentid) eq $nullid2} {
3442 # need to do the blame from the index
3444 set from_index [index_sha1 $flist_menu_file]
3446 error_popup [mc "Error reading index: %s" $err]
3450 set id $parents($curview,$currentid)
3453 set id [lindex $parents($curview,$currentid) $pi]
3455 set line [lindex $h 1]
3458 if {$from_index ne {}} {
3459 lappend blameargs | git cat-file blob $from_index
3461 lappend blameargs | git blame -p -L$line,+1
3462 if {$from_index ne {}} {
3463 lappend blameargs --contents -
3465 lappend blameargs $id
3467 lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
3469 set f [open $blameargs r]
3471 error_popup [mc "Couldn't start git blame: %s" $err]
3474 nowbusy blaming [mc "Searching"]
3475 fconfigure $f -blocking 0
3476 set i [reg_instance $f]
3477 set blamestuff($i) {}
3479 filerun $f [list read_line_source $f $i]
3482 proc stopblaming {} {
3485 if {[info exists blameinst]} {
3486 stop_instance $blameinst
3492 proc read_line_source {fd inst} {
3493 global blamestuff curview commfd blameinst nullid nullid2
3495 while {[gets $fd line] >= 0} {
3496 lappend blamestuff($inst) $line
3504 fconfigure $fd -blocking 1
3505 if {[catch {close $fd} err]} {
3506 error_popup [mc "Error running git blame: %s" $err]
3511 set line [split [lindex $blamestuff($inst) 0] " "]
3512 set id [lindex $line 0]
3513 set lnum [lindex $line 1]
3514 if {[string length $id] == 40 && [string is xdigit $id] &&
3515 [string is digit -strict $lnum]} {
3516 # look for "filename" line
3517 foreach l $blamestuff($inst) {
3518 if {[string match "filename *" $l]} {
3519 set fname [string range $l 9 end]
3525 # all looks good, select it
3526 if {$id eq $nullid} {
3527 # blame uses all-zeroes to mean not committed,
3528 # which would mean a change in the index
3531 if {[commitinview $id $curview]} {
3532 selectline [rowofcommit $id] 1 [list $fname $lnum]
3534 error_popup [mc "That line comes from commit %s, \
3535 which is not in this view" [shortids $id]]
3538 puts "oops couldn't parse git blame output"
3543 # delete $dir when we see eof on $f (presumably because the child has exited)
3544 proc delete_at_eof {f dir} {
3545 while {[gets $f line] >= 0} {}
3547 if {[catch {close $f} err]} {
3548 error_popup "[mc "External diff viewer failed:"] $err"
3550 file delete -force $dir
3556 # Functions for adding and removing shell-type quoting
3558 proc shellquote {str} {
3559 if {![string match "*\['\"\\ \t]*" $str]} {
3562 if {![string match "*\['\"\\]*" $str]} {
3565 if {![string match "*'*" $str]} {
3568 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3571 proc shellarglist {l} {
3577 append str [shellquote $a]
3582 proc shelldequote {str} {
3587 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3588 append ret [string range $str $used end]
3589 set used [string length $str]
3592 set first [lindex $first 0]
3593 set ch [string index $str $first]
3594 if {$first > $used} {
3595 append ret [string range $str $used [expr {$first - 1}]]
3598 if {$ch eq " " || $ch eq "\t"} break
3601 set first [string first "'" $str $used]
3603 error "unmatched single-quote"
3605 append ret [string range $str $used [expr {$first - 1}]]
3610 if {$used >= [string length $str]} {
3611 error "trailing backslash"
3613 append ret [string index $str $used]
3618 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3619 error "unmatched double-quote"
3621 set first [lindex $first 0]
3622 set ch [string index $str $first]
3623 if {$first > $used} {
3624 append ret [string range $str $used [expr {$first - 1}]]
3627 if {$ch eq "\""} break
3629 append ret [string index $str $used]
3633 return [list $used $ret]
3636 proc shellsplit {str} {
3639 set str [string trimleft $str]
3640 if {$str eq {}} break
3641 set dq [shelldequote $str]
3642 set n [lindex $dq 0]
3643 set word [lindex $dq 1]
3644 set str [string range $str $n end]
3650 # Code to implement multiple views
3652 proc newview {ishighlight} {
3653 global nextviewnum newviewname newishighlight
3654 global revtreeargs viewargscmd newviewopts curview
3656 set newishighlight $ishighlight
3658 if {[winfo exists $top]} {
3662 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3663 set newviewopts($nextviewnum,perm) 0
3664 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3665 decode_view_opts $nextviewnum $revtreeargs
3666 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3669 set known_view_options {
3670 {perm b . {} {mc "Remember this view"}}
3671 {args t50= + {} {mc "Commits to include (arguments to git log):"}}
3672 {all b * "--all" {mc "Use all refs"}}
3673 {dorder b . {"--date-order" "-d"} {mc "Strictly sort by date"}}
3674 {lright b . "--left-right" {mc "Mark branch sides"}}
3675 {since t15 + {"--since=*" "--after=*"} {mc "Since date:"}}
3676 {until t15 . {"--until=*" "--before=*"} {mc "Until date:"}}
3677 {limit t10 + "--max-count=*" {mc "Max count:"}}
3678 {skip t10 . "--skip=*" {mc "Skip:"}}
3679 {first b . "--first-parent" {mc "Limit to first parent"}}
3680 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3683 proc encode_view_opts {n} {
3684 global known_view_options newviewopts
3687 foreach opt $known_view_options {
3688 set patterns [lindex $opt 3]
3689 if {$patterns eq {}} continue
3690 set pattern [lindex $patterns 0]
3692 set val $newviewopts($n,[lindex $opt 0])
3694 if {[lindex $opt 1] eq "b"} {
3696 lappend rargs $pattern
3699 set val [string trim $val]
3701 set pfix [string range $pattern 0 end-1]
3702 lappend rargs $pfix$val
3706 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3709 proc decode_view_opts {n view_args} {
3710 global known_view_options newviewopts
3712 foreach opt $known_view_options {
3713 if {[lindex $opt 1] eq "b"} {
3718 set newviewopts($n,[lindex $opt 0]) $val
3721 foreach arg $view_args {
3722 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3723 && ![info exists found(limit)]} {
3724 set newviewopts($n,limit) $cnt
3729 foreach opt $known_view_options {
3730 set id [lindex $opt 0]
3731 if {[info exists found($id)]} continue
3732 foreach pattern [lindex $opt 3] {
3733 if {![string match $pattern $arg]} continue
3734 if {[lindex $opt 1] ne "b"} {
3735 set size [string length $pattern]
3736 set val [string range $arg [expr {$size-1}] end]
3740 set newviewopts($n,$id) $val
3744 if {[info exists val]} break
3746 if {[info exists val]} continue
3749 set newviewopts($n,args) [shellarglist $oargs]
3752 proc edit_or_newview {} {
3764 global viewname viewperm newviewname newviewopts
3765 global viewargs viewargscmd
3767 set top .gitkvedit-$curview
3768 if {[winfo exists $top]} {
3772 set newviewname($curview) $viewname($curview)
3773 set newviewopts($curview,perm) $viewperm($curview)
3774 set newviewopts($curview,cmd) $viewargscmd($curview)
3775 decode_view_opts $curview $viewargs($curview)
3776 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
3779 proc vieweditor {top n title} {
3780 global newviewname newviewopts viewfiles bgcolor
3781 global known_view_options
3784 wm title $top $title
3785 make_transient $top .
3789 label $top.nl -text [mc "Name"]
3790 entry $top.name -width 20 -textvariable newviewname($n)
3791 pack $top.nfr -in $top -fill x -pady 5 -padx 3
3792 pack $top.nl -in $top.nfr -side left -padx {0 30}
3793 pack $top.name -in $top.nfr -side left
3799 foreach opt $known_view_options {
3800 set id [lindex $opt 0]
3801 set type [lindex $opt 1]
3802 set flags [lindex $opt 2]
3803 set title [eval [lindex $opt 4]]
3806 if {$flags eq "+" || $flags eq "*"} {
3807 set cframe $top.fr$cnt
3810 pack $cframe -in $top -fill x -pady 3 -padx 3
3811 set cexpand [expr {$flags eq "*"}]
3817 checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
3818 pack $cframe.c_$id -in $cframe -side left \
3819 -padx [list $lxpad 0] -expand $cexpand -anchor w
3820 } elseif {[regexp {^t(\d+)$} $type type sz]} {
3821 message $cframe.l_$id -aspect 1500 -text $title
3822 entry $cframe.e_$id -width $sz -background $bgcolor \
3823 -textvariable newviewopts($n,$id)
3824 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
3825 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
3826 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
3827 message $cframe.l_$id -aspect 1500 -text $title
3828 entry $cframe.e_$id -width $sz -background $bgcolor \
3829 -textvariable newviewopts($n,$id)
3830 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
3831 pack $cframe.e_$id -in $cframe -side top -fill x
3836 message $top.l -aspect 1500 \
3837 -text [mc "Enter files and directories to include, one per line:"]
3838 pack $top.l -in $top -side top -pady [list 7 0] -anchor w -padx 3
3839 text $top.t -width 40 -height 5 -background $bgcolor -font uifont
3840 if {[info exists viewfiles($n)]} {
3841 foreach f $viewfiles($n) {
3842 $top.t insert end $f
3843 $top.t insert end "\n"
3845 $top.t delete {end - 1c} end
3846 $top.t mark set insert 0.0
3848 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
3850 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3851 button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
3852 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3853 bind $top <Control-Return> [list newviewok $top $n]
3854 bind $top <F5> [list newviewok $top $n 1]
3855 bind $top <Escape> [list destroy $top]
3856 grid $top.buts.ok $top.buts.apply $top.buts.can
3857 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3858 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3859 grid columnconfigure $top.buts 2 -weight 1 -uniform a
3860 pack $top.buts -in $top -side top -fill x
3864 proc doviewmenu {m first cmd op argv} {
3865 set nmenu [$m index end]
3866 for {set i $first} {$i <= $nmenu} {incr i} {
3867 if {[$m entrycget $i -command] eq $cmd} {
3868 eval $m $op $i $argv
3874 proc allviewmenus {n op args} {
3877 doviewmenu .bar.view 5 [list showview $n] $op $args
3878 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3881 proc newviewok {top n {apply 0}} {
3882 global nextviewnum newviewperm newviewname newishighlight
3883 global viewname viewfiles viewperm selectedview curview
3884 global viewargs viewargscmd newviewopts viewhlmenu
3887 set newargs [encode_view_opts $n]
3889 error_popup "[mc "Error in commit selection arguments:"] $err" $top
3893 foreach f [split [$top.t get 0.0 end] "\n"] {
3894 set ft [string trim $f]
3899 if {![info exists viewfiles($n)]} {
3900 # creating a new view
3902 set viewname($n) $newviewname($n)
3903 set viewperm($n) $newviewopts($n,perm)
3904 set viewfiles($n) $files
3905 set viewargs($n) $newargs
3906 set viewargscmd($n) $newviewopts($n,cmd)
3908 if {!$newishighlight} {
3911 run addvhighlight $n
3914 # editing an existing view
3915 set viewperm($n) $newviewopts($n,perm)
3916 if {$newviewname($n) ne $viewname($n)} {
3917 set viewname($n) $newviewname($n)
3918 doviewmenu .bar.view 5 [list showview $n] \
3919 entryconf [list -label $viewname($n)]
3920 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3921 # entryconf [list -label $viewname($n) -value $viewname($n)]
3923 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3924 $newviewopts($n,cmd) ne $viewargscmd($n)} {
3925 set viewfiles($n) $files
3926 set viewargs($n) $newargs
3927 set viewargscmd($n) $newviewopts($n,cmd)
3928 if {$curview == $n} {
3934 catch {destroy $top}
3938 global curview viewperm hlview selectedhlview
3940 if {$curview == 0} return
3941 if {[info exists hlview] && $hlview == $curview} {
3942 set selectedhlview [mc "None"]
3945 allviewmenus $curview delete
3946 set viewperm($curview) 0
3950 proc addviewmenu {n} {
3951 global viewname viewhlmenu
3953 .bar.view add radiobutton -label $viewname($n) \
3954 -command [list showview $n] -variable selectedview -value $n
3955 #$viewhlmenu add radiobutton -label $viewname($n) \
3956 # -command [list addvhighlight $n] -variable selectedhlview
3960 global curview cached_commitrow ordertok
3961 global displayorder parentlist rowidlist rowisopt rowfinal
3962 global colormap rowtextx nextcolor canvxmax
3963 global numcommits viewcomplete
3964 global selectedline currentid canv canvy0
3966 global pending_select mainheadid
3969 global hlview selectedhlview commitinterest
3971 if {$n == $curview} return
3973 set ymax [lindex [$canv cget -scrollregion] 3]
3974 set span [$canv yview]
3975 set ytop [expr {[lindex $span 0] * $ymax}]
3976 set ybot [expr {[lindex $span 1] * $ymax}]
3977 set yscreen [expr {($ybot - $ytop) / 2}]
3978 if {$selectedline ne {}} {
3979 set selid $currentid
3980 set y [yc $selectedline]
3981 if {$ytop < $y && $y < $ybot} {
3982 set yscreen [expr {$y - $ytop}]
3984 } elseif {[info exists pending_select]} {
3985 set selid $pending_select
3986 unset pending_select
3990 catch {unset treediffs}
3992 if {[info exists hlview] && $hlview == $n} {
3994 set selectedhlview [mc "None"]
3996 catch {unset commitinterest}
3997 catch {unset cached_commitrow}
3998 catch {unset ordertok}
4002 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4003 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4006 if {![info exists viewcomplete($n)]} {
4016 set numcommits $commitidx($n)
4018 catch {unset colormap}
4019 catch {unset rowtextx}
4021 set canvxmax [$canv cget -width]
4027 if {$selid ne {} && [commitinview $selid $n]} {
4028 set row [rowofcommit $selid]
4029 # try to get the selected row in the same position on the screen
4030 set ymax [lindex [$canv cget -scrollregion] 3]
4031 set ytop [expr {[yc $row] - $yscreen}]
4035 set yf [expr {$ytop * 1.0 / $ymax}]
4037 allcanvs yview moveto $yf
4041 } elseif {!$viewcomplete($n)} {
4042 reset_pending_select $selid
4044 reset_pending_select {}
4046 if {[commitinview $pending_select $curview]} {
4047 selectline [rowofcommit $pending_select] 1
4049 set row [first_real_row]
4050 if {$row < $numcommits} {
4055 if {!$viewcomplete($n)} {
4056 if {$numcommits == 0} {
4057 show_status [mc "Reading commits..."]
4059 } elseif {$numcommits == 0} {
4060 show_status [mc "No commits selected"]
4064 # Stuff relating to the highlighting facility
4066 proc ishighlighted {id} {
4067 global vhighlights fhighlights nhighlights rhighlights
4069 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4070 return $nhighlights($id)
4072 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4073 return $vhighlights($id)
4075 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4076 return $fhighlights($id)
4078 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4079 return $rhighlights($id)
4084 proc bolden {id font} {
4085 global canv linehtag currentid boldids need_redisplay markedid
4087 # need_redisplay = 1 means the display is stale and about to be redrawn
4088 if {$need_redisplay} return
4090 $canv itemconf $linehtag($id) -font $font
4091 if {[info exists currentid] && $id eq $currentid} {
4093 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4094 -outline {{}} -tags secsel \
4095 -fill [$canv cget -selectbackground]]
4098 if {[info exists markedid] && $id eq $markedid} {
4103 proc bolden_name {id font} {
4104 global canv2 linentag currentid boldnameids need_redisplay
4106 if {$need_redisplay} return
4107 lappend boldnameids $id
4108 $canv2 itemconf $linentag($id) -font $font
4109 if {[info exists currentid] && $id eq $currentid} {
4110 $canv2 delete secsel
4111 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4112 -outline {{}} -tags secsel \
4113 -fill [$canv2 cget -selectbackground]]
4122 foreach id $boldids {
4123 if {![ishighlighted $id]} {
4126 lappend stillbold $id
4129 set boldids $stillbold
4132 proc addvhighlight {n} {
4133 global hlview viewcomplete curview vhl_done commitidx
4135 if {[info exists hlview]} {
4139 if {$n != $curview && ![info exists viewcomplete($n)]} {
4142 set vhl_done $commitidx($hlview)
4143 if {$vhl_done > 0} {
4148 proc delvhighlight {} {
4149 global hlview vhighlights
4151 if {![info exists hlview]} return
4153 catch {unset vhighlights}
4157 proc vhighlightmore {} {
4158 global hlview vhl_done commitidx vhighlights curview
4160 set max $commitidx($hlview)
4161 set vr [visiblerows]
4162 set r0 [lindex $vr 0]
4163 set r1 [lindex $vr 1]
4164 for {set i $vhl_done} {$i < $max} {incr i} {
4165 set id [commitonrow $i $hlview]
4166 if {[commitinview $id $curview]} {
4167 set row [rowofcommit $id]
4168 if {$r0 <= $row && $row <= $r1} {
4169 if {![highlighted $row]} {
4170 bolden $id mainfontbold
4172 set vhighlights($id) 1
4180 proc askvhighlight {row id} {
4181 global hlview vhighlights iddrawn
4183 if {[commitinview $id $hlview]} {
4184 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4185 bolden $id mainfontbold
4187 set vhighlights($id) 1
4189 set vhighlights($id) 0
4193 proc hfiles_change {} {
4194 global highlight_files filehighlight fhighlights fh_serial
4195 global highlight_paths
4197 if {[info exists filehighlight]} {
4198 # delete previous highlights
4199 catch {close $filehighlight}
4201 catch {unset fhighlights}
4203 unhighlight_filelist
4205 set highlight_paths {}
4206 after cancel do_file_hl $fh_serial
4208 if {$highlight_files ne {}} {
4209 after 300 do_file_hl $fh_serial
4213 proc gdttype_change {name ix op} {
4214 global gdttype highlight_files findstring findpattern
4217 if {$findstring ne {}} {
4218 if {$gdttype eq [mc "containing:"]} {
4219 if {$highlight_files ne {}} {
4220 set highlight_files {}
4225 if {$findpattern ne {}} {
4229 set highlight_files $findstring
4234 # enable/disable findtype/findloc menus too
4237 proc find_change {name ix op} {
4238 global gdttype findstring highlight_files
4241 if {$gdttype eq [mc "containing:"]} {
4244 if {$highlight_files ne $findstring} {
4245 set highlight_files $findstring
4252 proc findcom_change args {
4253 global nhighlights boldnameids
4254 global findpattern findtype findstring gdttype
4257 # delete previous highlights, if any
4258 foreach id $boldnameids {
4259 bolden_name $id mainfont
4262 catch {unset nhighlights}
4265 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4267 } elseif {$findtype eq [mc "Regexp"]} {
4268 set findpattern $findstring
4270 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4272 set findpattern "*$e*"
4276 proc makepatterns {l} {
4279 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4280 if {[string index $ee end] eq "/"} {
4290 proc do_file_hl {serial} {
4291 global highlight_files filehighlight highlight_paths gdttype fhl_list
4293 if {$gdttype eq [mc "touching paths:"]} {
4294 if {[catch {set paths [shellsplit $highlight_files]}]} return
4295 set highlight_paths [makepatterns $paths]
4297 set gdtargs [concat -- $paths]
4298 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4299 set gdtargs [list "-S$highlight_files"]
4301 # must be "containing:", i.e. we're searching commit info
4304 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4305 set filehighlight [open $cmd r+]
4306 fconfigure $filehighlight -blocking 0
4307 filerun $filehighlight readfhighlight
4313 proc flushhighlights {} {
4314 global filehighlight fhl_list
4316 if {[info exists filehighlight]} {
4318 puts $filehighlight ""
4319 flush $filehighlight
4323 proc askfilehighlight {row id} {
4324 global filehighlight fhighlights fhl_list
4326 lappend fhl_list $id
4327 set fhighlights($id) -1
4328 puts $filehighlight $id
4331 proc readfhighlight {} {
4332 global filehighlight fhighlights curview iddrawn
4333 global fhl_list find_dirn
4335 if {![info exists filehighlight]} {
4339 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4340 set line [string trim $line]
4341 set i [lsearch -exact $fhl_list $line]
4342 if {$i < 0} continue
4343 for {set j 0} {$j < $i} {incr j} {
4344 set id [lindex $fhl_list $j]
4345 set fhighlights($id) 0
4347 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4348 if {$line eq {}} continue
4349 if {![commitinview $line $curview]} continue
4350 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4351 bolden $line mainfontbold
4353 set fhighlights($line) 1
4355 if {[eof $filehighlight]} {
4357 puts "oops, git diff-tree died"
4358 catch {close $filehighlight}
4362 if {[info exists find_dirn]} {
4368 proc doesmatch {f} {
4369 global findtype findpattern
4371 if {$findtype eq [mc "Regexp"]} {
4372 return [regexp $findpattern $f]
4373 } elseif {$findtype eq [mc "IgnCase"]} {
4374 return [string match -nocase $findpattern $f]
4376 return [string match $findpattern $f]
4380 proc askfindhighlight {row id} {
4381 global nhighlights commitinfo iddrawn
4383 global markingmatches
4385 if {![info exists commitinfo($id)]} {
4388 set info $commitinfo($id)
4390 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4391 foreach f $info ty $fldtypes {
4392 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4394 if {$ty eq [mc "Author"]} {
4401 if {$isbold && [info exists iddrawn($id)]} {
4402 if {![ishighlighted $id]} {
4403 bolden $id mainfontbold
4405 bolden_name $id mainfontbold
4408 if {$markingmatches} {
4409 markrowmatches $row $id
4412 set nhighlights($id) $isbold
4415 proc markrowmatches {row id} {
4416 global canv canv2 linehtag linentag commitinfo findloc
4418 set headline [lindex $commitinfo($id) 0]
4419 set author [lindex $commitinfo($id) 1]
4420 $canv delete match$row
4421 $canv2 delete match$row
4422 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4423 set m [findmatches $headline]
4425 markmatches $canv $row $headline $linehtag($id) $m \
4426 [$canv itemcget $linehtag($id) -font] $row
4429 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4430 set m [findmatches $author]
4432 markmatches $canv2 $row $author $linentag($id) $m \
4433 [$canv2 itemcget $linentag($id) -font] $row
4438 proc vrel_change {name ix op} {
4439 global highlight_related
4442 if {$highlight_related ne [mc "None"]} {
4447 # prepare for testing whether commits are descendents or ancestors of a
4448 proc rhighlight_sel {a} {
4449 global descendent desc_todo ancestor anc_todo
4450 global highlight_related
4452 catch {unset descendent}
4453 set desc_todo [list $a]
4454 catch {unset ancestor}
4455 set anc_todo [list $a]
4456 if {$highlight_related ne [mc "None"]} {
4462 proc rhighlight_none {} {
4465 catch {unset rhighlights}
4469 proc is_descendent {a} {
4470 global curview children descendent desc_todo
4473 set la [rowofcommit $a]
4477 for {set i 0} {$i < [llength $todo]} {incr i} {
4478 set do [lindex $todo $i]
4479 if {[rowofcommit $do] < $la} {
4480 lappend leftover $do
4483 foreach nk $children($v,$do) {
4484 if {![info exists descendent($nk)]} {
4485 set descendent($nk) 1
4493 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4497 set descendent($a) 0
4498 set desc_todo $leftover
4501 proc is_ancestor {a} {
4502 global curview parents ancestor anc_todo
4505 set la [rowofcommit $a]
4509 for {set i 0} {$i < [llength $todo]} {incr i} {
4510 set do [lindex $todo $i]
4511 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4512 lappend leftover $do
4515 foreach np $parents($v,$do) {
4516 if {![info exists ancestor($np)]} {
4525 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4530 set anc_todo $leftover
4533 proc askrelhighlight {row id} {
4534 global descendent highlight_related iddrawn rhighlights
4535 global selectedline ancestor
4537 if {$selectedline eq {}} return
4539 if {$highlight_related eq [mc "Descendant"] ||
4540 $highlight_related eq [mc "Not descendant"]} {
4541 if {![info exists descendent($id)]} {
4544 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4547 } elseif {$highlight_related eq [mc "Ancestor"] ||
4548 $highlight_related eq [mc "Not ancestor"]} {
4549 if {![info exists ancestor($id)]} {
4552 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4556 if {[info exists iddrawn($id)]} {
4557 if {$isbold && ![ishighlighted $id]} {
4558 bolden $id mainfontbold
4561 set rhighlights($id) $isbold
4564 # Graph layout functions
4566 proc shortids {ids} {
4569 if {[llength $id] > 1} {
4570 lappend res [shortids $id]
4571 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4572 lappend res [string range $id 0 7]
4583 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4584 if {($n & $mask) != 0} {
4585 set ret [concat $ret $o]
4587 set o [concat $o $o]
4592 proc ordertoken {id} {
4593 global ordertok curview varcid varcstart varctok curview parents children
4594 global nullid nullid2
4596 if {[info exists ordertok($id)]} {
4597 return $ordertok($id)
4602 if {[info exists varcid($curview,$id)]} {
4603 set a $varcid($curview,$id)
4604 set p [lindex $varcstart($curview) $a]
4606 set p [lindex $children($curview,$id) 0]
4608 if {[info exists ordertok($p)]} {
4609 set tok $ordertok($p)
4612 set id [first_real_child $curview,$p]
4615 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4618 if {[llength $parents($curview,$id)] == 1} {
4619 lappend todo [list $p {}]
4621 set j [lsearch -exact $parents($curview,$id) $p]
4623 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4625 lappend todo [list $p [strrep $j]]
4628 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4629 set p [lindex $todo $i 0]
4630 append tok [lindex $todo $i 1]
4631 set ordertok($p) $tok
4633 set ordertok($origid) $tok
4637 # Work out where id should go in idlist so that order-token
4638 # values increase from left to right
4639 proc idcol {idlist id {i 0}} {
4640 set t [ordertoken $id]
4644 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4645 if {$i > [llength $idlist]} {
4646 set i [llength $idlist]
4648 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4651 if {$t > [ordertoken [lindex $idlist $i]]} {
4652 while {[incr i] < [llength $idlist] &&
4653 $t >= [ordertoken [lindex $idlist $i]]} {}
4659 proc initlayout {} {
4660 global rowidlist rowisopt rowfinal displayorder parentlist
4661 global numcommits canvxmax canv
4663 global colormap rowtextx
4672 set canvxmax [$canv cget -width]
4673 catch {unset colormap}
4674 catch {unset rowtextx}
4678 proc setcanvscroll {} {
4679 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4680 global lastscrollset lastscrollrows
4682 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4683 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4684 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4685 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4686 set lastscrollset [clock clicks -milliseconds]
4687 set lastscrollrows $numcommits
4690 proc visiblerows {} {
4691 global canv numcommits linespc
4693 set ymax [lindex [$canv cget -scrollregion] 3]
4694 if {$ymax eq {} || $ymax == 0} return
4696 set y0 [expr {int([lindex $f 0] * $ymax)}]
4697 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4701 set y1 [expr {int([lindex $f 1] * $ymax)}]
4702 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4703 if {$r1 >= $numcommits} {
4704 set r1 [expr {$numcommits - 1}]
4706 return [list $r0 $r1]
4709 proc layoutmore {} {
4710 global commitidx viewcomplete curview
4711 global numcommits pending_select curview
4712 global lastscrollset lastscrollrows
4714 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4715 [clock clicks -milliseconds] - $lastscrollset > 500} {
4718 if {[info exists pending_select] &&
4719 [commitinview $pending_select $curview]} {
4721 selectline [rowofcommit $pending_select] 1
4726 # With path limiting, we mightn't get the actual HEAD commit,
4727 # so ask git rev-list what is the first ancestor of HEAD that
4728 # touches a file in the path limit.
4729 proc get_viewmainhead {view} {
4730 global viewmainheadid vfilelimit viewinstances mainheadid
4733 set rfd [open [concat | git rev-list -1 $mainheadid \
4734 -- $vfilelimit($view)] r]
4735 set j [reg_instance $rfd]
4736 lappend viewinstances($view) $j
4737 fconfigure $rfd -blocking 0
4738 filerun $rfd [list getviewhead $rfd $j $view]
4739 set viewmainheadid($curview) {}
4743 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4744 proc getviewhead {fd inst view} {
4745 global viewmainheadid commfd curview viewinstances showlocalchanges
4748 if {[gets $fd line] < 0} {
4752 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4755 set viewmainheadid($view) $id
4758 set i [lsearch -exact $viewinstances($view) $inst]
4760 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4762 if {$showlocalchanges && $id ne {} && $view == $curview} {
4768 proc doshowlocalchanges {} {
4769 global curview viewmainheadid
4771 if {$viewmainheadid($curview) eq {}} return
4772 if {[commitinview $viewmainheadid($curview) $curview]} {
4775 interestedin $viewmainheadid($curview) dodiffindex
4779 proc dohidelocalchanges {} {
4780 global nullid nullid2 lserial curview
4782 if {[commitinview $nullid $curview]} {
4783 removefakerow $nullid
4785 if {[commitinview $nullid2 $curview]} {
4786 removefakerow $nullid2
4791 # spawn off a process to do git diff-index --cached HEAD
4792 proc dodiffindex {} {
4793 global lserial showlocalchanges vfilelimit curview
4796 if {!$showlocalchanges || !$isworktree} return
4798 set cmd "|git diff-index --cached HEAD"
4799 if {$vfilelimit($curview) ne {}} {
4800 set cmd [concat $cmd -- $vfilelimit($curview)]
4802 set fd [open $cmd r]
4803 fconfigure $fd -blocking 0
4804 set i [reg_instance $fd]
4805 filerun $fd [list readdiffindex $fd $lserial $i]
4808 proc readdiffindex {fd serial inst} {
4809 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
4813 if {[gets $fd line] < 0} {
4819 # we only need to see one line and we don't really care what it says...
4822 if {$serial != $lserial} {
4826 # now see if there are any local changes not checked in to the index
4827 set cmd "|git diff-files"
4828 if {$vfilelimit($curview) ne {}} {
4829 set cmd [concat $cmd -- $vfilelimit($curview)]
4831 set fd [open $cmd r]
4832 fconfigure $fd -blocking 0
4833 set i [reg_instance $fd]
4834 filerun $fd [list readdifffiles $fd $serial $i]
4836 if {$isdiff && ![commitinview $nullid2 $curview]} {
4837 # add the line for the changes in the index to the graph
4838 set hl [mc "Local changes checked in to index but not committed"]
4839 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4840 set commitdata($nullid2) "\n $hl\n"
4841 if {[commitinview $nullid $curview]} {
4842 removefakerow $nullid
4844 insertfakerow $nullid2 $viewmainheadid($curview)
4845 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4846 if {[commitinview $nullid $curview]} {
4847 removefakerow $nullid
4849 removefakerow $nullid2
4854 proc readdifffiles {fd serial inst} {
4855 global viewmainheadid nullid nullid2 curview
4856 global commitinfo commitdata lserial
4859 if {[gets $fd line] < 0} {
4865 # we only need to see one line and we don't really care what it says...
4868 if {$serial != $lserial} {
4872 if {$isdiff && ![commitinview $nullid $curview]} {
4873 # add the line for the local diff to the graph
4874 set hl [mc "Local uncommitted changes, not checked in to index"]
4875 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4876 set commitdata($nullid) "\n $hl\n"
4877 if {[commitinview $nullid2 $curview]} {
4880 set p $viewmainheadid($curview)
4882 insertfakerow $nullid $p
4883 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4884 removefakerow $nullid
4889 proc nextuse {id row} {
4890 global curview children
4892 if {[info exists children($curview,$id)]} {
4893 foreach kid $children($curview,$id) {
4894 if {![commitinview $kid $curview]} {
4897 if {[rowofcommit $kid] > $row} {
4898 return [rowofcommit $kid]
4902 if {[commitinview $id $curview]} {
4903 return [rowofcommit $id]
4908 proc prevuse {id row} {
4909 global curview children
4912 if {[info exists children($curview,$id)]} {
4913 foreach kid $children($curview,$id) {
4914 if {![commitinview $kid $curview]} break
4915 if {[rowofcommit $kid] < $row} {
4916 set ret [rowofcommit $kid]
4923 proc make_idlist {row} {
4924 global displayorder parentlist uparrowlen downarrowlen mingaplen
4925 global commitidx curview children
4927 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4931 set ra [expr {$row - $downarrowlen}]
4935 set rb [expr {$row + $uparrowlen}]
4936 if {$rb > $commitidx($curview)} {
4937 set rb $commitidx($curview)
4939 make_disporder $r [expr {$rb + 1}]
4941 for {} {$r < $ra} {incr r} {
4942 set nextid [lindex $displayorder [expr {$r + 1}]]
4943 foreach p [lindex $parentlist $r] {
4944 if {$p eq $nextid} continue
4945 set rn [nextuse $p $r]
4947 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4948 lappend ids [list [ordertoken $p] $p]
4952 for {} {$r < $row} {incr r} {
4953 set nextid [lindex $displayorder [expr {$r + 1}]]
4954 foreach p [lindex $parentlist $r] {
4955 if {$p eq $nextid} continue
4956 set rn [nextuse $p $r]
4957 if {$rn < 0 || $rn >= $row} {
4958 lappend ids [list [ordertoken $p] $p]
4962 set id [lindex $displayorder $row]
4963 lappend ids [list [ordertoken $id] $id]
4965 foreach p [lindex $parentlist $r] {
4966 set firstkid [lindex $children($curview,$p) 0]
4967 if {[rowofcommit $firstkid] < $row} {
4968 lappend ids [list [ordertoken $p] $p]
4972 set id [lindex $displayorder $r]
4974 set firstkid [lindex $children($curview,$id) 0]
4975 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4976 lappend ids [list [ordertoken $id] $id]
4981 foreach idx [lsort -unique $ids] {
4982 lappend idlist [lindex $idx 1]
4987 proc rowsequal {a b} {
4988 while {[set i [lsearch -exact $a {}]] >= 0} {
4989 set a [lreplace $a $i $i]
4991 while {[set i [lsearch -exact $b {}]] >= 0} {
4992 set b [lreplace $b $i $i]
4994 return [expr {$a eq $b}]
4997 proc makeupline {id row rend col} {
4998 global rowidlist uparrowlen downarrowlen mingaplen
5000 for {set r $rend} {1} {set r $rstart} {
5001 set rstart [prevuse $id $r]
5002 if {$rstart < 0} return
5003 if {$rstart < $row} break
5005 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5006 set rstart [expr {$rend - $uparrowlen - 1}]
5008 for {set r $rstart} {[incr r] <= $row} {} {
5009 set idlist [lindex $rowidlist $r]
5010 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5011 set col [idcol $idlist $id $col]
5012 lset rowidlist $r [linsert $idlist $col $id]
5018 proc layoutrows {row endrow} {
5019 global rowidlist rowisopt rowfinal displayorder
5020 global uparrowlen downarrowlen maxwidth mingaplen
5021 global children parentlist
5022 global commitidx viewcomplete curview
5024 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5027 set rm1 [expr {$row - 1}]
5028 foreach id [lindex $rowidlist $rm1] {
5033 set final [lindex $rowfinal $rm1]
5035 for {} {$row < $endrow} {incr row} {
5036 set rm1 [expr {$row - 1}]
5037 if {$rm1 < 0 || $idlist eq {}} {
5038 set idlist [make_idlist $row]
5041 set id [lindex $displayorder $rm1]
5042 set col [lsearch -exact $idlist $id]
5043 set idlist [lreplace $idlist $col $col]
5044 foreach p [lindex $parentlist $rm1] {
5045 if {[lsearch -exact $idlist $p] < 0} {
5046 set col [idcol $idlist $p $col]
5047 set idlist [linsert $idlist $col $p]
5048 # if not the first child, we have to insert a line going up
5049 if {$id ne [lindex $children($curview,$p) 0]} {
5050 makeupline $p $rm1 $row $col
5054 set id [lindex $displayorder $row]
5055 if {$row > $downarrowlen} {
5056 set termrow [expr {$row - $downarrowlen - 1}]
5057 foreach p [lindex $parentlist $termrow] {
5058 set i [lsearch -exact $idlist $p]
5059 if {$i < 0} continue
5060 set nr [nextuse $p $termrow]
5061 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5062 set idlist [lreplace $idlist $i $i]
5066 set col [lsearch -exact $idlist $id]
5068 set col [idcol $idlist $id]
5069 set idlist [linsert $idlist $col $id]
5070 if {$children($curview,$id) ne {}} {
5071 makeupline $id $rm1 $row $col
5074 set r [expr {$row + $uparrowlen - 1}]
5075 if {$r < $commitidx($curview)} {
5077 foreach p [lindex $parentlist $r] {
5078 if {[lsearch -exact $idlist $p] >= 0} continue
5079 set fk [lindex $children($curview,$p) 0]
5080 if {[rowofcommit $fk] < $row} {
5081 set x [idcol $idlist $p $x]
5082 set idlist [linsert $idlist $x $p]
5085 if {[incr r] < $commitidx($curview)} {
5086 set p [lindex $displayorder $r]
5087 if {[lsearch -exact $idlist $p] < 0} {
5088 set fk [lindex $children($curview,$p) 0]
5089 if {$fk ne {} && [rowofcommit $fk] < $row} {
5090 set x [idcol $idlist $p $x]
5091 set idlist [linsert $idlist $x $p]
5097 if {$final && !$viewcomplete($curview) &&
5098 $row + $uparrowlen + $mingaplen + $downarrowlen
5099 >= $commitidx($curview)} {
5102 set l [llength $rowidlist]
5104 lappend rowidlist $idlist
5106 lappend rowfinal $final
5107 } elseif {$row < $l} {
5108 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5109 lset rowidlist $row $idlist
5112 lset rowfinal $row $final
5114 set pad [ntimes [expr {$row - $l}] {}]
5115 set rowidlist [concat $rowidlist $pad]
5116 lappend rowidlist $idlist
5117 set rowfinal [concat $rowfinal $pad]
5118 lappend rowfinal $final
5119 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5125 proc changedrow {row} {
5126 global displayorder iddrawn rowisopt need_redisplay
5128 set l [llength $rowisopt]
5130 lset rowisopt $row 0
5131 if {$row + 1 < $l} {
5132 lset rowisopt [expr {$row + 1}] 0
5133 if {$row + 2 < $l} {
5134 lset rowisopt [expr {$row + 2}] 0
5138 set id [lindex $displayorder $row]
5139 if {[info exists iddrawn($id)]} {
5140 set need_redisplay 1
5144 proc insert_pad {row col npad} {
5147 set pad [ntimes $npad {}]
5148 set idlist [lindex $rowidlist $row]
5149 set bef [lrange $idlist 0 [expr {$col - 1}]]
5150 set aft [lrange $idlist $col end]
5151 set i [lsearch -exact $aft {}]
5153 set aft [lreplace $aft $i $i]
5155 lset rowidlist $row [concat $bef $pad $aft]
5159 proc optimize_rows {row col endrow} {
5160 global rowidlist rowisopt displayorder curview children
5165 for {} {$row < $endrow} {incr row; set col 0} {
5166 if {[lindex $rowisopt $row]} continue
5168 set y0 [expr {$row - 1}]
5169 set ym [expr {$row - 2}]
5170 set idlist [lindex $rowidlist $row]
5171 set previdlist [lindex $rowidlist $y0]
5172 if {$idlist eq {} || $previdlist eq {}} continue
5174 set pprevidlist [lindex $rowidlist $ym]
5175 if {$pprevidlist eq {}} continue
5181 for {} {$col < [llength $idlist]} {incr col} {
5182 set id [lindex $idlist $col]
5183 if {[lindex $previdlist $col] eq $id} continue
5188 set x0 [lsearch -exact $previdlist $id]
5189 if {$x0 < 0} continue
5190 set z [expr {$x0 - $col}]
5194 set xm [lsearch -exact $pprevidlist $id]
5196 set z0 [expr {$xm - $x0}]
5200 # if row y0 is the first child of $id then it's not an arrow
5201 if {[lindex $children($curview,$id) 0] ne
5202 [lindex $displayorder $y0]} {
5206 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5207 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5210 # Looking at lines from this row to the previous row,
5211 # make them go straight up if they end in an arrow on
5212 # the previous row; otherwise make them go straight up
5214 if {$z < -1 || ($z < 0 && $isarrow)} {
5215 # Line currently goes left too much;
5216 # insert pads in the previous row, then optimize it
5217 set npad [expr {-1 - $z + $isarrow}]
5218 insert_pad $y0 $x0 $npad
5220 optimize_rows $y0 $x0 $row
5222 set previdlist [lindex $rowidlist $y0]
5223 set x0 [lsearch -exact $previdlist $id]
5224 set z [expr {$x0 - $col}]
5226 set pprevidlist [lindex $rowidlist $ym]
5227 set xm [lsearch -exact $pprevidlist $id]
5228 set z0 [expr {$xm - $x0}]
5230 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5231 # Line currently goes right too much;
5232 # insert pads in this line
5233 set npad [expr {$z - 1 + $isarrow}]
5234 insert_pad $row $col $npad
5235 set idlist [lindex $rowidlist $row]
5237 set z [expr {$x0 - $col}]
5240 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5241 # this line links to its first child on row $row-2
5242 set id [lindex $displayorder $ym]
5243 set xc [lsearch -exact $pprevidlist $id]
5245 set z0 [expr {$xc - $x0}]
5248 # avoid lines jigging left then immediately right
5249 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5250 insert_pad $y0 $x0 1
5252 optimize_rows $y0 $x0 $row
5253 set previdlist [lindex $rowidlist $y0]
5257 # Find the first column that doesn't have a line going right
5258 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5259 set id [lindex $idlist $col]
5260 if {$id eq {}} break
5261 set x0 [lsearch -exact $previdlist $id]
5263 # check if this is the link to the first child
5264 set kid [lindex $displayorder $y0]
5265 if {[lindex $children($curview,$id) 0] eq $kid} {
5266 # it is, work out offset to child
5267 set x0 [lsearch -exact $previdlist $kid]
5270 if {$x0 <= $col} break
5272 # Insert a pad at that column as long as it has a line and
5273 # isn't the last column
5274 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5275 set idlist [linsert $idlist $col {}]
5276 lset rowidlist $row $idlist
5284 global canvx0 linespc
5285 return [expr {$canvx0 + $col * $linespc}]
5289 global canvy0 linespc
5290 return [expr {$canvy0 + $row * $linespc}]
5293 proc linewidth {id} {
5294 global thickerline lthickness
5297 if {[info exists thickerline] && $id eq $thickerline} {
5298 set wid [expr {2 * $lthickness}]
5303 proc rowranges {id} {
5304 global curview children uparrowlen downarrowlen
5307 set kids $children($curview,$id)
5313 foreach child $kids {
5314 if {![commitinview $child $curview]} break
5315 set row [rowofcommit $child]
5316 if {![info exists prev]} {
5317 lappend ret [expr {$row + 1}]
5319 if {$row <= $prevrow} {
5320 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5322 # see if the line extends the whole way from prevrow to row
5323 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5324 [lsearch -exact [lindex $rowidlist \
5325 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5326 # it doesn't, see where it ends
5327 set r [expr {$prevrow + $downarrowlen}]
5328 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5329 while {[incr r -1] > $prevrow &&
5330 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5332 while {[incr r] <= $row &&
5333 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5337 # see where it starts up again
5338 set r [expr {$row - $uparrowlen}]
5339 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5340 while {[incr r] < $row &&
5341 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5343 while {[incr r -1] >= $prevrow &&
5344 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5350 if {$child eq $id} {
5359 proc drawlineseg {id row endrow arrowlow} {
5360 global rowidlist displayorder iddrawn linesegs
5361 global canv colormap linespc curview maxlinelen parentlist
5363 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5364 set le [expr {$row + 1}]
5367 set c [lsearch -exact [lindex $rowidlist $le] $id]
5373 set x [lindex $displayorder $le]
5378 if {[info exists iddrawn($x)] || $le == $endrow} {
5379 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5395 if {[info exists linesegs($id)]} {
5396 set lines $linesegs($id)
5398 set r0 [lindex $li 0]
5400 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5410 set li [lindex $lines [expr {$i-1}]]
5411 set r1 [lindex $li 1]
5412 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5417 set x [lindex $cols [expr {$le - $row}]]
5418 set xp [lindex $cols [expr {$le - 1 - $row}]]
5419 set dir [expr {$xp - $x}]
5421 set ith [lindex $lines $i 2]
5422 set coords [$canv coords $ith]
5423 set ah [$canv itemcget $ith -arrow]
5424 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5425 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5426 if {$x2 ne {} && $x - $x2 == $dir} {
5427 set coords [lrange $coords 0 end-2]
5430 set coords [list [xc $le $x] [yc $le]]
5433 set itl [lindex $lines [expr {$i-1}] 2]
5434 set al [$canv itemcget $itl -arrow]
5435 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5436 } elseif {$arrowlow} {
5437 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5438 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5442 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5443 for {set y $le} {[incr y -1] > $row} {} {
5445 set xp [lindex $cols [expr {$y - 1 - $row}]]
5446 set ndir [expr {$xp - $x}]
5447 if {$dir != $ndir || $xp < 0} {
5448 lappend coords [xc $y $x] [yc $y]
5454 # join parent line to first child
5455 set ch [lindex $displayorder $row]
5456 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5458 puts "oops: drawlineseg: child $ch not on row $row"
5459 } elseif {$xc != $x} {
5460 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5461 set d [expr {int(0.5 * $linespc)}]
5464 set x2 [expr {$x1 - $d}]
5466 set x2 [expr {$x1 + $d}]
5469 set y1 [expr {$y2 + $d}]
5470 lappend coords $x1 $y1 $x2 $y2
5471 } elseif {$xc < $x - 1} {
5472 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5473 } elseif {$xc > $x + 1} {
5474 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5478 lappend coords [xc $row $x] [yc $row]
5480 set xn [xc $row $xp]
5482 lappend coords $xn $yn
5486 set t [$canv create line $coords -width [linewidth $id] \
5487 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5490 set lines [linsert $lines $i [list $row $le $t]]
5492 $canv coords $ith $coords
5493 if {$arrow ne $ah} {
5494 $canv itemconf $ith -arrow $arrow
5496 lset lines $i 0 $row
5499 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5500 set ndir [expr {$xo - $xp}]
5501 set clow [$canv coords $itl]
5502 if {$dir == $ndir} {
5503 set clow [lrange $clow 2 end]
5505 set coords [concat $coords $clow]
5507 lset lines [expr {$i-1}] 1 $le
5509 # coalesce two pieces
5511 set b [lindex $lines [expr {$i-1}] 0]
5512 set e [lindex $lines $i 1]
5513 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5515 $canv coords $itl $coords
5516 if {$arrow ne $al} {
5517 $canv itemconf $itl -arrow $arrow
5521 set linesegs($id) $lines
5525 proc drawparentlinks {id row} {
5526 global rowidlist canv colormap curview parentlist
5527 global idpos linespc
5529 set rowids [lindex $rowidlist $row]
5530 set col [lsearch -exact $rowids $id]
5531 if {$col < 0} return
5532 set olds [lindex $parentlist $row]
5533 set row2 [expr {$row + 1}]
5534 set x [xc $row $col]
5537 set d [expr {int(0.5 * $linespc)}]
5538 set ymid [expr {$y + $d}]
5539 set ids [lindex $rowidlist $row2]
5540 # rmx = right-most X coord used
5543 set i [lsearch -exact $ids $p]
5545 puts "oops, parent $p of $id not in list"
5548 set x2 [xc $row2 $i]
5552 set j [lsearch -exact $rowids $p]
5554 # drawlineseg will do this one for us
5558 # should handle duplicated parents here...
5559 set coords [list $x $y]
5561 # if attaching to a vertical segment, draw a smaller
5562 # slant for visual distinctness
5565 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5567 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5569 } elseif {$i < $col && $i < $j} {
5570 # segment slants towards us already
5571 lappend coords [xc $row $j] $y
5573 if {$i < $col - 1} {
5574 lappend coords [expr {$x2 + $linespc}] $y
5575 } elseif {$i > $col + 1} {
5576 lappend coords [expr {$x2 - $linespc}] $y
5578 lappend coords $x2 $y2
5581 lappend coords $x2 $y2
5583 set t [$canv create line $coords -width [linewidth $p] \
5584 -fill $colormap($p) -tags lines.$p]
5588 if {$rmx > [lindex $idpos($id) 1]} {
5589 lset idpos($id) 1 $rmx
5594 proc drawlines {id} {
5597 $canv itemconf lines.$id -width [linewidth $id]
5600 proc drawcmittext {id row col} {
5601 global linespc canv canv2 canv3 fgcolor curview
5602 global cmitlisted commitinfo rowidlist parentlist
5603 global rowtextx idpos idtags idheads idotherrefs
5604 global linehtag linentag linedtag selectedline
5605 global canvxmax boldids boldnameids fgcolor markedid
5606 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5608 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5609 set listed $cmitlisted($curview,$id)
5610 if {$id eq $nullid} {
5612 } elseif {$id eq $nullid2} {
5614 } elseif {$id eq $mainheadid} {
5617 set ofill [lindex $circlecolors $listed]
5619 set x [xc $row $col]
5621 set orad [expr {$linespc / 3}]
5623 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5624 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5625 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5626 } elseif {$listed == 3} {
5627 # triangle pointing left for left-side commits
5628 set t [$canv create polygon \
5629 [expr {$x - $orad}] $y \
5630 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5631 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5632 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5634 # triangle pointing right for right-side commits
5635 set t [$canv create polygon \
5636 [expr {$x + $orad - 1}] $y \
5637 [expr {$x - $orad}] [expr {$y - $orad}] \
5638 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5639 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5641 set circleitem($row) $t
5643 $canv bind $t <1> {selcanvline {} %x %y}
5644 set rmx [llength [lindex $rowidlist $row]]
5645 set olds [lindex $parentlist $row]
5647 set nextids [lindex $rowidlist [expr {$row + 1}]]
5649 set i [lsearch -exact $nextids $p]
5655 set xt [xc $row $rmx]
5656 set rowtextx($row) $xt
5657 set idpos($id) [list $x $xt $y]
5658 if {[info exists idtags($id)] || [info exists idheads($id)]
5659 || [info exists idotherrefs($id)]} {
5660 set xt [drawtags $id $x $xt $y]
5662 set headline [lindex $commitinfo($id) 0]
5663 set name [lindex $commitinfo($id) 1]
5664 set date [lindex $commitinfo($id) 2]
5665 set date [formatdate $date]
5668 set isbold [ishighlighted $id]
5671 set font mainfontbold
5673 lappend boldnameids $id
5674 set nfont mainfontbold
5677 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5678 -text $headline -font $font -tags text]
5679 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5680 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5681 -text $name -font $nfont -tags text]
5682 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5683 -text $date -font mainfont -tags text]
5684 if {$selectedline == $row} {
5687 if {[info exists markedid] && $markedid eq $id} {
5690 set xr [expr {$xt + [font measure $font $headline]}]
5691 if {$xr > $canvxmax} {
5697 proc drawcmitrow {row} {
5698 global displayorder rowidlist nrows_drawn
5699 global iddrawn markingmatches
5700 global commitinfo numcommits
5701 global filehighlight fhighlights findpattern nhighlights
5702 global hlview vhighlights
5703 global highlight_related rhighlights
5705 if {$row >= $numcommits} return
5707 set id [lindex $displayorder $row]
5708 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5709 askvhighlight $row $id
5711 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5712 askfilehighlight $row $id
5714 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5715 askfindhighlight $row $id
5717 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5718 askrelhighlight $row $id
5720 if {![info exists iddrawn($id)]} {
5721 set col [lsearch -exact [lindex $rowidlist $row] $id]
5723 puts "oops, row $row id $id not in list"
5726 if {![info exists commitinfo($id)]} {
5730 drawcmittext $id $row $col
5734 if {$markingmatches} {
5735 markrowmatches $row $id
5739 proc drawcommits {row {endrow {}}} {
5740 global numcommits iddrawn displayorder curview need_redisplay
5741 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5746 if {$endrow eq {}} {
5749 if {$endrow >= $numcommits} {
5750 set endrow [expr {$numcommits - 1}]
5753 set rl1 [expr {$row - $downarrowlen - 3}]
5757 set ro1 [expr {$row - 3}]
5761 set r2 [expr {$endrow + $uparrowlen + 3}]
5762 if {$r2 > $numcommits} {
5765 for {set r $rl1} {$r < $r2} {incr r} {
5766 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5770 set rl1 [expr {$r + 1}]
5776 optimize_rows $ro1 0 $r2
5777 if {$need_redisplay || $nrows_drawn > 2000} {
5781 # make the lines join to already-drawn rows either side
5782 set r [expr {$row - 1}]
5783 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5786 set er [expr {$endrow + 1}]
5787 if {$er >= $numcommits ||
5788 ![info exists iddrawn([lindex $displayorder $er])]} {
5791 for {} {$r <= $er} {incr r} {
5792 set id [lindex $displayorder $r]
5793 set wasdrawn [info exists iddrawn($id)]
5795 if {$r == $er} break
5796 set nextid [lindex $displayorder [expr {$r + 1}]]
5797 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5798 drawparentlinks $id $r
5800 set rowids [lindex $rowidlist $r]
5801 foreach lid $rowids {
5802 if {$lid eq {}} continue
5803 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5805 # see if this is the first child of any of its parents
5806 foreach p [lindex $parentlist $r] {
5807 if {[lsearch -exact $rowids $p] < 0} {
5808 # make this line extend up to the child
5809 set lineend($p) [drawlineseg $p $r $er 0]
5813 set lineend($lid) [drawlineseg $lid $r $er 1]
5819 proc undolayout {row} {
5820 global uparrowlen mingaplen downarrowlen
5821 global rowidlist rowisopt rowfinal need_redisplay
5823 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5827 if {[llength $rowidlist] > $r} {
5829 set rowidlist [lrange $rowidlist 0 $r]
5830 set rowfinal [lrange $rowfinal 0 $r]
5831 set rowisopt [lrange $rowisopt 0 $r]
5832 set need_redisplay 1
5837 proc drawvisible {} {
5838 global canv linespc curview vrowmod selectedline targetrow targetid
5839 global need_redisplay cscroll numcommits
5841 set fs [$canv yview]
5842 set ymax [lindex [$canv cget -scrollregion] 3]
5843 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5844 set f0 [lindex $fs 0]
5845 set f1 [lindex $fs 1]
5846 set y0 [expr {int($f0 * $ymax)}]
5847 set y1 [expr {int($f1 * $ymax)}]
5849 if {[info exists targetid]} {
5850 if {[commitinview $targetid $curview]} {
5851 set r [rowofcommit $targetid]
5852 if {$r != $targetrow} {
5853 # Fix up the scrollregion and change the scrolling position
5854 # now that our target row has moved.
5855 set diff [expr {($r - $targetrow) * $linespc}]
5858 set ymax [lindex [$canv cget -scrollregion] 3]
5861 set f0 [expr {$y0 / $ymax}]
5862 set f1 [expr {$y1 / $ymax}]
5863 allcanvs yview moveto $f0
5864 $cscroll set $f0 $f1
5865 set need_redisplay 1
5872 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5873 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5874 if {$endrow >= $vrowmod($curview)} {
5875 update_arcrows $curview
5877 if {$selectedline ne {} &&
5878 $row <= $selectedline && $selectedline <= $endrow} {
5879 set targetrow $selectedline
5880 } elseif {[info exists targetid]} {
5881 set targetrow [expr {int(($row + $endrow) / 2)}]
5883 if {[info exists targetrow]} {
5884 if {$targetrow >= $numcommits} {
5885 set targetrow [expr {$numcommits - 1}]
5887 set targetid [commitonrow $targetrow]
5889 drawcommits $row $endrow
5892 proc clear_display {} {
5893 global iddrawn linesegs need_redisplay nrows_drawn
5894 global vhighlights fhighlights nhighlights rhighlights
5895 global linehtag linentag linedtag boldids boldnameids
5898 catch {unset iddrawn}
5899 catch {unset linesegs}
5900 catch {unset linehtag}
5901 catch {unset linentag}
5902 catch {unset linedtag}
5905 catch {unset vhighlights}
5906 catch {unset fhighlights}
5907 catch {unset nhighlights}
5908 catch {unset rhighlights}
5909 set need_redisplay 0
5913 proc findcrossings {id} {
5914 global rowidlist parentlist numcommits displayorder
5918 foreach {s e} [rowranges $id] {
5919 if {$e >= $numcommits} {
5920 set e [expr {$numcommits - 1}]
5922 if {$e <= $s} continue
5923 for {set row $e} {[incr row -1] >= $s} {} {
5924 set x [lsearch -exact [lindex $rowidlist $row] $id]
5926 set olds [lindex $parentlist $row]
5927 set kid [lindex $displayorder $row]
5928 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5929 if {$kidx < 0} continue
5930 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5932 set px [lsearch -exact $nextrow $p]
5933 if {$px < 0} continue
5934 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5935 if {[lsearch -exact $ccross $p] >= 0} continue
5936 if {$x == $px + ($kidx < $px? -1: 1)} {
5938 } elseif {[lsearch -exact $cross $p] < 0} {
5945 return [concat $ccross {{}} $cross]
5948 proc assigncolor {id} {
5949 global colormap colors nextcolor
5950 global parents children children curview
5952 if {[info exists colormap($id)]} return
5953 set ncolors [llength $colors]
5954 if {[info exists children($curview,$id)]} {
5955 set kids $children($curview,$id)
5959 if {[llength $kids] == 1} {
5960 set child [lindex $kids 0]
5961 if {[info exists colormap($child)]
5962 && [llength $parents($curview,$child)] == 1} {
5963 set colormap($id) $colormap($child)
5969 foreach x [findcrossings $id] {
5971 # delimiter between corner crossings and other crossings
5972 if {[llength $badcolors] >= $ncolors - 1} break
5973 set origbad $badcolors
5975 if {[info exists colormap($x)]
5976 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5977 lappend badcolors $colormap($x)
5980 if {[llength $badcolors] >= $ncolors} {
5981 set badcolors $origbad
5983 set origbad $badcolors
5984 if {[llength $badcolors] < $ncolors - 1} {
5985 foreach child $kids {
5986 if {[info exists colormap($child)]
5987 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5988 lappend badcolors $colormap($child)
5990 foreach p $parents($curview,$child) {
5991 if {[info exists colormap($p)]
5992 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5993 lappend badcolors $colormap($p)
5997 if {[llength $badcolors] >= $ncolors} {
5998 set badcolors $origbad
6001 for {set i 0} {$i <= $ncolors} {incr i} {
6002 set c [lindex $colors $nextcolor]
6003 if {[incr nextcolor] >= $ncolors} {
6006 if {[lsearch -exact $badcolors $c]} break
6008 set colormap($id) $c
6011 proc bindline {t id} {
6014 $canv bind $t <Enter> "lineenter %x %y $id"
6015 $canv bind $t <Motion> "linemotion %x %y $id"
6016 $canv bind $t <Leave> "lineleave $id"
6017 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6020 proc drawtags {id x xt y1} {
6021 global idtags idheads idotherrefs mainhead
6022 global linespc lthickness
6023 global canv rowtextx curview fgcolor bgcolor ctxbut
6028 if {[info exists idtags($id)]} {
6029 set marks $idtags($id)
6030 set ntags [llength $marks]
6032 if {[info exists idheads($id)]} {
6033 set marks [concat $marks $idheads($id)]
6034 set nheads [llength $idheads($id)]
6036 if {[info exists idotherrefs($id)]} {
6037 set marks [concat $marks $idotherrefs($id)]
6043 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6044 set yt [expr {$y1 - 0.5 * $linespc}]
6045 set yb [expr {$yt + $linespc - 1}]
6049 foreach tag $marks {
6051 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6052 set wid [font measure mainfontbold $tag]
6054 set wid [font measure mainfont $tag]
6058 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6060 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6061 -width $lthickness -fill black -tags tag.$id]
6063 foreach tag $marks x $xvals wid $wvals {
6064 set xl [expr {$x + $delta}]
6065 set xr [expr {$x + $delta + $wid + $lthickness}]
6067 if {[incr ntags -1] >= 0} {
6069 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6070 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6071 -width 1 -outline black -fill yellow -tags tag.$id]
6072 $canv bind $t <1> [list showtag $tag 1]
6073 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6075 # draw a head or other ref
6076 if {[incr nheads -1] >= 0} {
6078 if {$tag eq $mainhead} {
6079 set font mainfontbold
6084 set xl [expr {$xl - $delta/2}]
6085 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6086 -width 1 -outline black -fill $col -tags tag.$id
6087 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6088 set rwid [font measure mainfont $remoteprefix]
6089 set xi [expr {$x + 1}]
6090 set yti [expr {$yt + 1}]
6091 set xri [expr {$x + $rwid}]
6092 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6093 -width 0 -fill "#ffddaa" -tags tag.$id
6096 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6097 -font $font -tags [list tag.$id text]]
6099 $canv bind $t <1> [list showtag $tag 1]
6100 } elseif {$nheads >= 0} {
6101 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
6107 proc xcoord {i level ln} {
6108 global canvx0 xspc1 xspc2
6110 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6111 if {$i > 0 && $i == $level} {
6112 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6113 } elseif {$i > $level} {
6114 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6119 proc show_status {msg} {
6123 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6124 -tags text -fill $fgcolor
6127 # Don't change the text pane cursor if it is currently the hand cursor,
6128 # showing that we are over a sha1 ID link.
6129 proc settextcursor {c} {
6130 global ctext curtextcursor
6132 if {[$ctext cget -cursor] == $curtextcursor} {
6133 $ctext config -cursor $c
6135 set curtextcursor $c
6138 proc nowbusy {what {name {}}} {
6139 global isbusy busyname statusw
6141 if {[array names isbusy] eq {}} {
6142 . config -cursor watch
6146 set busyname($what) $name
6148 $statusw conf -text $name
6152 proc notbusy {what} {
6153 global isbusy maincursor textcursor busyname statusw
6157 if {$busyname($what) ne {} &&
6158 [$statusw cget -text] eq $busyname($what)} {
6159 $statusw conf -text {}
6162 if {[array names isbusy] eq {}} {
6163 . config -cursor $maincursor
6164 settextcursor $textcursor
6168 proc findmatches {f} {
6169 global findtype findstring
6170 if {$findtype == [mc "Regexp"]} {
6171 set matches [regexp -indices -all -inline $findstring $f]
6174 if {$findtype == [mc "IgnCase"]} {
6175 set f [string tolower $f]
6176 set fs [string tolower $fs]
6180 set l [string length $fs]
6181 while {[set j [string first $fs $f $i]] >= 0} {
6182 lappend matches [list $j [expr {$j+$l-1}]]
6183 set i [expr {$j + $l}]
6189 proc dofind {{dirn 1} {wrap 1}} {
6190 global findstring findstartline findcurline selectedline numcommits
6191 global gdttype filehighlight fh_serial find_dirn findallowwrap
6193 if {[info exists find_dirn]} {
6194 if {$find_dirn == $dirn} return
6198 if {$findstring eq {} || $numcommits == 0} return
6199 if {$selectedline eq {}} {
6200 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6202 set findstartline $selectedline
6204 set findcurline $findstartline
6205 nowbusy finding [mc "Searching"]
6206 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6207 after cancel do_file_hl $fh_serial
6208 do_file_hl $fh_serial
6211 set findallowwrap $wrap
6215 proc stopfinding {} {
6216 global find_dirn findcurline fprogcoord
6218 if {[info exists find_dirn]} {
6229 global commitdata commitinfo numcommits findpattern findloc
6230 global findstartline findcurline findallowwrap
6231 global find_dirn gdttype fhighlights fprogcoord
6232 global curview varcorder vrownum varccommits vrowmod
6234 if {![info exists find_dirn]} {
6237 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6240 if {$find_dirn > 0} {
6242 if {$l >= $numcommits} {
6245 if {$l <= $findstartline} {
6246 set lim [expr {$findstartline + 1}]
6249 set moretodo $findallowwrap
6256 if {$l >= $findstartline} {
6257 set lim [expr {$findstartline - 1}]
6260 set moretodo $findallowwrap
6263 set n [expr {($lim - $l) * $find_dirn}]
6268 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6269 update_arcrows $curview
6273 set ai [bsearch $vrownum($curview) $l]
6274 set a [lindex $varcorder($curview) $ai]
6275 set arow [lindex $vrownum($curview) $ai]
6276 set ids [lindex $varccommits($curview,$a)]
6277 set arowend [expr {$arow + [llength $ids]}]
6278 if {$gdttype eq [mc "containing:"]} {
6279 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6280 if {$l < $arow || $l >= $arowend} {
6282 set a [lindex $varcorder($curview) $ai]
6283 set arow [lindex $vrownum($curview) $ai]
6284 set ids [lindex $varccommits($curview,$a)]
6285 set arowend [expr {$arow + [llength $ids]}]
6287 set id [lindex $ids [expr {$l - $arow}]]
6288 # shouldn't happen unless git log doesn't give all the commits...
6289 if {![info exists commitdata($id)] ||
6290 ![doesmatch $commitdata($id)]} {
6293 if {![info exists commitinfo($id)]} {
6296 set info $commitinfo($id)
6297 foreach f $info ty $fldtypes {
6298 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6307 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6308 if {$l < $arow || $l >= $arowend} {
6310 set a [lindex $varcorder($curview) $ai]
6311 set arow [lindex $vrownum($curview) $ai]
6312 set ids [lindex $varccommits($curview,$a)]
6313 set arowend [expr {$arow + [llength $ids]}]
6315 set id [lindex $ids [expr {$l - $arow}]]
6316 if {![info exists fhighlights($id)]} {
6317 # this sets fhighlights($id) to -1
6318 askfilehighlight $l $id
6320 if {$fhighlights($id) > 0} {
6324 if {$fhighlights($id) < 0} {
6327 set findcurline [expr {$l - $find_dirn}]
6332 if {$found || ($domore && !$moretodo)} {
6348 set findcurline [expr {$l - $find_dirn}]
6350 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6354 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6359 proc findselectline {l} {
6360 global findloc commentend ctext findcurline markingmatches gdttype
6362 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6365 if {$markingmatches &&
6366 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6367 # highlight the matches in the comments
6368 set f [$ctext get 1.0 $commentend]
6369 set matches [findmatches $f]
6370 foreach match $matches {
6371 set start [lindex $match 0]
6372 set end [expr {[lindex $match 1] + 1}]
6373 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6379 # mark the bits of a headline or author that match a find string
6380 proc markmatches {canv l str tag matches font row} {
6383 set bbox [$canv bbox $tag]
6384 set x0 [lindex $bbox 0]
6385 set y0 [lindex $bbox 1]
6386 set y1 [lindex $bbox 3]
6387 foreach match $matches {
6388 set start [lindex $match 0]
6389 set end [lindex $match 1]
6390 if {$start > $end} continue
6391 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6392 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6393 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6394 [expr {$x0+$xlen+2}] $y1 \
6395 -outline {} -tags [list match$l matches] -fill yellow]
6397 if {$row == $selectedline} {
6398 $canv raise $t secsel
6403 proc unmarkmatches {} {
6404 global markingmatches
6406 allcanvs delete matches
6407 set markingmatches 0
6411 proc selcanvline {w x y} {
6412 global canv canvy0 ctext linespc
6414 set ymax [lindex [$canv cget -scrollregion] 3]
6415 if {$ymax == {}} return
6416 set yfrac [lindex [$canv yview] 0]
6417 set y [expr {$y + $yfrac * $ymax}]
6418 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6423 set xmax [lindex [$canv cget -scrollregion] 2]
6424 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6425 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6431 proc commit_descriptor {p} {
6433 if {![info exists commitinfo($p)]} {
6437 if {[llength $commitinfo($p)] > 1} {
6438 set l [lindex $commitinfo($p) 0]
6443 # append some text to the ctext widget, and make any SHA1 ID
6444 # that we know about be a clickable link.
6445 proc appendwithlinks {text tags} {
6446 global ctext linknum curview
6448 set start [$ctext index "end - 1c"]
6449 $ctext insert end $text $tags
6450 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6454 set linkid [string range $text $s $e]
6456 $ctext tag delete link$linknum
6457 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6458 setlink $linkid link$linknum
6463 proc setlink {id lk} {
6464 global curview ctext pendinglinks
6467 if {[string length $id] < 40} {
6468 set matches [longid $id]
6469 if {[llength $matches] > 0} {
6470 if {[llength $matches] > 1} return
6472 set id [lindex $matches 0]
6475 set known [commitinview $id $curview]
6478 $ctext tag conf $lk -foreground blue -underline 1
6479 $ctext tag bind $lk <1> [list selbyid $id]
6480 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6481 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6483 lappend pendinglinks($id) $lk
6484 interestedin $id {makelink %P}
6488 proc makelink {id} {
6491 if {![info exists pendinglinks($id)]} return
6492 foreach lk $pendinglinks($id) {
6495 unset pendinglinks($id)
6498 proc linkcursor {w inc} {
6499 global linkentercount curtextcursor
6501 if {[incr linkentercount $inc] > 0} {
6502 $w configure -cursor hand2
6504 $w configure -cursor $curtextcursor
6505 if {$linkentercount < 0} {
6506 set linkentercount 0
6511 proc viewnextline {dir} {
6515 set ymax [lindex [$canv cget -scrollregion] 3]
6516 set wnow [$canv yview]
6517 set wtop [expr {[lindex $wnow 0] * $ymax}]
6518 set newtop [expr {$wtop + $dir * $linespc}]
6521 } elseif {$newtop > $ymax} {
6524 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6527 # add a list of tag or branch names at position pos
6528 # returns the number of names inserted
6529 proc appendrefs {pos ids var} {
6530 global ctext linknum curview $var maxrefs
6532 if {[catch {$ctext index $pos}]} {
6535 $ctext conf -state normal
6536 $ctext delete $pos "$pos lineend"
6539 foreach tag [set $var\($id\)] {
6540 lappend tags [list $tag $id]
6543 if {[llength $tags] > $maxrefs} {
6544 $ctext insert $pos "[mc "many"] ([llength $tags])"
6546 set tags [lsort -index 0 -decreasing $tags]
6549 set id [lindex $ti 1]
6552 $ctext tag delete $lk
6553 $ctext insert $pos $sep
6554 $ctext insert $pos [lindex $ti 0] $lk
6559 $ctext conf -state disabled
6560 return [llength $tags]
6563 # called when we have finished computing the nearby tags
6564 proc dispneartags {delay} {
6565 global selectedline currentid showneartags tagphase
6567 if {$selectedline eq {} || !$showneartags} return
6568 after cancel dispnexttag
6570 after 200 dispnexttag
6573 after idle dispnexttag
6578 proc dispnexttag {} {
6579 global selectedline currentid showneartags tagphase ctext
6581 if {$selectedline eq {} || !$showneartags} return
6582 switch -- $tagphase {
6584 set dtags [desctags $currentid]
6586 appendrefs precedes $dtags idtags
6590 set atags [anctags $currentid]
6592 appendrefs follows $atags idtags
6596 set dheads [descheads $currentid]
6597 if {$dheads ne {}} {
6598 if {[appendrefs branch $dheads idheads] > 1
6599 && [$ctext get "branch -3c"] eq "h"} {
6600 # turn "Branch" into "Branches"
6601 $ctext conf -state normal
6602 $ctext insert "branch -2c" "es"
6603 $ctext conf -state disabled
6608 if {[incr tagphase] <= 2} {
6609 after idle dispnexttag
6613 proc make_secsel {id} {
6614 global linehtag linentag linedtag canv canv2 canv3
6616 if {![info exists linehtag($id)]} return
6618 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6619 -tags secsel -fill [$canv cget -selectbackground]]
6621 $canv2 delete secsel
6622 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6623 -tags secsel -fill [$canv2 cget -selectbackground]]
6625 $canv3 delete secsel
6626 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6627 -tags secsel -fill [$canv3 cget -selectbackground]]
6631 proc make_idmark {id} {
6632 global linehtag canv fgcolor
6634 if {![info exists linehtag($id)]} return
6636 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6637 -tags markid -outline $fgcolor]
6641 proc selectline {l isnew {desired_loc {}}} {
6642 global canv ctext commitinfo selectedline
6643 global canvy0 linespc parents children curview
6644 global currentid sha1entry
6645 global commentend idtags linknum
6646 global mergemax numcommits pending_select
6647 global cmitmode showneartags allcommits
6648 global targetrow targetid lastscrollrows
6649 global autoselect jump_to_here
6651 catch {unset pending_select}
6656 if {$l < 0 || $l >= $numcommits} return
6657 set id [commitonrow $l]
6662 if {$lastscrollrows < $numcommits} {
6666 set y [expr {$canvy0 + $l * $linespc}]
6667 set ymax [lindex [$canv cget -scrollregion] 3]
6668 set ytop [expr {$y - $linespc - 1}]
6669 set ybot [expr {$y + $linespc + 1}]
6670 set wnow [$canv yview]
6671 set wtop [expr {[lindex $wnow 0] * $ymax}]
6672 set wbot [expr {[lindex $wnow 1] * $ymax}]
6673 set wh [expr {$wbot - $wtop}]
6675 if {$ytop < $wtop} {
6676 if {$ybot < $wtop} {
6677 set newtop [expr {$y - $wh / 2.0}]
6680 if {$newtop > $wtop - $linespc} {
6681 set newtop [expr {$wtop - $linespc}]
6684 } elseif {$ybot > $wbot} {
6685 if {$ytop > $wbot} {
6686 set newtop [expr {$y - $wh / 2.0}]
6688 set newtop [expr {$ybot - $wh}]
6689 if {$newtop < $wtop + $linespc} {
6690 set newtop [expr {$wtop + $linespc}]
6694 if {$newtop != $wtop} {
6698 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6705 addtohistory [list selbyid $id]
6708 $sha1entry delete 0 end
6709 $sha1entry insert 0 $id
6711 $sha1entry selection from 0
6712 $sha1entry selection to end
6716 $ctext conf -state normal
6719 if {![info exists commitinfo($id)]} {
6722 set info $commitinfo($id)
6723 set date [formatdate [lindex $info 2]]
6724 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6725 set date [formatdate [lindex $info 4]]
6726 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6727 if {[info exists idtags($id)]} {
6728 $ctext insert end [mc "Tags:"]
6729 foreach tag $idtags($id) {
6730 $ctext insert end " $tag"
6732 $ctext insert end "\n"
6736 set olds $parents($curview,$id)
6737 if {[llength $olds] > 1} {
6740 if {$np >= $mergemax} {
6745 $ctext insert end "[mc "Parent"]: " $tag
6746 appendwithlinks [commit_descriptor $p] {}
6751 append headers "[mc "Parent"]: [commit_descriptor $p]"
6755 foreach c $children($curview,$id) {
6756 append headers "[mc "Child"]: [commit_descriptor $c]"
6759 # make anything that looks like a SHA1 ID be a clickable link
6760 appendwithlinks $headers {}
6761 if {$showneartags} {
6762 if {![info exists allcommits]} {
6765 $ctext insert end "[mc "Branch"]: "
6766 $ctext mark set branch "end -1c"
6767 $ctext mark gravity branch left
6768 $ctext insert end "\n[mc "Follows"]: "
6769 $ctext mark set follows "end -1c"
6770 $ctext mark gravity follows left
6771 $ctext insert end "\n[mc "Precedes"]: "
6772 $ctext mark set precedes "end -1c"
6773 $ctext mark gravity precedes left
6774 $ctext insert end "\n"
6777 $ctext insert end "\n"
6778 set comment [lindex $info 5]
6779 if {[string first "\r" $comment] >= 0} {
6780 set comment [string map {"\r" "\n "} $comment]
6782 appendwithlinks $comment {comment}
6784 $ctext tag remove found 1.0 end
6785 $ctext conf -state disabled
6786 set commentend [$ctext index "end - 1c"]
6788 set jump_to_here $desired_loc
6789 init_flist [mc "Comments"]
6790 if {$cmitmode eq "tree"} {
6792 } elseif {[llength $olds] <= 1} {
6799 proc selfirstline {} {
6804 proc sellastline {} {
6807 set l [expr {$numcommits - 1}]
6811 proc selnextline {dir} {
6814 if {$selectedline eq {}} return
6815 set l [expr {$selectedline + $dir}]
6820 proc selnextpage {dir} {
6821 global canv linespc selectedline numcommits
6823 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6827 allcanvs yview scroll [expr {$dir * $lpp}] units
6829 if {$selectedline eq {}} return
6830 set l [expr {$selectedline + $dir * $lpp}]
6833 } elseif {$l >= $numcommits} {
6834 set l [expr $numcommits - 1]
6840 proc unselectline {} {
6841 global selectedline currentid
6844 catch {unset currentid}
6845 allcanvs delete secsel
6849 proc reselectline {} {
6852 if {$selectedline ne {}} {
6853 selectline $selectedline 0
6857 proc addtohistory {cmd} {
6858 global history historyindex curview
6860 set elt [list $curview $cmd]
6861 if {$historyindex > 0
6862 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6866 if {$historyindex < [llength $history]} {
6867 set history [lreplace $history $historyindex end $elt]
6869 lappend history $elt
6872 if {$historyindex > 1} {
6873 .tf.bar.leftbut conf -state normal
6875 .tf.bar.leftbut conf -state disabled
6877 .tf.bar.rightbut conf -state disabled
6883 set view [lindex $elt 0]
6884 set cmd [lindex $elt 1]
6885 if {$curview != $view} {
6892 global history historyindex
6895 if {$historyindex > 1} {
6896 incr historyindex -1
6897 godo [lindex $history [expr {$historyindex - 1}]]
6898 .tf.bar.rightbut conf -state normal
6900 if {$historyindex <= 1} {
6901 .tf.bar.leftbut conf -state disabled
6906 global history historyindex
6909 if {$historyindex < [llength $history]} {
6910 set cmd [lindex $history $historyindex]
6913 .tf.bar.leftbut conf -state normal
6915 if {$historyindex >= [llength $history]} {
6916 .tf.bar.rightbut conf -state disabled
6921 global treefilelist treeidlist diffids diffmergeid treepending
6922 global nullid nullid2
6925 catch {unset diffmergeid}
6926 if {![info exists treefilelist($id)]} {
6927 if {![info exists treepending]} {
6928 if {$id eq $nullid} {
6929 set cmd [list | git ls-files]
6930 } elseif {$id eq $nullid2} {
6931 set cmd [list | git ls-files --stage -t]
6933 set cmd [list | git ls-tree -r $id]
6935 if {[catch {set gtf [open $cmd r]}]} {
6939 set treefilelist($id) {}
6940 set treeidlist($id) {}
6941 fconfigure $gtf -blocking 0 -encoding binary
6942 filerun $gtf [list gettreeline $gtf $id]
6949 proc gettreeline {gtf id} {
6950 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6953 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6954 if {$diffids eq $nullid} {
6957 set i [string first "\t" $line]
6958 if {$i < 0} continue
6959 set fname [string range $line [expr {$i+1}] end]
6960 set line [string range $line 0 [expr {$i-1}]]
6961 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6962 set sha1 [lindex $line 2]
6963 lappend treeidlist($id) $sha1
6965 if {[string index $fname 0] eq "\""} {
6966 set fname [lindex $fname 0]
6968 set fname [encoding convertfrom $fname]
6969 lappend treefilelist($id) $fname
6972 return [expr {$nl >= 1000? 2: 1}]
6976 if {$cmitmode ne "tree"} {
6977 if {![info exists diffmergeid]} {
6978 gettreediffs $diffids
6980 } elseif {$id ne $diffids} {
6989 global treefilelist treeidlist diffids nullid nullid2
6990 global ctext_file_names ctext_file_lines
6991 global ctext commentend
6993 set i [lsearch -exact $treefilelist($diffids) $f]
6995 puts "oops, $f not in list for id $diffids"
6998 if {$diffids eq $nullid} {
6999 if {[catch {set bf [open $f r]} err]} {
7000 puts "oops, can't read $f: $err"
7004 set blob [lindex $treeidlist($diffids) $i]
7005 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7006 puts "oops, error reading blob $blob: $err"
7010 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7011 filerun $bf [list getblobline $bf $diffids]
7012 $ctext config -state normal
7013 clear_ctext $commentend
7014 lappend ctext_file_names $f
7015 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7016 $ctext insert end "\n"
7017 $ctext insert end "$f\n" filesep
7018 $ctext config -state disabled
7019 $ctext yview $commentend
7023 proc getblobline {bf id} {
7024 global diffids cmitmode ctext
7026 if {$id ne $diffids || $cmitmode ne "tree"} {
7030 $ctext config -state normal
7032 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7033 $ctext insert end "$line\n"
7036 global jump_to_here ctext_file_names commentend
7038 # delete last newline
7039 $ctext delete "end - 2c" "end - 1c"
7041 if {$jump_to_here ne {} &&
7042 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7043 set lnum [expr {[lindex $jump_to_here 1] +
7044 [lindex [split $commentend .] 0]}]
7045 mark_ctext_line $lnum
7049 $ctext config -state disabled
7050 return [expr {$nl >= 1000? 2: 1}]
7053 proc mark_ctext_line {lnum} {
7054 global ctext markbgcolor
7056 $ctext tag delete omark
7057 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7058 $ctext tag conf omark -background $markbgcolor
7062 proc mergediff {id} {
7064 global diffids treediffs
7065 global parents curview
7069 set treediffs($id) {}
7070 set np [llength $parents($curview,$id)]
7075 proc startdiff {ids} {
7076 global treediffs diffids treepending diffmergeid nullid nullid2
7080 catch {unset diffmergeid}
7081 if {![info exists treediffs($ids)] ||
7082 [lsearch -exact $ids $nullid] >= 0 ||
7083 [lsearch -exact $ids $nullid2] >= 0} {
7084 if {![info exists treepending]} {
7092 proc path_filter {filter name} {
7094 set l [string length $p]
7095 if {[string index $p end] eq "/"} {
7096 if {[string compare -length $l $p $name] == 0} {
7100 if {[string compare -length $l $p $name] == 0 &&
7101 ([string length $name] == $l ||
7102 [string index $name $l] eq "/")} {
7110 proc addtocflist {ids} {
7113 add_flist $treediffs($ids)
7117 proc diffcmd {ids flags} {
7118 global nullid nullid2
7120 set i [lsearch -exact $ids $nullid]
7121 set j [lsearch -exact $ids $nullid2]
7123 if {[llength $ids] > 1 && $j < 0} {
7124 # comparing working directory with some specific revision
7125 set cmd [concat | git diff-index $flags]
7127 lappend cmd -R [lindex $ids 1]
7129 lappend cmd [lindex $ids 0]
7132 # comparing working directory with index
7133 set cmd [concat | git diff-files $flags]
7138 } elseif {$j >= 0} {
7139 set cmd [concat | git diff-index --cached $flags]
7140 if {[llength $ids] > 1} {
7141 # comparing index with specific revision
7143 lappend cmd -R [lindex $ids 1]
7145 lappend cmd [lindex $ids 0]
7148 # comparing index with HEAD
7152 set cmd [concat | git diff-tree -r $flags $ids]
7157 proc gettreediffs {ids} {
7158 global treediff treepending
7160 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7162 set treepending $ids
7164 fconfigure $gdtf -blocking 0 -encoding binary
7165 filerun $gdtf [list gettreediffline $gdtf $ids]
7168 proc gettreediffline {gdtf ids} {
7169 global treediff treediffs treepending diffids diffmergeid
7170 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7175 if {$perfile_attrs} {
7176 # cache_gitattr is slow, and even slower on win32 where we
7177 # have to invoke it for only about 30 paths at a time
7179 if {[tk windowingsystem] == "win32"} {
7183 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7184 set i [string first "\t" $line]
7186 set file [string range $line [expr {$i+1}] end]
7187 if {[string index $file 0] eq "\""} {
7188 set file [lindex $file 0]
7190 set file [encoding convertfrom $file]
7191 if {$file ne [lindex $treediff end]} {
7192 lappend treediff $file
7193 lappend sublist $file
7197 if {$perfile_attrs} {
7198 cache_gitattr encoding $sublist
7201 return [expr {$nr >= $max? 2: 1}]
7204 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7206 foreach f $treediff {
7207 if {[path_filter $vfilelimit($curview) $f]} {
7211 set treediffs($ids) $flist
7213 set treediffs($ids) $treediff
7216 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7218 } elseif {$ids != $diffids} {
7219 if {![info exists diffmergeid]} {
7220 gettreediffs $diffids
7228 # empty string or positive integer
7229 proc diffcontextvalidate {v} {
7230 return [regexp {^(|[1-9][0-9]*)$} $v]
7233 proc diffcontextchange {n1 n2 op} {
7234 global diffcontextstring diffcontext
7236 if {[string is integer -strict $diffcontextstring]} {
7237 if {$diffcontextstring > 0} {
7238 set diffcontext $diffcontextstring
7244 proc changeignorespace {} {
7248 proc getblobdiffs {ids} {
7249 global blobdifffd diffids env
7250 global diffinhdr treediffs
7253 global limitdiffs vfilelimit curview
7254 global diffencoding targetline diffnparents
7256 set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
7260 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7261 set cmd [concat $cmd -- $vfilelimit($curview)]
7263 if {[catch {set bdf [open $cmd r]} err]} {
7264 error_popup [mc "Error getting diffs: %s" $err]
7270 set diffencoding [get_path_encoding {}]
7271 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7272 set blobdifffd($ids) $bdf
7273 filerun $bdf [list getblobdiffline $bdf $diffids]
7276 proc setinlist {var i val} {
7279 while {[llength [set $var]] < $i} {
7282 if {[llength [set $var]] == $i} {
7289 proc makediffhdr {fname ids} {
7290 global ctext curdiffstart treediffs diffencoding
7291 global ctext_file_names jump_to_here targetline diffline
7293 set fname [encoding convertfrom $fname]
7294 set diffencoding [get_path_encoding $fname]
7295 set i [lsearch -exact $treediffs($ids) $fname]
7297 setinlist difffilestart $i $curdiffstart
7299 lset ctext_file_names end $fname
7300 set l [expr {(78 - [string length $fname]) / 2}]
7301 set pad [string range "----------------------------------------" 1 $l]
7302 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7304 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7305 set targetline [lindex $jump_to_here 1]
7310 proc getblobdiffline {bdf ids} {
7311 global diffids blobdifffd ctext curdiffstart
7312 global diffnexthead diffnextnote difffilestart
7313 global ctext_file_names ctext_file_lines
7314 global diffinhdr treediffs mergemax diffnparents
7315 global diffencoding jump_to_here targetline diffline
7318 $ctext conf -state normal
7319 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7320 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7324 if {![string compare -length 5 "diff " $line]} {
7325 if {![regexp {^diff (--cc|--git) } $line m type]} {
7326 set line [encoding convertfrom $line]
7327 $ctext insert end "$line\n" hunksep
7330 # start of a new file
7332 $ctext insert end "\n"
7333 set curdiffstart [$ctext index "end - 1c"]
7334 lappend ctext_file_names ""
7335 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7336 $ctext insert end "\n" filesep
7338 if {$type eq "--cc"} {
7339 # start of a new file in a merge diff
7340 set fname [string range $line 10 end]
7341 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7342 lappend treediffs($ids) $fname
7343 add_flist [list $fname]
7347 set line [string range $line 11 end]
7348 # If the name hasn't changed the length will be odd,
7349 # the middle char will be a space, and the two bits either
7350 # side will be a/name and b/name, or "a/name" and "b/name".
7351 # If the name has changed we'll get "rename from" and
7352 # "rename to" or "copy from" and "copy to" lines following
7353 # this, and we'll use them to get the filenames.
7354 # This complexity is necessary because spaces in the
7355 # filename(s) don't get escaped.
7356 set l [string length $line]
7357 set i [expr {$l / 2}]
7358 if {!(($l & 1) && [string index $line $i] eq " " &&
7359 [string range $line 2 [expr {$i - 1}]] eq \
7360 [string range $line [expr {$i + 3}] end])} {
7363 # unescape if quoted and chop off the a/ from the front
7364 if {[string index $line 0] eq "\""} {
7365 set fname [string range [lindex $line 0] 2 end]
7367 set fname [string range $line 2 [expr {$i - 1}]]
7370 makediffhdr $fname $ids
7372 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7373 set fname [encoding convertfrom [string range $line 16 end]]
7374 $ctext insert end "\n"
7375 set curdiffstart [$ctext index "end - 1c"]
7376 lappend ctext_file_names $fname
7377 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7378 $ctext insert end "$line\n" filesep
7379 set i [lsearch -exact $treediffs($ids) $fname]
7381 setinlist difffilestart $i $curdiffstart
7384 } elseif {![string compare -length 2 "@@" $line]} {
7385 regexp {^@@+} $line ats
7386 set line [encoding convertfrom $diffencoding $line]
7387 $ctext insert end "$line\n" hunksep
7388 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7391 set diffnparents [expr {[string length $ats] - 1}]
7394 } elseif {$diffinhdr} {
7395 if {![string compare -length 12 "rename from " $line]} {
7396 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7397 if {[string index $fname 0] eq "\""} {
7398 set fname [lindex $fname 0]
7400 set fname [encoding convertfrom $fname]
7401 set i [lsearch -exact $treediffs($ids) $fname]
7403 setinlist difffilestart $i $curdiffstart
7405 } elseif {![string compare -length 10 $line "rename to "] ||
7406 ![string compare -length 8 $line "copy to "]} {
7407 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7408 if {[string index $fname 0] eq "\""} {
7409 set fname [lindex $fname 0]
7411 makediffhdr $fname $ids
7412 } elseif {[string compare -length 3 $line "---"] == 0} {
7415 } elseif {[string compare -length 3 $line "+++"] == 0} {
7419 $ctext insert end "$line\n" filesep
7422 set line [string map {\x1A ^Z} \
7423 [encoding convertfrom $diffencoding $line]]
7424 # parse the prefix - one ' ', '-' or '+' for each parent
7425 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7426 set tag [expr {$diffnparents > 1? "m": "d"}]
7427 if {[string trim $prefix " -+"] eq {}} {
7428 # prefix only has " ", "-" and "+" in it: normal diff line
7429 set num [string first "-" $prefix]
7431 # removed line, first parent with line is $num
7432 if {$num >= $mergemax} {
7435 $ctext insert end "$line\n" $tag$num
7438 if {[string first "+" $prefix] >= 0} {
7440 lappend tags ${tag}result
7441 if {$diffnparents > 1} {
7442 set num [string first " " $prefix]
7444 if {$num >= $mergemax} {
7451 if {$targetline ne {}} {
7452 if {$diffline == $targetline} {
7453 set seehere [$ctext index "end - 1 chars"]
7459 $ctext insert end "$line\n" $tags
7462 # "\ No newline at end of file",
7463 # or something else we don't recognize
7464 $ctext insert end "$line\n" hunksep
7468 if {[info exists seehere]} {
7469 mark_ctext_line [lindex [split $seehere .] 0]
7471 $ctext conf -state disabled
7476 return [expr {$nr >= 1000? 2: 1}]
7479 proc changediffdisp {} {
7480 global ctext diffelide
7482 $ctext tag conf d0 -elide [lindex $diffelide 0]
7483 $ctext tag conf dresult -elide [lindex $diffelide 1]
7486 proc highlightfile {loc cline} {
7487 global ctext cflist cflist_top
7490 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7491 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7492 $cflist see $cline.0
7493 set cflist_top $cline
7497 global difffilestart ctext cmitmode
7499 if {$cmitmode eq "tree"} return
7502 set here [$ctext index @0,0]
7503 foreach loc $difffilestart {
7504 if {[$ctext compare $loc >= $here]} {
7505 highlightfile $prev $prevline
7511 highlightfile $prev $prevline
7515 global difffilestart ctext cmitmode
7517 if {$cmitmode eq "tree"} return
7518 set here [$ctext index @0,0]
7520 foreach loc $difffilestart {
7522 if {[$ctext compare $loc > $here]} {
7523 highlightfile $loc $line
7529 proc clear_ctext {{first 1.0}} {
7530 global ctext smarktop smarkbot
7531 global ctext_file_names ctext_file_lines
7534 set l [lindex [split $first .] 0]
7535 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7538 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7541 $ctext delete $first end
7542 if {$first eq "1.0"} {
7543 catch {unset pendinglinks}
7545 set ctext_file_names {}
7546 set ctext_file_lines {}
7549 proc settabs {{firstab {}}} {
7550 global firsttabstop tabstop ctext have_tk85
7552 if {$firstab ne {} && $have_tk85} {
7553 set firsttabstop $firstab
7555 set w [font measure textfont "0"]
7556 if {$firsttabstop != 0} {
7557 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7558 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7559 } elseif {$have_tk85 || $tabstop != 8} {
7560 $ctext conf -tabs [expr {$tabstop * $w}]
7562 $ctext conf -tabs {}
7566 proc incrsearch {name ix op} {
7567 global ctext searchstring searchdirn
7569 $ctext tag remove found 1.0 end
7570 if {[catch {$ctext index anchor}]} {
7571 # no anchor set, use start of selection, or of visible area
7572 set sel [$ctext tag ranges sel]
7574 $ctext mark set anchor [lindex $sel 0]
7575 } elseif {$searchdirn eq "-forwards"} {
7576 $ctext mark set anchor @0,0
7578 $ctext mark set anchor @0,[winfo height $ctext]
7581 if {$searchstring ne {}} {
7582 set here [$ctext search $searchdirn -- $searchstring anchor]
7591 global sstring ctext searchstring searchdirn
7594 $sstring icursor end
7595 set searchdirn -forwards
7596 if {$searchstring ne {}} {
7597 set sel [$ctext tag ranges sel]
7599 set start "[lindex $sel 0] + 1c"
7600 } elseif {[catch {set start [$ctext index anchor]}]} {
7603 set match [$ctext search -count mlen -- $searchstring $start]
7604 $ctext tag remove sel 1.0 end
7610 set mend "$match + $mlen c"
7611 $ctext tag add sel $match $mend
7612 $ctext mark unset anchor
7616 proc dosearchback {} {
7617 global sstring ctext searchstring searchdirn
7620 $sstring icursor end
7621 set searchdirn -backwards
7622 if {$searchstring ne {}} {
7623 set sel [$ctext tag ranges sel]
7625 set start [lindex $sel 0]
7626 } elseif {[catch {set start [$ctext index anchor]}]} {
7627 set start @0,[winfo height $ctext]
7629 set match [$ctext search -backwards -count ml -- $searchstring $start]
7630 $ctext tag remove sel 1.0 end
7636 set mend "$match + $ml c"
7637 $ctext tag add sel $match $mend
7638 $ctext mark unset anchor
7642 proc searchmark {first last} {
7643 global ctext searchstring
7647 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7648 if {$match eq {}} break
7649 set mend "$match + $mlen c"
7650 $ctext tag add found $match $mend
7654 proc searchmarkvisible {doall} {
7655 global ctext smarktop smarkbot
7657 set topline [lindex [split [$ctext index @0,0] .] 0]
7658 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7659 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7660 # no overlap with previous
7661 searchmark $topline $botline
7662 set smarktop $topline
7663 set smarkbot $botline
7665 if {$topline < $smarktop} {
7666 searchmark $topline [expr {$smarktop-1}]
7667 set smarktop $topline
7669 if {$botline > $smarkbot} {
7670 searchmark [expr {$smarkbot+1}] $botline
7671 set smarkbot $botline
7676 proc scrolltext {f0 f1} {
7679 .bleft.bottom.sb set $f0 $f1
7680 if {$searchstring ne {}} {
7686 global linespc charspc canvx0 canvy0
7687 global xspc1 xspc2 lthickness
7689 set linespc [font metrics mainfont -linespace]
7690 set charspc [font measure mainfont "m"]
7691 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7692 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7693 set lthickness [expr {int($linespc / 9) + 1}]
7694 set xspc1(0) $linespc
7702 set ymax [lindex [$canv cget -scrollregion] 3]
7703 if {$ymax eq {} || $ymax == 0} return
7704 set span [$canv yview]
7707 allcanvs yview moveto [lindex $span 0]
7709 if {$selectedline ne {}} {
7710 selectline $selectedline 0
7711 allcanvs yview moveto [lindex $span 0]
7715 proc parsefont {f n} {
7718 set fontattr($f,family) [lindex $n 0]
7720 if {$s eq {} || $s == 0} {
7723 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7725 set fontattr($f,size) $s
7726 set fontattr($f,weight) normal
7727 set fontattr($f,slant) roman
7728 foreach style [lrange $n 2 end] {
7731 "bold" {set fontattr($f,weight) $style}
7733 "italic" {set fontattr($f,slant) $style}
7738 proc fontflags {f {isbold 0}} {
7741 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7742 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7743 -slant $fontattr($f,slant)]
7749 set n [list $fontattr($f,family) $fontattr($f,size)]
7750 if {$fontattr($f,weight) eq "bold"} {
7753 if {$fontattr($f,slant) eq "italic"} {
7759 proc incrfont {inc} {
7760 global mainfont textfont ctext canv cflist showrefstop
7761 global stopped entries fontattr
7764 set s $fontattr(mainfont,size)
7769 set fontattr(mainfont,size) $s
7770 font config mainfont -size $s
7771 font config mainfontbold -size $s
7772 set mainfont [fontname mainfont]
7773 set s $fontattr(textfont,size)
7778 set fontattr(textfont,size) $s
7779 font config textfont -size $s
7780 font config textfontbold -size $s
7781 set textfont [fontname textfont]
7788 global sha1entry sha1string
7789 if {[string length $sha1string] == 40} {
7790 $sha1entry delete 0 end
7794 proc sha1change {n1 n2 op} {
7795 global sha1string currentid sha1but
7796 if {$sha1string == {}
7797 || ([info exists currentid] && $sha1string == $currentid)} {
7802 if {[$sha1but cget -state] == $state} return
7803 if {$state == "normal"} {
7804 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7806 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7810 proc gotocommit {} {
7811 global sha1string tagids headids curview varcid
7813 if {$sha1string == {}
7814 || ([info exists currentid] && $sha1string == $currentid)} return
7815 if {[info exists tagids($sha1string)]} {
7816 set id $tagids($sha1string)
7817 } elseif {[info exists headids($sha1string)]} {
7818 set id $headids($sha1string)
7820 set id [string tolower $sha1string]
7821 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7822 set matches [longid $id]
7823 if {$matches ne {}} {
7824 if {[llength $matches] > 1} {
7825 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7828 set id [lindex $matches 0]
7832 if {[commitinview $id $curview]} {
7833 selectline [rowofcommit $id] 1
7836 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7837 set msg [mc "SHA1 id %s is not known" $sha1string]
7839 set msg [mc "Tag/Head %s is not known" $sha1string]
7844 proc lineenter {x y id} {
7845 global hoverx hovery hoverid hovertimer
7846 global commitinfo canv
7848 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7852 if {[info exists hovertimer]} {
7853 after cancel $hovertimer
7855 set hovertimer [after 500 linehover]
7859 proc linemotion {x y id} {
7860 global hoverx hovery hoverid hovertimer
7862 if {[info exists hoverid] && $id == $hoverid} {
7865 if {[info exists hovertimer]} {
7866 after cancel $hovertimer
7868 set hovertimer [after 500 linehover]
7872 proc lineleave {id} {
7873 global hoverid hovertimer canv
7875 if {[info exists hoverid] && $id == $hoverid} {
7877 if {[info exists hovertimer]} {
7878 after cancel $hovertimer
7886 global hoverx hovery hoverid hovertimer
7887 global canv linespc lthickness
7890 set text [lindex $commitinfo($hoverid) 0]
7891 set ymax [lindex [$canv cget -scrollregion] 3]
7892 if {$ymax == {}} return
7893 set yfrac [lindex [$canv yview] 0]
7894 set x [expr {$hoverx + 2 * $linespc}]
7895 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7896 set x0 [expr {$x - 2 * $lthickness}]
7897 set y0 [expr {$y - 2 * $lthickness}]
7898 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7899 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7900 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7901 -fill \#ffff80 -outline black -width 1 -tags hover]
7903 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7908 proc clickisonarrow {id y} {
7911 set ranges [rowranges $id]
7912 set thresh [expr {2 * $lthickness + 6}]
7913 set n [expr {[llength $ranges] - 1}]
7914 for {set i 1} {$i < $n} {incr i} {
7915 set row [lindex $ranges $i]
7916 if {abs([yc $row] - $y) < $thresh} {
7923 proc arrowjump {id n y} {
7926 # 1 <-> 2, 3 <-> 4, etc...
7927 set n [expr {(($n - 1) ^ 1) + 1}]
7928 set row [lindex [rowranges $id] $n]
7930 set ymax [lindex [$canv cget -scrollregion] 3]
7931 if {$ymax eq {} || $ymax <= 0} return
7932 set view [$canv yview]
7933 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7934 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7938 allcanvs yview moveto $yfrac
7941 proc lineclick {x y id isnew} {
7942 global ctext commitinfo children canv thickerline curview
7944 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7949 # draw this line thicker than normal
7953 set ymax [lindex [$canv cget -scrollregion] 3]
7954 if {$ymax eq {}} return
7955 set yfrac [lindex [$canv yview] 0]
7956 set y [expr {$y + $yfrac * $ymax}]
7958 set dirn [clickisonarrow $id $y]
7960 arrowjump $id $dirn $y
7965 addtohistory [list lineclick $x $y $id 0]
7967 # fill the details pane with info about this line
7968 $ctext conf -state normal
7971 $ctext insert end "[mc "Parent"]:\t"
7972 $ctext insert end $id link0
7974 set info $commitinfo($id)
7975 $ctext insert end "\n\t[lindex $info 0]\n"
7976 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7977 set date [formatdate [lindex $info 2]]
7978 $ctext insert end "\t[mc "Date"]:\t$date\n"
7979 set kids $children($curview,$id)
7981 $ctext insert end "\n[mc "Children"]:"
7983 foreach child $kids {
7985 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7986 set info $commitinfo($child)
7987 $ctext insert end "\n\t"
7988 $ctext insert end $child link$i
7989 setlink $child link$i
7990 $ctext insert end "\n\t[lindex $info 0]"
7991 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7992 set date [formatdate [lindex $info 2]]
7993 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7996 $ctext conf -state disabled
8000 proc normalline {} {
8002 if {[info exists thickerline]} {
8011 if {[commitinview $id $curview]} {
8012 selectline [rowofcommit $id] 1
8018 if {![info exists startmstime]} {
8019 set startmstime [clock clicks -milliseconds]
8021 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8024 proc rowmenu {x y id} {
8025 global rowctxmenu selectedline rowmenuid curview
8026 global nullid nullid2 fakerowmenu mainhead markedid
8030 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8035 if {$id ne $nullid && $id ne $nullid2} {
8036 set menu $rowctxmenu
8037 if {$mainhead ne {}} {
8038 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8040 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8042 if {[info exists markedid] && $markedid ne $id} {
8043 $menu entryconfigure 9 -state normal
8044 $menu entryconfigure 10 -state normal
8045 $menu entryconfigure 11 -state normal
8047 $menu entryconfigure 9 -state disabled
8048 $menu entryconfigure 10 -state disabled
8049 $menu entryconfigure 11 -state disabled
8052 set menu $fakerowmenu
8054 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8055 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8056 $menu entryconfigure [mca "Make patch"] -state $state
8057 tk_popup $menu $x $y
8061 global rowmenuid markedid canv
8063 set markedid $rowmenuid
8064 make_idmark $markedid
8070 if {[info exists markedid]} {
8075 proc replace_by_kids {l r} {
8076 global curview children
8078 set id [commitonrow $r]
8079 set l [lreplace $l 0 0]
8080 foreach kid $children($curview,$id) {
8081 lappend l [rowofcommit $kid]
8083 return [lsort -integer -decreasing -unique $l]
8086 proc find_common_desc {} {
8087 global markedid rowmenuid curview children
8089 if {![info exists markedid]} return
8090 if {![commitinview $markedid $curview] ||
8091 ![commitinview $rowmenuid $curview]} return
8092 #set t1 [clock clicks -milliseconds]
8093 set l1 [list [rowofcommit $markedid]]
8094 set l2 [list [rowofcommit $rowmenuid]]
8096 set r1 [lindex $l1 0]
8097 set r2 [lindex $l2 0]
8098 if {$r1 eq {} || $r2 eq {}} break
8104 set l1 [replace_by_kids $l1 $r1]
8106 set l2 [replace_by_kids $l2 $r2]
8109 #set t2 [clock clicks -milliseconds]
8110 #puts "took [expr {$t2-$t1}]ms"
8113 proc compare_commits {} {
8114 global markedid rowmenuid curview children
8116 if {![info exists markedid]} return
8117 if {![commitinview $markedid $curview]} return
8118 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8119 do_cmp_commits $markedid $rowmenuid
8122 proc getpatchid {id} {
8125 if {![info exists patchids($id)]} {
8126 set x [exec git diff-tree -p --root $id | git patch-id]
8127 set patchids($id) [lindex $x 0]
8129 return $patchids($id)
8132 proc do_cmp_commits {a b} {
8133 global ctext curview parents children patchids commitinfo
8135 $ctext conf -state normal
8138 for {set i 0} {$i < 100} {incr i} {
8139 set shorta [string range $a 0 7]
8140 set shortb [string range $b 0 7]
8143 if {[llength $parents($curview,$a)] > 1} {
8144 appendwithlinks [mc "Skipping merge commit %s\n" $shorta] {}
8147 set patcha [getpatchid $a]
8149 if {[llength $parents($curview,$b)] > 1} {
8150 appendwithlinks [mc "Skipping merge commit %s\n" $shortb] {}
8153 set patchb [getpatchid $b]
8155 if {!$skipa && !$skipb} {
8156 set heada [lindex $commitinfo($a) 0]
8157 set headb [lindex $commitinfo($b) 0]
8158 if {$patcha eq $patchb} {
8159 if {$heada eq $headb} {
8160 appendwithlinks [mc "Commit %s == %s %s\n" \
8161 $shorta $shortb $heada] {}
8163 appendwithlinks [mc "Commit %s %s\n" $shorta $heada] {}
8164 appendwithlinks [mc " is the same patch as\n"] {}
8165 appendwithlinks [mc " %s %s\n" $shortb $headb] {}
8170 $ctext insert end "\n"
8171 appendwithlinks [mc "Commit %s %s\n" $shorta $heada] {}
8172 appendwithlinks [mc " differs from\n"] {}
8173 appendwithlinks [mc " %s %s\n" $shortb $headb] {}
8174 appendwithlinks [mc "- stopping\n"]
8179 if {[llength $children($curview,$a)] != 1} {
8180 $ctext insert end "\n"
8181 appendwithlinks [mc "Commit %s has %s children - stopping\n" \
8182 $shorta [llength $children($curview,$a)]] {}
8185 set a [lindex $children($curview,$a) 0]
8188 if {[llength $children($curview,$b)] != 1} {
8189 appendwithlinks [mc "Commit %s has %s children - stopping\n" \
8190 $shortb [llength $children($curview,$b)]] {}
8193 set b [lindex $children($curview,$b) 0]
8196 $ctext conf -state disabled
8199 proc diffvssel {dirn} {
8200 global rowmenuid selectedline
8202 if {$selectedline eq {}} return
8204 set oldid [commitonrow $selectedline]
8205 set newid $rowmenuid
8207 set oldid $rowmenuid
8208 set newid [commitonrow $selectedline]
8210 addtohistory [list doseldiff $oldid $newid]
8211 doseldiff $oldid $newid
8214 proc doseldiff {oldid newid} {
8218 $ctext conf -state normal
8220 init_flist [mc "Top"]
8221 $ctext insert end "[mc "From"] "
8222 $ctext insert end $oldid link0
8223 setlink $oldid link0
8224 $ctext insert end "\n "
8225 $ctext insert end [lindex $commitinfo($oldid) 0]
8226 $ctext insert end "\n\n[mc "To"] "
8227 $ctext insert end $newid link1
8228 setlink $newid link1
8229 $ctext insert end "\n "
8230 $ctext insert end [lindex $commitinfo($newid) 0]
8231 $ctext insert end "\n"
8232 $ctext conf -state disabled
8233 $ctext tag remove found 1.0 end
8234 startdiff [list $oldid $newid]
8238 global rowmenuid currentid commitinfo patchtop patchnum
8240 if {![info exists currentid]} return
8241 set oldid $currentid
8242 set oldhead [lindex $commitinfo($oldid) 0]
8243 set newid $rowmenuid
8244 set newhead [lindex $commitinfo($newid) 0]
8247 catch {destroy $top}
8249 make_transient $top .
8250 label $top.title -text [mc "Generate patch"]
8251 grid $top.title - -pady 10
8252 label $top.from -text [mc "From:"]
8253 entry $top.fromsha1 -width 40 -relief flat
8254 $top.fromsha1 insert 0 $oldid
8255 $top.fromsha1 conf -state readonly
8256 grid $top.from $top.fromsha1 -sticky w
8257 entry $top.fromhead -width 60 -relief flat
8258 $top.fromhead insert 0 $oldhead
8259 $top.fromhead conf -state readonly
8260 grid x $top.fromhead -sticky w
8261 label $top.to -text [mc "To:"]
8262 entry $top.tosha1 -width 40 -relief flat
8263 $top.tosha1 insert 0 $newid
8264 $top.tosha1 conf -state readonly
8265 grid $top.to $top.tosha1 -sticky w
8266 entry $top.tohead -width 60 -relief flat
8267 $top.tohead insert 0 $newhead
8268 $top.tohead conf -state readonly
8269 grid x $top.tohead -sticky w
8270 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
8271 grid $top.rev x -pady 10
8272 label $top.flab -text [mc "Output file:"]
8273 entry $top.fname -width 60
8274 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8276 grid $top.flab $top.fname -sticky w
8278 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8279 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8280 bind $top <Key-Return> mkpatchgo
8281 bind $top <Key-Escape> mkpatchcan
8282 grid $top.buts.gen $top.buts.can
8283 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8284 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8285 grid $top.buts - -pady 10 -sticky ew
8289 proc mkpatchrev {} {
8292 set oldid [$patchtop.fromsha1 get]
8293 set oldhead [$patchtop.fromhead get]
8294 set newid [$patchtop.tosha1 get]
8295 set newhead [$patchtop.tohead get]
8296 foreach e [list fromsha1 fromhead tosha1 tohead] \
8297 v [list $newid $newhead $oldid $oldhead] {
8298 $patchtop.$e conf -state normal
8299 $patchtop.$e delete 0 end
8300 $patchtop.$e insert 0 $v
8301 $patchtop.$e conf -state readonly
8306 global patchtop nullid nullid2
8308 set oldid [$patchtop.fromsha1 get]
8309 set newid [$patchtop.tosha1 get]
8310 set fname [$patchtop.fname get]
8311 set cmd [diffcmd [list $oldid $newid] -p]
8312 # trim off the initial "|"
8313 set cmd [lrange $cmd 1 end]
8314 lappend cmd >$fname &
8315 if {[catch {eval exec $cmd} err]} {
8316 error_popup "[mc "Error creating patch:"] $err" $patchtop
8318 catch {destroy $patchtop}
8322 proc mkpatchcan {} {
8325 catch {destroy $patchtop}
8330 global rowmenuid mktagtop commitinfo
8334 catch {destroy $top}
8336 make_transient $top .
8337 label $top.title -text [mc "Create tag"]
8338 grid $top.title - -pady 10
8339 label $top.id -text [mc "ID:"]
8340 entry $top.sha1 -width 40 -relief flat
8341 $top.sha1 insert 0 $rowmenuid
8342 $top.sha1 conf -state readonly
8343 grid $top.id $top.sha1 -sticky w
8344 entry $top.head -width 60 -relief flat
8345 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8346 $top.head conf -state readonly
8347 grid x $top.head -sticky w
8348 label $top.tlab -text [mc "Tag name:"]
8349 entry $top.tag -width 60
8350 grid $top.tlab $top.tag -sticky w
8352 button $top.buts.gen -text [mc "Create"] -command mktaggo
8353 button $top.buts.can -text [mc "Cancel"] -command mktagcan
8354 bind $top <Key-Return> mktaggo
8355 bind $top <Key-Escape> mktagcan
8356 grid $top.buts.gen $top.buts.can
8357 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8358 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8359 grid $top.buts - -pady 10 -sticky ew
8364 global mktagtop env tagids idtags
8366 set id [$mktagtop.sha1 get]
8367 set tag [$mktagtop.tag get]
8369 error_popup [mc "No tag name specified"] $mktagtop
8372 if {[info exists tagids($tag)]} {
8373 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8377 exec git tag $tag $id
8379 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8383 set tagids($tag) $id
8384 lappend idtags($id) $tag
8392 proc redrawtags {id} {
8393 global canv linehtag idpos currentid curview cmitlisted markedid
8394 global canvxmax iddrawn circleitem mainheadid circlecolors
8396 if {![commitinview $id $curview]} return
8397 if {![info exists iddrawn($id)]} return
8398 set row [rowofcommit $id]
8399 if {$id eq $mainheadid} {
8402 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8404 $canv itemconf $circleitem($row) -fill $ofill
8405 $canv delete tag.$id
8406 set xt [eval drawtags $id $idpos($id)]
8407 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8408 set text [$canv itemcget $linehtag($id) -text]
8409 set font [$canv itemcget $linehtag($id) -font]
8410 set xr [expr {$xt + [font measure $font $text]}]
8411 if {$xr > $canvxmax} {
8415 if {[info exists currentid] && $currentid == $id} {
8418 if {[info exists markedid] && $markedid eq $id} {
8426 catch {destroy $mktagtop}
8431 if {![domktag]} return
8435 proc writecommit {} {
8436 global rowmenuid wrcomtop commitinfo wrcomcmd
8438 set top .writecommit
8440 catch {destroy $top}
8442 make_transient $top .
8443 label $top.title -text [mc "Write commit to file"]
8444 grid $top.title - -pady 10
8445 label $top.id -text [mc "ID:"]
8446 entry $top.sha1 -width 40 -relief flat
8447 $top.sha1 insert 0 $rowmenuid
8448 $top.sha1 conf -state readonly
8449 grid $top.id $top.sha1 -sticky w
8450 entry $top.head -width 60 -relief flat
8451 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8452 $top.head conf -state readonly
8453 grid x $top.head -sticky w
8454 label $top.clab -text [mc "Command:"]
8455 entry $top.cmd -width 60 -textvariable wrcomcmd
8456 grid $top.clab $top.cmd -sticky w -pady 10
8457 label $top.flab -text [mc "Output file:"]
8458 entry $top.fname -width 60
8459 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8460 grid $top.flab $top.fname -sticky w
8462 button $top.buts.gen -text [mc "Write"] -command wrcomgo
8463 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8464 bind $top <Key-Return> wrcomgo
8465 bind $top <Key-Escape> wrcomcan
8466 grid $top.buts.gen $top.buts.can
8467 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8468 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8469 grid $top.buts - -pady 10 -sticky ew
8476 set id [$wrcomtop.sha1 get]
8477 set cmd "echo $id | [$wrcomtop.cmd get]"
8478 set fname [$wrcomtop.fname get]
8479 if {[catch {exec sh -c $cmd >$fname &} err]} {
8480 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8482 catch {destroy $wrcomtop}
8489 catch {destroy $wrcomtop}
8494 global rowmenuid mkbrtop
8497 catch {destroy $top}
8499 make_transient $top .
8500 label $top.title -text [mc "Create new branch"]
8501 grid $top.title - -pady 10
8502 label $top.id -text [mc "ID:"]
8503 entry $top.sha1 -width 40 -relief flat
8504 $top.sha1 insert 0 $rowmenuid
8505 $top.sha1 conf -state readonly
8506 grid $top.id $top.sha1 -sticky w
8507 label $top.nlab -text [mc "Name:"]
8508 entry $top.name -width 40
8509 grid $top.nlab $top.name -sticky w
8511 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8512 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8513 bind $top <Key-Return> [list mkbrgo $top]
8514 bind $top <Key-Escape> "catch {destroy $top}"
8515 grid $top.buts.go $top.buts.can
8516 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8517 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8518 grid $top.buts - -pady 10 -sticky ew
8523 global headids idheads
8525 set name [$top.name get]
8526 set id [$top.sha1 get]
8530 error_popup [mc "Please specify a name for the new branch"] $top
8533 if {[info exists headids($name)]} {
8534 if {![confirm_popup [mc \
8535 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8538 set old_id $headids($name)
8541 catch {destroy $top}
8542 lappend cmdargs $name $id
8546 eval exec git branch $cmdargs
8552 if {$old_id ne {}} {
8558 set headids($name) $id
8559 lappend idheads($id) $name
8568 proc exec_citool {tool_args {baseid {}}} {
8569 global commitinfo env
8571 set save_env [array get env GIT_AUTHOR_*]
8573 if {$baseid ne {}} {
8574 if {![info exists commitinfo($baseid)]} {
8577 set author [lindex $commitinfo($baseid) 1]
8578 set date [lindex $commitinfo($baseid) 2]
8579 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8580 $author author name email]
8582 set env(GIT_AUTHOR_NAME) $name
8583 set env(GIT_AUTHOR_EMAIL) $email
8584 set env(GIT_AUTHOR_DATE) $date
8588 eval exec git citool $tool_args &
8590 array unset env GIT_AUTHOR_*
8591 array set env $save_env
8594 proc cherrypick {} {
8595 global rowmenuid curview
8596 global mainhead mainheadid
8598 set oldhead [exec git rev-parse HEAD]
8599 set dheads [descheads $rowmenuid]
8600 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8601 set ok [confirm_popup [mc "Commit %s is already\
8602 included in branch %s -- really re-apply it?" \
8603 [string range $rowmenuid 0 7] $mainhead]]
8606 nowbusy cherrypick [mc "Cherry-picking"]
8608 # Unfortunately git-cherry-pick writes stuff to stderr even when
8609 # no error occurs, and exec takes that as an indication of error...
8610 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8613 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8615 error_popup [mc "Cherry-pick failed because of local changes\
8616 to file '%s'.\nPlease commit, reset or stash\
8617 your changes and try again." $fname]
8618 } elseif {[regexp -line \
8619 {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8621 if {[confirm_popup [mc "Cherry-pick failed because of merge\
8622 conflict.\nDo you wish to run git citool to\
8624 # Force citool to read MERGE_MSG
8625 file delete [file join [gitdir] "GITGUI_MSG"]
8626 exec_citool {} $rowmenuid
8634 set newhead [exec git rev-parse HEAD]
8635 if {$newhead eq $oldhead} {
8637 error_popup [mc "No changes committed"]
8640 addnewchild $newhead $oldhead
8641 if {[commitinview $oldhead $curview]} {
8642 # XXX this isn't right if we have a path limit...
8643 insertrow $newhead $oldhead $curview
8644 if {$mainhead ne {}} {
8645 movehead $newhead $mainhead
8646 movedhead $newhead $mainhead
8648 set mainheadid $newhead
8657 global mainhead rowmenuid confirm_ok resettype
8660 set w ".confirmreset"
8663 wm title $w [mc "Confirm reset"]
8664 message $w.m -text \
8665 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8666 -justify center -aspect 1000
8667 pack $w.m -side top -fill x -padx 20 -pady 20
8668 frame $w.f -relief sunken -border 2
8669 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8670 grid $w.f.rt -sticky w
8672 radiobutton $w.f.soft -value soft -variable resettype -justify left \
8673 -text [mc "Soft: Leave working tree and index untouched"]
8674 grid $w.f.soft -sticky w
8675 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8676 -text [mc "Mixed: Leave working tree untouched, reset index"]
8677 grid $w.f.mixed -sticky w
8678 radiobutton $w.f.hard -value hard -variable resettype -justify left \
8679 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8680 grid $w.f.hard -sticky w
8681 pack $w.f -side top -fill x
8682 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8683 pack $w.ok -side left -fill x -padx 20 -pady 20
8684 button $w.cancel -text [mc Cancel] -command "destroy $w"
8685 bind $w <Key-Escape> [list destroy $w]
8686 pack $w.cancel -side right -fill x -padx 20 -pady 20
8687 bind $w <Visibility> "grab $w; focus $w"
8689 if {!$confirm_ok} return
8690 if {[catch {set fd [open \
8691 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8695 filerun $fd [list readresetstat $fd]
8696 nowbusy reset [mc "Resetting"]
8701 proc readresetstat {fd} {
8702 global mainhead mainheadid showlocalchanges rprogcoord
8704 if {[gets $fd line] >= 0} {
8705 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8706 set rprogcoord [expr {1.0 * $m / $n}]
8714 if {[catch {close $fd} err]} {
8717 set oldhead $mainheadid
8718 set newhead [exec git rev-parse HEAD]
8719 if {$newhead ne $oldhead} {
8720 movehead $newhead $mainhead
8721 movedhead $newhead $mainhead
8722 set mainheadid $newhead
8726 if {$showlocalchanges} {
8732 # context menu for a head
8733 proc headmenu {x y id head} {
8734 global headmenuid headmenuhead headctxmenu mainhead
8738 set headmenuhead $head
8740 if {$head eq $mainhead} {
8743 $headctxmenu entryconfigure 0 -state $state
8744 $headctxmenu entryconfigure 1 -state $state
8745 tk_popup $headctxmenu $x $y
8749 global headmenuid headmenuhead headids
8750 global showlocalchanges
8752 # check the tree is clean first??
8753 nowbusy checkout [mc "Checking out"]
8757 set fd [open [list | git checkout $headmenuhead 2>@1] r]
8761 if {$showlocalchanges} {
8765 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8769 proc readcheckoutstat {fd newhead newheadid} {
8770 global mainhead mainheadid headids showlocalchanges progresscoords
8771 global viewmainheadid curview
8773 if {[gets $fd line] >= 0} {
8774 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8775 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8780 set progresscoords {0 0}
8783 if {[catch {close $fd} err]} {
8786 set oldmainid $mainheadid
8787 set mainhead $newhead
8788 set mainheadid $newheadid
8789 set viewmainheadid($curview) $newheadid
8790 redrawtags $oldmainid
8791 redrawtags $newheadid
8793 if {$showlocalchanges} {
8799 global headmenuid headmenuhead mainhead
8802 set head $headmenuhead
8804 # this check shouldn't be needed any more...
8805 if {$head eq $mainhead} {
8806 error_popup [mc "Cannot delete the currently checked-out branch"]
8809 set dheads [descheads $id]
8810 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8811 # the stuff on this branch isn't on any other branch
8812 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8813 branch.\nReally delete branch %s?" $head $head]]} return
8817 if {[catch {exec git branch -D $head} err]} {
8822 removehead $id $head
8823 removedhead $id $head
8830 # Display a list of tags and heads
8832 global showrefstop bgcolor fgcolor selectbgcolor
8833 global bglist fglist reflistfilter reflist maincursor
8836 set showrefstop $top
8837 if {[winfo exists $top]} {
8843 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8844 make_transient $top .
8845 text $top.list -background $bgcolor -foreground $fgcolor \
8846 -selectbackground $selectbgcolor -font mainfont \
8847 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8848 -width 30 -height 20 -cursor $maincursor \
8849 -spacing1 1 -spacing3 1 -state disabled
8850 $top.list tag configure highlight -background $selectbgcolor
8851 lappend bglist $top.list
8852 lappend fglist $top.list
8853 scrollbar $top.ysb -command "$top.list yview" -orient vertical
8854 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8855 grid $top.list $top.ysb -sticky nsew
8856 grid $top.xsb x -sticky ew
8858 label $top.f.l -text "[mc "Filter"]: "
8859 entry $top.f.e -width 20 -textvariable reflistfilter
8860 set reflistfilter "*"
8861 trace add variable reflistfilter write reflistfilter_change
8862 pack $top.f.e -side right -fill x -expand 1
8863 pack $top.f.l -side left
8864 grid $top.f - -sticky ew -pady 2
8865 button $top.close -command [list destroy $top] -text [mc "Close"]
8866 bind $top <Key-Escape> [list destroy $top]
8868 grid columnconfigure $top 0 -weight 1
8869 grid rowconfigure $top 0 -weight 1
8870 bind $top.list <1> {break}
8871 bind $top.list <B1-Motion> {break}
8872 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8877 proc sel_reflist {w x y} {
8878 global showrefstop reflist headids tagids otherrefids
8880 if {![winfo exists $showrefstop]} return
8881 set l [lindex [split [$w index "@$x,$y"] "."] 0]
8882 set ref [lindex $reflist [expr {$l-1}]]
8883 set n [lindex $ref 0]
8884 switch -- [lindex $ref 1] {
8885 "H" {selbyid $headids($n)}
8886 "T" {selbyid $tagids($n)}
8887 "o" {selbyid $otherrefids($n)}
8889 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8892 proc unsel_reflist {} {
8895 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8896 $showrefstop.list tag remove highlight 0.0 end
8899 proc reflistfilter_change {n1 n2 op} {
8900 global reflistfilter
8902 after cancel refill_reflist
8903 after 200 refill_reflist
8906 proc refill_reflist {} {
8907 global reflist reflistfilter showrefstop headids tagids otherrefids
8910 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8912 foreach n [array names headids] {
8913 if {[string match $reflistfilter $n]} {
8914 if {[commitinview $headids($n) $curview]} {
8915 lappend refs [list $n H]
8917 interestedin $headids($n) {run refill_reflist}
8921 foreach n [array names tagids] {
8922 if {[string match $reflistfilter $n]} {
8923 if {[commitinview $tagids($n) $curview]} {
8924 lappend refs [list $n T]
8926 interestedin $tagids($n) {run refill_reflist}
8930 foreach n [array names otherrefids] {
8931 if {[string match $reflistfilter $n]} {
8932 if {[commitinview $otherrefids($n) $curview]} {
8933 lappend refs [list $n o]
8935 interestedin $otherrefids($n) {run refill_reflist}
8939 set refs [lsort -index 0 $refs]
8940 if {$refs eq $reflist} return
8942 # Update the contents of $showrefstop.list according to the
8943 # differences between $reflist (old) and $refs (new)
8944 $showrefstop.list conf -state normal
8945 $showrefstop.list insert end "\n"
8948 while {$i < [llength $reflist] || $j < [llength $refs]} {
8949 if {$i < [llength $reflist]} {
8950 if {$j < [llength $refs]} {
8951 set cmp [string compare [lindex $reflist $i 0] \
8952 [lindex $refs $j 0]]
8954 set cmp [string compare [lindex $reflist $i 1] \
8955 [lindex $refs $j 1]]
8965 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8973 set l [expr {$j + 1}]
8974 $showrefstop.list image create $l.0 -align baseline \
8975 -image reficon-[lindex $refs $j 1] -padx 2
8976 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8982 # delete last newline
8983 $showrefstop.list delete end-2c end-1c
8984 $showrefstop.list conf -state disabled
8987 # Stuff for finding nearby tags
8988 proc getallcommits {} {
8989 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8990 global idheads idtags idotherrefs allparents tagobjid
8992 if {![info exists allcommits]} {
8998 set allccache [file join [gitdir] "gitk.cache"]
9000 set f [open $allccache r]
9009 set cmd [list | git rev-list --parents]
9010 set allcupdate [expr {$seeds ne {}}]
9014 set refs [concat [array names idheads] [array names idtags] \
9015 [array names idotherrefs]]
9018 foreach name [array names tagobjid] {
9019 lappend tagobjs $tagobjid($name)
9021 foreach id [lsort -unique $refs] {
9022 if {![info exists allparents($id)] &&
9023 [lsearch -exact $tagobjs $id] < 0} {
9034 set fd [open [concat $cmd $ids] r]
9035 fconfigure $fd -blocking 0
9038 filerun $fd [list getallclines $fd]
9044 # Since most commits have 1 parent and 1 child, we group strings of
9045 # such commits into "arcs" joining branch/merge points (BMPs), which
9046 # are commits that either don't have 1 parent or don't have 1 child.
9048 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9049 # arcout(id) - outgoing arcs for BMP
9050 # arcids(a) - list of IDs on arc including end but not start
9051 # arcstart(a) - BMP ID at start of arc
9052 # arcend(a) - BMP ID at end of arc
9053 # growing(a) - arc a is still growing
9054 # arctags(a) - IDs out of arcids (excluding end) that have tags
9055 # archeads(a) - IDs out of arcids (excluding end) that have heads
9056 # The start of an arc is at the descendent end, so "incoming" means
9057 # coming from descendents, and "outgoing" means going towards ancestors.
9059 proc getallclines {fd} {
9060 global allparents allchildren idtags idheads nextarc
9061 global arcnos arcids arctags arcout arcend arcstart archeads growing
9062 global seeds allcommits cachedarcs allcupdate
9065 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9066 set id [lindex $line 0]
9067 if {[info exists allparents($id)]} {
9072 set olds [lrange $line 1 end]
9073 set allparents($id) $olds
9074 if {![info exists allchildren($id)]} {
9075 set allchildren($id) {}
9080 if {[llength $olds] == 1 && [llength $a] == 1} {
9081 lappend arcids($a) $id
9082 if {[info exists idtags($id)]} {
9083 lappend arctags($a) $id
9085 if {[info exists idheads($id)]} {
9086 lappend archeads($a) $id
9088 if {[info exists allparents($olds)]} {
9089 # seen parent already
9090 if {![info exists arcout($olds)]} {
9093 lappend arcids($a) $olds
9094 set arcend($a) $olds
9097 lappend allchildren($olds) $id
9098 lappend arcnos($olds) $a
9102 foreach a $arcnos($id) {
9103 lappend arcids($a) $id
9110 lappend allchildren($p) $id
9111 set a [incr nextarc]
9112 set arcstart($a) $id
9119 if {[info exists allparents($p)]} {
9120 # seen it already, may need to make a new branch
9121 if {![info exists arcout($p)]} {
9124 lappend arcids($a) $p
9128 lappend arcnos($p) $a
9133 global cached_dheads cached_dtags cached_atags
9134 catch {unset cached_dheads}
9135 catch {unset cached_dtags}
9136 catch {unset cached_atags}
9139 return [expr {$nid >= 1000? 2: 1}]
9143 fconfigure $fd -blocking 1
9146 # got an error reading the list of commits
9147 # if we were updating, try rereading the whole thing again
9153 error_popup "[mc "Error reading commit topology information;\
9154 branch and preceding/following tag information\
9155 will be incomplete."]\n($err)"
9158 if {[incr allcommits -1] == 0} {
9168 proc recalcarc {a} {
9169 global arctags archeads arcids idtags idheads
9173 foreach id [lrange $arcids($a) 0 end-1] {
9174 if {[info exists idtags($id)]} {
9177 if {[info exists idheads($id)]} {
9182 set archeads($a) $ah
9186 global arcnos arcids nextarc arctags archeads idtags idheads
9187 global arcstart arcend arcout allparents growing
9190 if {[llength $a] != 1} {
9191 puts "oops splitarc called but [llength $a] arcs already"
9195 set i [lsearch -exact $arcids($a) $p]
9197 puts "oops splitarc $p not in arc $a"
9200 set na [incr nextarc]
9201 if {[info exists arcend($a)]} {
9202 set arcend($na) $arcend($a)
9204 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9205 set j [lsearch -exact $arcnos($l) $a]
9206 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9208 set tail [lrange $arcids($a) [expr {$i+1}] end]
9209 set arcids($a) [lrange $arcids($a) 0 $i]
9211 set arcstart($na) $p
9213 set arcids($na) $tail
9214 if {[info exists growing($a)]} {
9220 if {[llength $arcnos($id)] == 1} {
9223 set j [lsearch -exact $arcnos($id) $a]
9224 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9228 # reconstruct tags and heads lists
9229 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9234 set archeads($na) {}
9238 # Update things for a new commit added that is a child of one
9239 # existing commit. Used when cherry-picking.
9240 proc addnewchild {id p} {
9241 global allparents allchildren idtags nextarc
9242 global arcnos arcids arctags arcout arcend arcstart archeads growing
9243 global seeds allcommits
9245 if {![info exists allcommits] || ![info exists arcnos($p)]} return
9246 set allparents($id) [list $p]
9247 set allchildren($id) {}
9250 lappend allchildren($p) $id
9251 set a [incr nextarc]
9252 set arcstart($a) $id
9255 set arcids($a) [list $p]
9257 if {![info exists arcout($p)]} {
9260 lappend arcnos($p) $a
9261 set arcout($id) [list $a]
9264 # This implements a cache for the topology information.
9265 # The cache saves, for each arc, the start and end of the arc,
9266 # the ids on the arc, and the outgoing arcs from the end.
9267 proc readcache {f} {
9268 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9269 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9274 if {$lim - $a > 500} {
9275 set lim [expr {$a + 500}]
9279 # finish reading the cache and setting up arctags, etc.
9281 if {$line ne "1"} {error "bad final version"}
9283 foreach id [array names idtags] {
9284 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9285 [llength $allparents($id)] == 1} {
9286 set a [lindex $arcnos($id) 0]
9287 if {$arctags($a) eq {}} {
9292 foreach id [array names idheads] {
9293 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9294 [llength $allparents($id)] == 1} {
9295 set a [lindex $arcnos($id) 0]
9296 if {$archeads($a) eq {}} {
9301 foreach id [lsort -unique $possible_seeds] {
9302 if {$arcnos($id) eq {}} {
9308 while {[incr a] <= $lim} {
9310 if {[llength $line] != 3} {error "bad line"}
9311 set s [lindex $line 0]
9313 lappend arcout($s) $a
9314 if {![info exists arcnos($s)]} {
9315 lappend possible_seeds $s
9318 set e [lindex $line 1]
9323 if {![info exists arcout($e)]} {
9327 set arcids($a) [lindex $line 2]
9328 foreach id $arcids($a) {
9329 lappend allparents($s) $id
9331 lappend arcnos($id) $a
9333 if {![info exists allparents($s)]} {
9334 set allparents($s) {}
9339 set nextarc [expr {$a - 1}]
9352 global nextarc cachedarcs possible_seeds
9356 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9357 # make sure it's an integer
9358 set cachedarcs [expr {int([lindex $line 1])}]
9359 if {$cachedarcs < 0} {error "bad number of arcs"}
9361 set possible_seeds {}
9369 proc dropcache {err} {
9370 global allcwait nextarc cachedarcs seeds
9372 #puts "dropping cache ($err)"
9373 foreach v {arcnos arcout arcids arcstart arcend growing \
9374 arctags archeads allparents allchildren} {
9385 proc writecache {f} {
9386 global cachearc cachedarcs allccache
9387 global arcstart arcend arcnos arcids arcout
9391 if {$lim - $a > 1000} {
9392 set lim [expr {$a + 1000}]
9395 while {[incr a] <= $lim} {
9396 if {[info exists arcend($a)]} {
9397 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9399 puts $f [list $arcstart($a) {} $arcids($a)]
9404 catch {file delete $allccache}
9405 #puts "writing cache failed ($err)"
9408 set cachearc [expr {$a - 1}]
9409 if {$a > $cachedarcs} {
9418 global nextarc cachedarcs cachearc allccache
9420 if {$nextarc == $cachedarcs} return
9422 set cachedarcs $nextarc
9424 set f [open $allccache w]
9425 puts $f [list 1 $cachedarcs]
9430 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9431 # or 0 if neither is true.
9432 proc anc_or_desc {a b} {
9433 global arcout arcstart arcend arcnos cached_isanc
9435 if {$arcnos($a) eq $arcnos($b)} {
9436 # Both are on the same arc(s); either both are the same BMP,
9437 # or if one is not a BMP, the other is also not a BMP or is
9438 # the BMP at end of the arc (and it only has 1 incoming arc).
9439 # Or both can be BMPs with no incoming arcs.
9440 if {$a eq $b || $arcnos($a) eq {}} {
9443 # assert {[llength $arcnos($a)] == 1}
9444 set arc [lindex $arcnos($a) 0]
9445 set i [lsearch -exact $arcids($arc) $a]
9446 set j [lsearch -exact $arcids($arc) $b]
9447 if {$i < 0 || $i > $j} {
9454 if {![info exists arcout($a)]} {
9455 set arc [lindex $arcnos($a) 0]
9456 if {[info exists arcend($arc)]} {
9457 set aend $arcend($arc)
9461 set a $arcstart($arc)
9465 if {![info exists arcout($b)]} {
9466 set arc [lindex $arcnos($b) 0]
9467 if {[info exists arcend($arc)]} {
9468 set bend $arcend($arc)
9472 set b $arcstart($arc)
9482 if {[info exists cached_isanc($a,$bend)]} {
9483 if {$cached_isanc($a,$bend)} {
9487 if {[info exists cached_isanc($b,$aend)]} {
9488 if {$cached_isanc($b,$aend)} {
9491 if {[info exists cached_isanc($a,$bend)]} {
9496 set todo [list $a $b]
9499 for {set i 0} {$i < [llength $todo]} {incr i} {
9500 set x [lindex $todo $i]
9501 if {$anc($x) eq {}} {
9504 foreach arc $arcnos($x) {
9505 set xd $arcstart($arc)
9507 set cached_isanc($a,$bend) 1
9508 set cached_isanc($b,$aend) 0
9510 } elseif {$xd eq $aend} {
9511 set cached_isanc($b,$aend) 1
9512 set cached_isanc($a,$bend) 0
9515 if {![info exists anc($xd)]} {
9516 set anc($xd) $anc($x)
9518 } elseif {$anc($xd) ne $anc($x)} {
9523 set cached_isanc($a,$bend) 0
9524 set cached_isanc($b,$aend) 0
9528 # This identifies whether $desc has an ancestor that is
9529 # a growing tip of the graph and which is not an ancestor of $anc
9530 # and returns 0 if so and 1 if not.
9531 # If we subsequently discover a tag on such a growing tip, and that
9532 # turns out to be a descendent of $anc (which it could, since we
9533 # don't necessarily see children before parents), then $desc
9534 # isn't a good choice to display as a descendent tag of
9535 # $anc (since it is the descendent of another tag which is
9536 # a descendent of $anc). Similarly, $anc isn't a good choice to
9537 # display as a ancestor tag of $desc.
9539 proc is_certain {desc anc} {
9540 global arcnos arcout arcstart arcend growing problems
9543 if {[llength $arcnos($anc)] == 1} {
9544 # tags on the same arc are certain
9545 if {$arcnos($desc) eq $arcnos($anc)} {
9548 if {![info exists arcout($anc)]} {
9549 # if $anc is partway along an arc, use the start of the arc instead
9550 set a [lindex $arcnos($anc) 0]
9551 set anc $arcstart($a)
9554 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9557 set a [lindex $arcnos($desc) 0]
9563 set anclist [list $x]
9567 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9568 set x [lindex $anclist $i]
9573 foreach a $arcout($x) {
9574 if {[info exists growing($a)]} {
9575 if {![info exists growanc($x)] && $dl($x)} {
9581 if {[info exists dl($y)]} {
9585 if {![info exists done($y)]} {
9588 if {[info exists growanc($x)]} {
9592 for {set k 0} {$k < [llength $xl]} {incr k} {
9593 set z [lindex $xl $k]
9594 foreach c $arcout($z) {
9595 if {[info exists arcend($c)]} {
9597 if {[info exists dl($v)] && $dl($v)} {
9599 if {![info exists done($v)]} {
9602 if {[info exists growanc($v)]} {
9612 } elseif {$y eq $anc || !$dl($x)} {
9623 foreach x [array names growanc] {
9632 proc validate_arctags {a} {
9633 global arctags idtags
9637 foreach id $arctags($a) {
9639 if {![info exists idtags($id)]} {
9640 set na [lreplace $na $i $i]
9647 proc validate_archeads {a} {
9648 global archeads idheads
9651 set na $archeads($a)
9652 foreach id $archeads($a) {
9654 if {![info exists idheads($id)]} {
9655 set na [lreplace $na $i $i]
9659 set archeads($a) $na
9662 # Return the list of IDs that have tags that are descendents of id,
9663 # ignoring IDs that are descendents of IDs already reported.
9664 proc desctags {id} {
9665 global arcnos arcstart arcids arctags idtags allparents
9666 global growing cached_dtags
9668 if {![info exists allparents($id)]} {
9671 set t1 [clock clicks -milliseconds]
9673 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9674 # part-way along an arc; check that arc first
9675 set a [lindex $arcnos($id) 0]
9676 if {$arctags($a) ne {}} {
9678 set i [lsearch -exact $arcids($a) $id]
9680 foreach t $arctags($a) {
9681 set j [lsearch -exact $arcids($a) $t]
9689 set id $arcstart($a)
9690 if {[info exists idtags($id)]} {
9694 if {[info exists cached_dtags($id)]} {
9695 return $cached_dtags($id)
9702 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9703 set id [lindex $todo $i]
9705 set ta [info exists hastaggedancestor($id)]
9709 # ignore tags on starting node
9710 if {!$ta && $i > 0} {
9711 if {[info exists idtags($id)]} {
9714 } elseif {[info exists cached_dtags($id)]} {
9715 set tagloc($id) $cached_dtags($id)
9719 foreach a $arcnos($id) {
9721 if {!$ta && $arctags($a) ne {}} {
9723 if {$arctags($a) ne {}} {
9724 lappend tagloc($id) [lindex $arctags($a) end]
9727 if {$ta || $arctags($a) ne {}} {
9728 set tomark [list $d]
9729 for {set j 0} {$j < [llength $tomark]} {incr j} {
9730 set dd [lindex $tomark $j]
9731 if {![info exists hastaggedancestor($dd)]} {
9732 if {[info exists done($dd)]} {
9733 foreach b $arcnos($dd) {
9734 lappend tomark $arcstart($b)
9736 if {[info exists tagloc($dd)]} {
9739 } elseif {[info exists queued($dd)]} {
9742 set hastaggedancestor($dd) 1
9746 if {![info exists queued($d)]} {
9749 if {![info exists hastaggedancestor($d)]} {
9756 foreach id [array names tagloc] {
9757 if {![info exists hastaggedancestor($id)]} {
9758 foreach t $tagloc($id) {
9759 if {[lsearch -exact $tags $t] < 0} {
9765 set t2 [clock clicks -milliseconds]
9768 # remove tags that are descendents of other tags
9769 for {set i 0} {$i < [llength $tags]} {incr i} {
9770 set a [lindex $tags $i]
9771 for {set j 0} {$j < $i} {incr j} {
9772 set b [lindex $tags $j]
9773 set r [anc_or_desc $a $b]
9775 set tags [lreplace $tags $j $j]
9778 } elseif {$r == -1} {
9779 set tags [lreplace $tags $i $i]
9786 if {[array names growing] ne {}} {
9787 # graph isn't finished, need to check if any tag could get
9788 # eclipsed by another tag coming later. Simply ignore any
9789 # tags that could later get eclipsed.
9792 if {[is_certain $t $origid]} {
9796 if {$tags eq $ctags} {
9797 set cached_dtags($origid) $tags
9802 set cached_dtags($origid) $tags
9804 set t3 [clock clicks -milliseconds]
9805 if {0 && $t3 - $t1 >= 100} {
9806 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9807 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9813 global arcnos arcids arcout arcend arctags idtags allparents
9814 global growing cached_atags
9816 if {![info exists allparents($id)]} {
9819 set t1 [clock clicks -milliseconds]
9821 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9822 # part-way along an arc; check that arc first
9823 set a [lindex $arcnos($id) 0]
9824 if {$arctags($a) ne {}} {
9826 set i [lsearch -exact $arcids($a) $id]
9827 foreach t $arctags($a) {
9828 set j [lsearch -exact $arcids($a) $t]
9834 if {![info exists arcend($a)]} {
9838 if {[info exists idtags($id)]} {
9842 if {[info exists cached_atags($id)]} {
9843 return $cached_atags($id)
9851 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9852 set id [lindex $todo $i]
9854 set td [info exists hastaggeddescendent($id)]
9858 # ignore tags on starting node
9859 if {!$td && $i > 0} {
9860 if {[info exists idtags($id)]} {
9863 } elseif {[info exists cached_atags($id)]} {
9864 set tagloc($id) $cached_atags($id)
9868 foreach a $arcout($id) {
9869 if {!$td && $arctags($a) ne {}} {
9871 if {$arctags($a) ne {}} {
9872 lappend tagloc($id) [lindex $arctags($a) 0]
9875 if {![info exists arcend($a)]} continue
9877 if {$td || $arctags($a) ne {}} {
9878 set tomark [list $d]
9879 for {set j 0} {$j < [llength $tomark]} {incr j} {
9880 set dd [lindex $tomark $j]
9881 if {![info exists hastaggeddescendent($dd)]} {
9882 if {[info exists done($dd)]} {
9883 foreach b $arcout($dd) {
9884 if {[info exists arcend($b)]} {
9885 lappend tomark $arcend($b)
9888 if {[info exists tagloc($dd)]} {
9891 } elseif {[info exists queued($dd)]} {
9894 set hastaggeddescendent($dd) 1
9898 if {![info exists queued($d)]} {
9901 if {![info exists hastaggeddescendent($d)]} {
9907 set t2 [clock clicks -milliseconds]
9910 foreach id [array names tagloc] {
9911 if {![info exists hastaggeddescendent($id)]} {
9912 foreach t $tagloc($id) {
9913 if {[lsearch -exact $tags $t] < 0} {
9920 # remove tags that are ancestors of other tags
9921 for {set i 0} {$i < [llength $tags]} {incr i} {
9922 set a [lindex $tags $i]
9923 for {set j 0} {$j < $i} {incr j} {
9924 set b [lindex $tags $j]
9925 set r [anc_or_desc $a $b]
9927 set tags [lreplace $tags $j $j]
9930 } elseif {$r == 1} {
9931 set tags [lreplace $tags $i $i]
9938 if {[array names growing] ne {}} {
9939 # graph isn't finished, need to check if any tag could get
9940 # eclipsed by another tag coming later. Simply ignore any
9941 # tags that could later get eclipsed.
9944 if {[is_certain $origid $t]} {
9948 if {$tags eq $ctags} {
9949 set cached_atags($origid) $tags
9954 set cached_atags($origid) $tags
9956 set t3 [clock clicks -milliseconds]
9957 if {0 && $t3 - $t1 >= 100} {
9958 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9959 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9964 # Return the list of IDs that have heads that are descendents of id,
9965 # including id itself if it has a head.
9966 proc descheads {id} {
9967 global arcnos arcstart arcids archeads idheads cached_dheads
9970 if {![info exists allparents($id)]} {
9974 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9975 # part-way along an arc; check it first
9976 set a [lindex $arcnos($id) 0]
9977 if {$archeads($a) ne {}} {
9978 validate_archeads $a
9979 set i [lsearch -exact $arcids($a) $id]
9980 foreach t $archeads($a) {
9981 set j [lsearch -exact $arcids($a) $t]
9986 set id $arcstart($a)
9992 for {set i 0} {$i < [llength $todo]} {incr i} {
9993 set id [lindex $todo $i]
9994 if {[info exists cached_dheads($id)]} {
9995 set ret [concat $ret $cached_dheads($id)]
9997 if {[info exists idheads($id)]} {
10000 foreach a $arcnos($id) {
10001 if {$archeads($a) ne {}} {
10002 validate_archeads $a
10003 if {$archeads($a) ne {}} {
10004 set ret [concat $ret $archeads($a)]
10007 set d $arcstart($a)
10008 if {![info exists seen($d)]} {
10015 set ret [lsort -unique $ret]
10016 set cached_dheads($origid) $ret
10017 return [concat $ret $aret]
10020 proc addedtag {id} {
10021 global arcnos arcout cached_dtags cached_atags
10023 if {![info exists arcnos($id)]} return
10024 if {![info exists arcout($id)]} {
10025 recalcarc [lindex $arcnos($id) 0]
10027 catch {unset cached_dtags}
10028 catch {unset cached_atags}
10031 proc addedhead {hid head} {
10032 global arcnos arcout cached_dheads
10034 if {![info exists arcnos($hid)]} return
10035 if {![info exists arcout($hid)]} {
10036 recalcarc [lindex $arcnos($hid) 0]
10038 catch {unset cached_dheads}
10041 proc removedhead {hid head} {
10042 global cached_dheads
10044 catch {unset cached_dheads}
10047 proc movedhead {hid head} {
10048 global arcnos arcout cached_dheads
10050 if {![info exists arcnos($hid)]} return
10051 if {![info exists arcout($hid)]} {
10052 recalcarc [lindex $arcnos($hid) 0]
10054 catch {unset cached_dheads}
10057 proc changedrefs {} {
10058 global cached_dheads cached_dtags cached_atags
10059 global arctags archeads arcnos arcout idheads idtags
10061 foreach id [concat [array names idheads] [array names idtags]] {
10062 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10063 set a [lindex $arcnos($id) 0]
10064 if {![info exists donearc($a)]} {
10070 catch {unset cached_dtags}
10071 catch {unset cached_atags}
10072 catch {unset cached_dheads}
10075 proc rereadrefs {} {
10076 global idtags idheads idotherrefs mainheadid
10078 set refids [concat [array names idtags] \
10079 [array names idheads] [array names idotherrefs]]
10080 foreach id $refids {
10081 if {![info exists ref($id)]} {
10082 set ref($id) [listrefs $id]
10085 set oldmainhead $mainheadid
10088 set refids [lsort -unique [concat $refids [array names idtags] \
10089 [array names idheads] [array names idotherrefs]]]
10090 foreach id $refids {
10091 set v [listrefs $id]
10092 if {![info exists ref($id)] || $ref($id) != $v} {
10096 if {$oldmainhead ne $mainheadid} {
10097 redrawtags $oldmainhead
10098 redrawtags $mainheadid
10103 proc listrefs {id} {
10104 global idtags idheads idotherrefs
10107 if {[info exists idtags($id)]} {
10111 if {[info exists idheads($id)]} {
10112 set y $idheads($id)
10115 if {[info exists idotherrefs($id)]} {
10116 set z $idotherrefs($id)
10118 return [list $x $y $z]
10121 proc showtag {tag isnew} {
10122 global ctext tagcontents tagids linknum tagobjid
10125 addtohistory [list showtag $tag 0]
10127 $ctext conf -state normal
10131 if {![info exists tagcontents($tag)]} {
10133 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
10136 if {[info exists tagcontents($tag)]} {
10137 set text $tagcontents($tag)
10139 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
10141 appendwithlinks $text {}
10142 $ctext conf -state disabled
10154 if {[info exists gitktmpdir]} {
10155 catch {file delete -force $gitktmpdir}
10159 proc mkfontdisp {font top which} {
10160 global fontattr fontpref $font
10162 set fontpref($font) [set $font]
10163 button $top.${font}but -text $which -font optionfont \
10164 -command [list choosefont $font $which]
10165 label $top.$font -relief flat -font $font \
10166 -text $fontattr($font,family) -justify left
10167 grid x $top.${font}but $top.$font -sticky w
10170 proc choosefont {font which} {
10171 global fontparam fontlist fonttop fontattr
10174 set fontparam(which) $which
10175 set fontparam(font) $font
10176 set fontparam(family) [font actual $font -family]
10177 set fontparam(size) $fontattr($font,size)
10178 set fontparam(weight) $fontattr($font,weight)
10179 set fontparam(slant) $fontattr($font,slant)
10182 if {![winfo exists $top]} {
10184 eval font config sample [font actual $font]
10186 make_transient $top $prefstop
10187 wm title $top [mc "Gitk font chooser"]
10188 label $top.l -textvariable fontparam(which)
10189 pack $top.l -side top
10190 set fontlist [lsort [font families]]
10192 listbox $top.f.fam -listvariable fontlist \
10193 -yscrollcommand [list $top.f.sb set]
10194 bind $top.f.fam <<ListboxSelect>> selfontfam
10195 scrollbar $top.f.sb -command [list $top.f.fam yview]
10196 pack $top.f.sb -side right -fill y
10197 pack $top.f.fam -side left -fill both -expand 1
10198 pack $top.f -side top -fill both -expand 1
10200 spinbox $top.g.size -from 4 -to 40 -width 4 \
10201 -textvariable fontparam(size) \
10202 -validatecommand {string is integer -strict %s}
10203 checkbutton $top.g.bold -padx 5 \
10204 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10205 -variable fontparam(weight) -onvalue bold -offvalue normal
10206 checkbutton $top.g.ital -padx 5 \
10207 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
10208 -variable fontparam(slant) -onvalue italic -offvalue roman
10209 pack $top.g.size $top.g.bold $top.g.ital -side left
10210 pack $top.g -side top
10211 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10213 $top.c create text 100 25 -anchor center -text $which -font sample \
10214 -fill black -tags text
10215 bind $top.c <Configure> [list centertext $top.c]
10216 pack $top.c -side top -fill x
10218 button $top.buts.ok -text [mc "OK"] -command fontok -default active
10219 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10220 bind $top <Key-Return> fontok
10221 bind $top <Key-Escape> fontcan
10222 grid $top.buts.ok $top.buts.can
10223 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10224 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10225 pack $top.buts -side bottom -fill x
10226 trace add variable fontparam write chg_fontparam
10229 $top.c itemconf text -text $which
10231 set i [lsearch -exact $fontlist $fontparam(family)]
10233 $top.f.fam selection set $i
10238 proc centertext {w} {
10239 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10243 global fontparam fontpref prefstop
10245 set f $fontparam(font)
10246 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10247 if {$fontparam(weight) eq "bold"} {
10248 lappend fontpref($f) "bold"
10250 if {$fontparam(slant) eq "italic"} {
10251 lappend fontpref($f) "italic"
10254 $w conf -text $fontparam(family) -font $fontpref($f)
10260 global fonttop fontparam
10262 if {[info exists fonttop]} {
10263 catch {destroy $fonttop}
10264 catch {font delete sample}
10270 proc selfontfam {} {
10271 global fonttop fontparam
10273 set i [$fonttop.f.fam curselection]
10275 set fontparam(family) [$fonttop.f.fam get $i]
10279 proc chg_fontparam {v sub op} {
10282 font config sample -$sub $fontparam($sub)
10286 global maxwidth maxgraphpct
10287 global oldprefs prefstop showneartags showlocalchanges
10288 global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10289 global tabstop limitdiffs autoselect extdifftool perfile_attrs
10293 if {[winfo exists $top]} {
10297 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10298 limitdiffs tabstop perfile_attrs} {
10299 set oldprefs($v) [set $v]
10302 wm title $top [mc "Gitk preferences"]
10303 make_transient $top .
10304 label $top.ldisp -text [mc "Commit list display options"]
10305 grid $top.ldisp - -sticky w -pady 10
10306 label $top.spacer -text " "
10307 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10309 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10310 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10311 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10313 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10314 grid x $top.maxpctl $top.maxpct -sticky w
10315 checkbutton $top.showlocal -text [mc "Show local changes"] \
10316 -font optionfont -variable showlocalchanges
10317 grid x $top.showlocal -sticky w
10318 checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10319 -font optionfont -variable autoselect
10320 grid x $top.autoselect -sticky w
10322 label $top.ddisp -text [mc "Diff display options"]
10323 grid $top.ddisp - -sticky w -pady 10
10324 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10325 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10326 grid x $top.tabstopl $top.tabstop -sticky w
10327 checkbutton $top.ntag -text [mc "Display nearby tags"] \
10328 -font optionfont -variable showneartags
10329 grid x $top.ntag -sticky w
10330 checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10331 -font optionfont -variable limitdiffs
10332 grid x $top.ldiff -sticky w
10333 checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10334 -font optionfont -variable perfile_attrs
10335 grid x $top.lattr -sticky w
10337 entry $top.extdifft -textvariable extdifftool
10338 frame $top.extdifff
10339 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10341 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10342 -command choose_extdiff
10343 pack $top.extdifff.l $top.extdifff.b -side left
10344 grid x $top.extdifff $top.extdifft -sticky w
10346 label $top.cdisp -text [mc "Colors: press to choose"]
10347 grid $top.cdisp - -sticky w -pady 10
10348 label $top.bg -padx 40 -relief sunk -background $bgcolor
10349 button $top.bgbut -text [mc "Background"] -font optionfont \
10350 -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10351 grid x $top.bgbut $top.bg -sticky w
10352 label $top.fg -padx 40 -relief sunk -background $fgcolor
10353 button $top.fgbut -text [mc "Foreground"] -font optionfont \
10354 -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10355 grid x $top.fgbut $top.fg -sticky w
10356 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10357 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10358 -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10359 [list $ctext tag conf d0 -foreground]]
10360 grid x $top.diffoldbut $top.diffold -sticky w
10361 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10362 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10363 -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10364 [list $ctext tag conf dresult -foreground]]
10365 grid x $top.diffnewbut $top.diffnew -sticky w
10366 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10367 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10368 -command [list choosecolor diffcolors 2 $top.hunksep \
10369 [mc "diff hunk header"] \
10370 [list $ctext tag conf hunksep -foreground]]
10371 grid x $top.hunksepbut $top.hunksep -sticky w
10372 label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10373 button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10374 -command [list choosecolor markbgcolor {} $top.markbgsep \
10375 [mc "marked line background"] \
10376 [list $ctext tag conf omark -background]]
10377 grid x $top.markbgbut $top.markbgsep -sticky w
10378 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10379 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10380 -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10381 grid x $top.selbgbut $top.selbgsep -sticky w
10383 label $top.cfont -text [mc "Fonts: press to choose"]
10384 grid $top.cfont - -sticky w -pady 10
10385 mkfontdisp mainfont $top [mc "Main font"]
10386 mkfontdisp textfont $top [mc "Diff display font"]
10387 mkfontdisp uifont $top [mc "User interface font"]
10390 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10391 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10392 bind $top <Key-Return> prefsok
10393 bind $top <Key-Escape> prefscan
10394 grid $top.buts.ok $top.buts.can
10395 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10396 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10397 grid $top.buts - - -pady 10 -sticky ew
10398 bind $top <Visibility> "focus $top.buts.ok"
10401 proc choose_extdiff {} {
10404 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10406 set extdifftool $prog
10410 proc choosecolor {v vi w x cmd} {
10413 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10414 -title [mc "Gitk: choose color for %s" $x]]
10415 if {$c eq {}} return
10416 $w conf -background $c
10421 proc setselbg {c} {
10422 global bglist cflist
10423 foreach w $bglist {
10424 $w configure -selectbackground $c
10426 $cflist tag configure highlight \
10427 -background [$cflist cget -selectbackground]
10428 allcanvs itemconf secsel -fill $c
10434 foreach w $bglist {
10435 $w conf -background $c
10442 foreach w $fglist {
10443 $w conf -foreground $c
10445 allcanvs itemconf text -fill $c
10446 $canv itemconf circle -outline $c
10447 $canv itemconf markid -outline $c
10451 global oldprefs prefstop
10453 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10454 limitdiffs tabstop perfile_attrs} {
10456 set $v $oldprefs($v)
10458 catch {destroy $prefstop}
10464 global maxwidth maxgraphpct
10465 global oldprefs prefstop showneartags showlocalchanges
10466 global fontpref mainfont textfont uifont
10467 global limitdiffs treediffs perfile_attrs
10469 catch {destroy $prefstop}
10473 if {$mainfont ne $fontpref(mainfont)} {
10474 set mainfont $fontpref(mainfont)
10475 parsefont mainfont $mainfont
10476 eval font configure mainfont [fontflags mainfont]
10477 eval font configure mainfontbold [fontflags mainfont 1]
10481 if {$textfont ne $fontpref(textfont)} {
10482 set textfont $fontpref(textfont)
10483 parsefont textfont $textfont
10484 eval font configure textfont [fontflags textfont]
10485 eval font configure textfontbold [fontflags textfont 1]
10487 if {$uifont ne $fontpref(uifont)} {
10488 set uifont $fontpref(uifont)
10489 parsefont uifont $uifont
10490 eval font configure uifont [fontflags uifont]
10493 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10494 if {$showlocalchanges} {
10500 if {$limitdiffs != $oldprefs(limitdiffs) ||
10501 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10502 # treediffs elements are limited by path;
10503 # won't have encodings cached if perfile_attrs was just turned on
10504 catch {unset treediffs}
10506 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10507 || $maxgraphpct != $oldprefs(maxgraphpct)} {
10509 } elseif {$showneartags != $oldprefs(showneartags) ||
10510 $limitdiffs != $oldprefs(limitdiffs)} {
10515 proc formatdate {d} {
10516 global datetimeformat
10518 set d [clock format $d -format $datetimeformat]
10523 # This list of encoding names and aliases is distilled from
10524 # http://www.iana.org/assignments/character-sets.
10525 # Not all of them are supported by Tcl.
10526 set encoding_aliases {
10527 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10528 ISO646-US US-ASCII us IBM367 cp367 csASCII }
10529 { ISO-10646-UTF-1 csISO10646UTF1 }
10530 { ISO_646.basic:1983 ref csISO646basic1983 }
10531 { INVARIANT csINVARIANT }
10532 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10533 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10534 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10535 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10536 { NATS-DANO iso-ir-9-1 csNATSDANO }
10537 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10538 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10539 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10540 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10541 { ISO-2022-KR csISO2022KR }
10543 { ISO-2022-JP csISO2022JP }
10544 { ISO-2022-JP-2 csISO2022JP2 }
10545 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10546 csISO13JISC6220jp }
10547 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10548 { IT iso-ir-15 ISO646-IT csISO15Italian }
10549 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10550 { ES iso-ir-17 ISO646-ES csISO17Spanish }
10551 { greek7-old iso-ir-18 csISO18Greek7Old }
10552 { latin-greek iso-ir-19 csISO19LatinGreek }
10553 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10554 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10555 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10556 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10557 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10558 { BS_viewdata iso-ir-47 csISO47BSViewdata }
10559 { INIS iso-ir-49 csISO49INIS }
10560 { INIS-8 iso-ir-50 csISO50INIS8 }
10561 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10562 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10563 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10564 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10565 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10566 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10567 csISO60Norwegian1 }
10568 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10569 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10570 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10571 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10572 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10573 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10574 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10575 { greek7 iso-ir-88 csISO88Greek7 }
10576 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10577 { iso-ir-90 csISO90 }
10578 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10579 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10580 csISO92JISC62991984b }
10581 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10582 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10583 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10584 csISO95JIS62291984handadd }
10585 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10586 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10587 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10588 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10589 CP819 csISOLatin1 }
10590 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10591 { T.61-7bit iso-ir-102 csISO102T617bit }
10592 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10593 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10594 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10595 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10596 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10597 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10598 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10599 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10600 arabic csISOLatinArabic }
10601 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10602 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10603 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10604 greek greek8 csISOLatinGreek }
10605 { T.101-G2 iso-ir-128 csISO128T101G2 }
10606 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10608 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10609 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10610 { CSN_369103 iso-ir-139 csISO139CSN369103 }
10611 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10612 { ISO_6937-2-add iso-ir-142 csISOTextComm }
10613 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10614 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10615 csISOLatinCyrillic }
10616 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10617 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10618 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10619 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10620 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10621 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10622 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10623 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10624 { ISO_10367-box iso-ir-155 csISO10367Box }
10625 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10626 { latin-lap lap iso-ir-158 csISO158Lap }
10627 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10628 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10631 { JIS_X0201 X0201 csHalfWidthKatakana }
10632 { KSC5636 ISO646-KR csKSC5636 }
10633 { ISO-10646-UCS-2 csUnicode }
10634 { ISO-10646-UCS-4 csUCS4 }
10635 { DEC-MCS dec csDECMCS }
10636 { hp-roman8 roman8 r8 csHPRoman8 }
10637 { macintosh mac csMacintosh }
10638 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10640 { IBM038 EBCDIC-INT cp038 csIBM038 }
10641 { IBM273 CP273 csIBM273 }
10642 { IBM274 EBCDIC-BE CP274 csIBM274 }
10643 { IBM275 EBCDIC-BR cp275 csIBM275 }
10644 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10645 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10646 { IBM280 CP280 ebcdic-cp-it csIBM280 }
10647 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10648 { IBM284 CP284 ebcdic-cp-es csIBM284 }
10649 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10650 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10651 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10652 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10653 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10654 { IBM424 cp424 ebcdic-cp-he csIBM424 }
10655 { IBM437 cp437 437 csPC8CodePage437 }
10656 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10657 { IBM775 cp775 csPC775Baltic }
10658 { IBM850 cp850 850 csPC850Multilingual }
10659 { IBM851 cp851 851 csIBM851 }
10660 { IBM852 cp852 852 csPCp852 }
10661 { IBM855 cp855 855 csIBM855 }
10662 { IBM857 cp857 857 csIBM857 }
10663 { IBM860 cp860 860 csIBM860 }
10664 { IBM861 cp861 861 cp-is csIBM861 }
10665 { IBM862 cp862 862 csPC862LatinHebrew }
10666 { IBM863 cp863 863 csIBM863 }
10667 { IBM864 cp864 csIBM864 }
10668 { IBM865 cp865 865 csIBM865 }
10669 { IBM866 cp866 866 csIBM866 }
10670 { IBM868 CP868 cp-ar csIBM868 }
10671 { IBM869 cp869 869 cp-gr csIBM869 }
10672 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10673 { IBM871 CP871 ebcdic-cp-is csIBM871 }
10674 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10675 { IBM891 cp891 csIBM891 }
10676 { IBM903 cp903 csIBM903 }
10677 { IBM904 cp904 904 csIBBM904 }
10678 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10679 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10680 { IBM1026 CP1026 csIBM1026 }
10681 { EBCDIC-AT-DE csIBMEBCDICATDE }
10682 { EBCDIC-AT-DE-A csEBCDICATDEA }
10683 { EBCDIC-CA-FR csEBCDICCAFR }
10684 { EBCDIC-DK-NO csEBCDICDKNO }
10685 { EBCDIC-DK-NO-A csEBCDICDKNOA }
10686 { EBCDIC-FI-SE csEBCDICFISE }
10687 { EBCDIC-FI-SE-A csEBCDICFISEA }
10688 { EBCDIC-FR csEBCDICFR }
10689 { EBCDIC-IT csEBCDICIT }
10690 { EBCDIC-PT csEBCDICPT }
10691 { EBCDIC-ES csEBCDICES }
10692 { EBCDIC-ES-A csEBCDICESA }
10693 { EBCDIC-ES-S csEBCDICESS }
10694 { EBCDIC-UK csEBCDICUK }
10695 { EBCDIC-US csEBCDICUS }
10696 { UNKNOWN-8BIT csUnknown8BiT }
10697 { MNEMONIC csMnemonic }
10699 { VISCII csVISCII }
10702 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10703 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10704 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10705 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10706 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10707 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10708 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10709 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10710 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10711 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10712 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10713 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10714 { IBM1047 IBM-1047 }
10715 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10716 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10717 { UNICODE-1-1 csUnicode11 }
10718 { CESU-8 csCESU-8 }
10719 { BOCU-1 csBOCU-1 }
10720 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10721 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10723 { ISO-8859-15 ISO_8859-15 Latin-9 }
10724 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10725 { GBK CP936 MS936 windows-936 }
10726 { JIS_Encoding csJISEncoding }
10727 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10728 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10730 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10731 { ISO-10646-UCS-Basic csUnicodeASCII }
10732 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10733 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10734 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10735 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10736 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10737 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10738 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10739 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10740 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10741 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10742 { Adobe-Standard-Encoding csAdobeStandardEncoding }
10743 { Ventura-US csVenturaUS }
10744 { Ventura-International csVenturaInternational }
10745 { PC8-Danish-Norwegian csPC8DanishNorwegian }
10746 { PC8-Turkish csPC8Turkish }
10747 { IBM-Symbols csIBMSymbols }
10748 { IBM-Thai csIBMThai }
10749 { HP-Legal csHPLegal }
10750 { HP-Pi-font csHPPiFont }
10751 { HP-Math8 csHPMath8 }
10752 { Adobe-Symbol-Encoding csHPPSMath }
10753 { HP-DeskTop csHPDesktop }
10754 { Ventura-Math csVenturaMath }
10755 { Microsoft-Publishing csMicrosoftPublishing }
10756 { Windows-31J csWindows31J }
10757 { GB2312 csGB2312 }
10761 proc tcl_encoding {enc} {
10762 global encoding_aliases tcl_encoding_cache
10763 if {[info exists tcl_encoding_cache($enc)]} {
10764 return $tcl_encoding_cache($enc)
10766 set names [encoding names]
10767 set lcnames [string tolower $names]
10768 set enc [string tolower $enc]
10769 set i [lsearch -exact $lcnames $enc]
10771 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10772 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10773 set i [lsearch -exact $lcnames $encx]
10777 foreach l $encoding_aliases {
10778 set ll [string tolower $l]
10779 if {[lsearch -exact $ll $enc] < 0} continue
10780 # look through the aliases for one that tcl knows about
10782 set i [lsearch -exact $lcnames $e]
10784 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10785 set i [lsearch -exact $lcnames $ex]
10795 set tclenc [lindex $names $i]
10797 set tcl_encoding_cache($enc) $tclenc
10801 proc gitattr {path attr default} {
10802 global path_attr_cache
10803 if {[info exists path_attr_cache($attr,$path)]} {
10804 set r $path_attr_cache($attr,$path)
10806 set r "unspecified"
10807 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10808 regexp "(.*): encoding: (.*)" $line m f r
10810 set path_attr_cache($attr,$path) $r
10812 if {$r eq "unspecified"} {
10818 proc cache_gitattr {attr pathlist} {
10819 global path_attr_cache
10821 foreach path $pathlist {
10822 if {![info exists path_attr_cache($attr,$path)]} {
10823 lappend newlist $path
10827 if {[tk windowingsystem] == "win32"} {
10828 # windows has a 32k limit on the arguments to a command...
10831 while {$newlist ne {}} {
10832 set head [lrange $newlist 0 [expr {$lim - 1}]]
10833 set newlist [lrange $newlist $lim end]
10834 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10835 foreach row [split $rlist "\n"] {
10836 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10837 if {[string index $path 0] eq "\""} {
10838 set path [encoding convertfrom [lindex $path 0]]
10840 set path_attr_cache($attr,$path) $value
10847 proc get_path_encoding {path} {
10848 global gui_encoding perfile_attrs
10849 set tcl_enc $gui_encoding
10850 if {$path ne {} && $perfile_attrs} {
10851 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10859 # First check that Tcl/Tk is recent enough
10860 if {[catch {package require Tk 8.4} err]} {
10861 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10862 Gitk requires at least Tcl/Tk 8.4."]
10867 set wrcomcmd "git diff-tree --stdin -p --pretty"
10871 set gitencoding [exec git config --get i18n.commitencoding]
10874 set gitencoding [exec git config --get i18n.logoutputencoding]
10876 if {$gitencoding == ""} {
10877 set gitencoding "utf-8"
10879 set tclencoding [tcl_encoding $gitencoding]
10880 if {$tclencoding == {}} {
10881 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10884 set gui_encoding [encoding system]
10886 set enc [exec git config --get gui.encoding]
10888 set tclenc [tcl_encoding $enc]
10889 if {$tclenc ne {}} {
10890 set gui_encoding $tclenc
10892 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10897 if {[tk windowingsystem] eq "aqua"} {
10898 set mainfont {{Lucida Grande} 9}
10899 set textfont {Monaco 9}
10900 set uifont {{Lucida Grande} 9 bold}
10902 set mainfont {Helvetica 9}
10903 set textfont {Courier 9}
10904 set uifont {Helvetica 9 bold}
10907 set findmergefiles 0
10915 set cmitmode "patch"
10916 set wrapcomment "none"
10920 set showlocalchanges 1
10922 set datetimeformat "%Y-%m-%d %H:%M:%S"
10924 set perfile_attrs 0
10926 if {[tk windowingsystem] eq "aqua"} {
10927 set extdifftool "opendiff"
10929 set extdifftool "meld"
10932 set colors {green red blue magenta darkgrey brown orange}
10935 set diffcolors {red "#00a000" blue}
10938 set selectbgcolor gray85
10939 set markbgcolor "#e0e0ff"
10941 set circlecolors {white blue gray blue blue}
10943 # button for popping up context menus
10944 if {[tk windowingsystem] eq "aqua"} {
10945 set ctxbut <Button-2>
10947 set ctxbut <Button-3>
10950 ## For msgcat loading, first locate the installation location.
10951 if { [info exists ::env(GITK_MSGSDIR)] } {
10952 ## Msgsdir was manually set in the environment.
10953 set gitk_msgsdir $::env(GITK_MSGSDIR)
10955 ## Let's guess the prefix from argv0.
10956 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10957 set gitk_libdir [file join $gitk_prefix share gitk lib]
10958 set gitk_msgsdir [file join $gitk_libdir msgs]
10962 ## Internationalization (i18n) through msgcat and gettext. See
10963 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10964 package require msgcat
10965 namespace import ::msgcat::mc
10966 ## And eventually load the actual message catalog
10967 ::msgcat::mcload $gitk_msgsdir
10969 catch {source ~/.gitk}
10971 font create optionfont -family sans-serif -size -12
10973 parsefont mainfont $mainfont
10974 eval font create mainfont [fontflags mainfont]
10975 eval font create mainfontbold [fontflags mainfont 1]
10977 parsefont textfont $textfont
10978 eval font create textfont [fontflags textfont]
10979 eval font create textfontbold [fontflags textfont 1]
10981 parsefont uifont $uifont
10982 eval font create uifont [fontflags uifont]
10986 # check that we can find a .git directory somewhere...
10987 if {[catch {set gitdir [gitdir]}]} {
10988 show_error {} . [mc "Cannot find a git repository here."]
10991 if {![file isdirectory $gitdir]} {
10992 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10997 set selectheadid {}
11000 set cmdline_files {}
11002 set revtreeargscmd {}
11003 foreach arg $argv {
11004 switch -glob -- $arg {
11007 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11010 "--select-commit=*" {
11011 set selecthead [string range $arg 16 end]
11014 set revtreeargscmd [string range $arg 10 end]
11017 lappend revtreeargs $arg
11023 if {$selecthead eq "HEAD"} {
11027 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11028 # no -- on command line, but some arguments (other than --argscmd)
11030 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11031 set cmdline_files [split $f "\n"]
11032 set n [llength $cmdline_files]
11033 set revtreeargs [lrange $revtreeargs 0 end-$n]
11034 # Unfortunately git rev-parse doesn't produce an error when
11035 # something is both a revision and a filename. To be consistent
11036 # with git log and git rev-list, check revtreeargs for filenames.
11037 foreach arg $revtreeargs {
11038 if {[file exists $arg]} {
11039 show_error {} . [mc "Ambiguous argument '%s': both revision\
11040 and filename" $arg]
11045 # unfortunately we get both stdout and stderr in $err,
11046 # so look for "fatal:".
11047 set i [string first "fatal:" $err]
11049 set err [string range $err [expr {$i + 6}] end]
11051 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11056 set nullid "0000000000000000000000000000000000000000"
11057 set nullid2 "0000000000000000000000000000000000000001"
11058 set nullfile "/dev/null"
11060 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11067 set highlight_paths {}
11069 set searchdirn -forwards
11072 set diffelide {0 0}
11073 set markingmatches 0
11074 set linkentercount 0
11075 set need_redisplay 0
11082 set selectedhlview [mc "None"]
11083 set highlight_related [mc "None"]
11084 set highlight_files {}
11085 set viewfiles(0) {}
11088 set viewargscmd(0) {}
11090 set selectedline {}
11098 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11102 image create photo gitlogo -width 16 -height 16
11104 image create photo gitlogominus -width 4 -height 2
11105 gitlogominus put #C00000 -to 0 0 4 2
11106 gitlogo copy gitlogominus -to 1 5
11107 gitlogo copy gitlogominus -to 6 5
11108 gitlogo copy gitlogominus -to 11 5
11109 image delete gitlogominus
11111 image create photo gitlogoplus -width 4 -height 4
11112 gitlogoplus put #008000 -to 1 0 3 4
11113 gitlogoplus put #008000 -to 0 1 4 3
11114 gitlogo copy gitlogoplus -to 1 9
11115 gitlogo copy gitlogoplus -to 6 9
11116 gitlogo copy gitlogoplus -to 11 9
11117 image delete gitlogoplus
11119 image create photo gitlogo32 -width 32 -height 32
11120 gitlogo32 copy gitlogo -zoom 2 2
11122 wm iconphoto . -default gitlogo gitlogo32
11124 # wait for the window to become visible
11125 tkwait visibility .
11126 wm title . "[file tail $argv0]: [file tail [pwd]]"
11129 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11130 # create a view for the files/dirs specified on the command line
11134 set viewname(1) [mc "Command line"]
11135 set viewfiles(1) $cmdline_files
11136 set viewargs(1) $revtreeargs
11137 set viewargscmd(1) $revtreeargscmd
11141 .bar.view entryconf [mca "Edit view..."] -state normal
11142 .bar.view entryconf [mca "Delete view"] -state normal
11145 if {[info exists permviews]} {
11146 foreach v $permviews {
11149 set viewname($n) [lindex $v 0]
11150 set viewfiles($n) [lindex $v 1]
11151 set viewargs($n) [lindex $v 2]
11152 set viewargscmd($n) [lindex $v 3]
11158 if {[tk windowingsystem] eq "win32"} {