2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright © 2005-2011 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.
13 return [expr {[exec git rev-parse
--is-bare-repository] == "false" &&
14 [exec git rev-parse
--is-inside-git-dir] == "false"}]
19 set n
[file normalize
$gitdir]
20 if {[string match
"*/.git" $n]} {
21 set n
[string range
$n 0 end-5
]
28 if {[info exists _gitworktree
]} {
31 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
32 if {[catch
{set _gitworktree
[exec git rev-parse
--show-toplevel]}]} {
33 # try to set work tree from environment, core.worktree or use
34 # cdup to obtain a relative path to the top of the worktree. If
35 # run from the top, the ./ prefix ensures normalize expands pwd.
36 if {[catch
{ set _gitworktree
$env(GIT_WORK_TREE
) }]} {
37 catch
{set _gitworktree
[exec git config
--get core.worktree
]}
38 if {$_gitworktree eq
""} {
39 set _gitworktree
[file normalize .
/[exec git rev-parse
--show-cdup]]
46 # A simple scheduler for compute-intensive stuff.
47 # The aim is to make sure that event handlers for GUI actions can
48 # run at least every 50-100 ms. Unfortunately fileevent handlers are
49 # run before X event handlers, so reading from a fast source can
50 # make the GUI completely unresponsive.
52 global isonrunq runq currunq
55 if {[info exists isonrunq
($script)]} return
56 if {$runq eq
{} && ![info exists currunq
]} {
59 lappend runq
[list
{} $script]
60 set isonrunq
($script) 1
63 proc filerun
{fd
script} {
64 fileevent
$fd readable
[list filereadable
$fd $script]
67 proc filereadable
{fd
script} {
70 fileevent
$fd readable
{}
71 if {$runq eq
{} && ![info exists currunq
]} {
74 lappend runq
[list
$fd $script]
80 for {set i
0} {$i < [llength
$runq]} {} {
81 if {[lindex
$runq $i 0] eq
$fd} {
82 set runq
[lreplace
$runq $i $i]
90 global isonrunq runq currunq
92 set tstart
[clock clicks
-milliseconds]
94 while {[llength
$runq] > 0} {
95 set fd
[lindex
$runq 0 0]
96 set script [lindex
$runq 0 1]
97 set currunq
[lindex
$runq 0]
98 set runq
[lrange
$runq 1 end
]
99 set repeat
[eval $script]
101 set t1
[clock clicks
-milliseconds]
102 set t
[expr {$t1 - $t0}]
103 if {$repeat ne
{} && $repeat} {
104 if {$fd eq
{} ||
$repeat == 2} {
105 # script returns 1 if it wants to be readded
106 # file readers return 2 if they could do more straight away
107 lappend runq
[list
$fd $script]
109 fileevent
$fd readable
[list filereadable
$fd $script]
111 } elseif
{$fd eq
{}} {
112 unset isonrunq
($script)
115 if {$t1 - $tstart >= 80} break
122 proc reg_instance
{fd
} {
123 global commfd leftover loginstance
125 set i
[incr loginstance
]
131 proc unmerged_files
{files
} {
134 # find the list of unmerged files
138 set fd
[open
"| git ls-files -u" r
]
140 show_error
{} .
"[mc "Couldn
't get list of unmerged files:"] $err"
143 while {[gets $fd line] >= 0} {
144 set i [string first "\t" $line]
146 set fname [string range $line [expr {$i+1}] end]
147 if {[lsearch -exact $mlist $fname] >= 0} continue
149 if {$files eq {} || [path_filter $files $fname]} {
157 proc parseviewargs {n arglist} {
158 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
159 global worddiff git_version
167 set origargs $arglist
171 foreach arg $arglist {
178 switch -glob -- $arg {
182 # remove from origargs in case we hit an unknown option
183 set origargs [lreplace $origargs $i $i]
187 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
188 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
189 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
190 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
191 "--ignore-space-change" - "-U*" - "--unified=*" {
192 # These request or affect diff output, which we don't want.
193 # Some could be used to set our defaults for diff display.
194 lappend diffargs
$arg
196 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
197 "--name-only" - "--name-status" - "--color" -
198 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
199 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
200 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
201 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
202 "--objects" - "--objects-edge" - "--reverse" {
203 # These cause our parsing of git log's output to fail, or else
204 # they're options we want to set ourselves, so ignore them.
206 "--color-words*" - "--word-diff=color" {
207 # These trigger a word diff in the console interface,
208 # so help the user by enabling our own support
209 if {[package vcompare
$git_version "1.7.2"] >= 0} {
210 set worddiff
[mc
"Color words"]
214 if {[package vcompare
$git_version "1.7.2"] >= 0} {
215 set worddiff
[mc
"Markup words"]
218 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
219 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
220 "--full-history" - "--dense" - "--sparse" -
221 "--follow" - "--left-right" - "--encoding=*" {
222 # These are harmless, and some are even useful
225 "--diff-filter=*" - "--no-merges" - "--unpacked" -
226 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
227 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
228 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
229 "--remove-empty" - "--first-parent" - "--cherry-pick" -
230 "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
231 "--simplify-by-decoration" {
232 # These mean that we get a subset of the commits
237 # This appears to be the only one that has a value as a
238 # separate word following it
248 # git rev-parse doesn't understand --merge
249 lappend revargs
--gitk-symmetric-diff-marker MERGE_HEAD...HEAD
251 "--no-replace-objects" {
252 set env
(GIT_NO_REPLACE_OBJECTS
) "1"
255 # Other flag arguments including -<n>
256 if {[string is digit
-strict [string range
$arg 1 end
]]} {
259 # a flag argument that we don't recognize;
260 # that means we can't optimize
266 # Non-flag arguments specify commits or ranges of commits
267 if {[string match
"*...*" $arg]} {
268 lappend revargs
--gitk-symmetric-diff-marker
274 set vdflags
($n) $diffargs
275 set vflags
($n) $glflags
276 set vrevs
($n) $revargs
277 set vfiltered
($n) $filtered
278 set vorigargs
($n) $origargs
282 proc parseviewrevs
{view revs
} {
283 global vposids vnegids
288 if {[catch
{set ids
[eval exec git rev-parse
$revs]} err
]} {
289 # we get stdout followed by stderr in $err
290 # for an unknown rev, git rev-parse echoes it and then errors out
291 set errlines
[split $err "\n"]
293 for {set l
0} {$l < [llength
$errlines]} {incr l
} {
294 set line
[lindex
$errlines $l]
295 if {!([string length
$line] == 40 && [string is xdigit
$line])} {
296 if {[string match
"fatal:*" $line]} {
297 if {[string match
"fatal: ambiguous argument*" $line]
299 if {[llength
$badrev] == 1} {
300 set err
"unknown revision $badrev"
302 set err
"unknown revisions: [join $badrev ", "]"
305 set err
[join [lrange
$errlines $l end
] "\n"]
312 error_popup
"[mc "Error parsing revisions
:"] $err"
319 foreach id
[split $ids "\n"] {
320 if {$id eq
"--gitk-symmetric-diff-marker"} {
322 } elseif
{[string match
"^*" $id]} {
329 lappend neg
[string range
$id 1 end
]
334 lset ret end
$id...
[lindex
$ret end
]
340 set vposids
($view) $pos
341 set vnegids
($view) $neg
345 # Start off a git log process and arrange to read its output
346 proc start_rev_list
{view
} {
347 global startmsecs commitidx viewcomplete curview
349 global viewargs viewargscmd viewfiles vfilelimit
350 global showlocalchanges
351 global viewactive viewinstances vmergeonly
352 global mainheadid viewmainheadid viewmainheadid_orig
353 global vcanopt vflags vrevs vorigargs
356 set startmsecs
[clock clicks
-milliseconds]
357 set commitidx
($view) 0
358 # these are set this way for the error exits
359 set viewcomplete
($view) 1
360 set viewactive
($view) 0
363 set args
$viewargs($view)
364 if {$viewargscmd($view) ne
{}} {
366 set str
[exec sh
-c $viewargscmd($view)]
368 error_popup
"[mc "Error executing
--argscmd command:"] $err"
371 set args
[concat
$args [split $str "\n"]]
373 set vcanopt
($view) [parseviewargs
$view $args]
375 set files
$viewfiles($view)
376 if {$vmergeonly($view)} {
377 set files
[unmerged_files
$files]
380 if {$nr_unmerged == 0} {
381 error_popup
[mc
"No files selected: --merge specified but\
382 no files are unmerged."]
384 error_popup
[mc
"No files selected: --merge specified but\
385 no unmerged files are within file limit."]
390 set vfilelimit
($view) $files
392 if {$vcanopt($view)} {
393 set revs
[parseviewrevs
$view $vrevs($view)]
397 set args
[concat
$vflags($view) $revs]
399 set args
$vorigargs($view)
403 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$show_notes \
404 --parents --boundary $args "--" $files] r
]
406 error_popup
"[mc "Error executing git log
:"] $err"
409 set i
[reg_instance
$fd]
410 set viewinstances
($view) [list
$i]
411 set viewmainheadid
($view) $mainheadid
412 set viewmainheadid_orig
($view) $mainheadid
413 if {$files ne
{} && $mainheadid ne
{}} {
414 get_viewmainhead
$view
416 if {$showlocalchanges && $viewmainheadid($view) ne
{}} {
417 interestedin
$viewmainheadid($view) dodiffindex
419 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
420 if {$tclencoding != {}} {
421 fconfigure
$fd -encoding $tclencoding
423 filerun
$fd [list getcommitlines
$fd $i $view 0]
424 nowbusy
$view [mc
"Reading"]
425 set viewcomplete
($view) 0
426 set viewactive
($view) 1
430 proc stop_instance
{inst
} {
431 global commfd leftover
433 set fd
$commfd($inst)
437 if {$
::tcl_platform
(platform
) eq
{windows
}} {
446 unset leftover
($inst)
449 proc stop_backends
{} {
452 foreach inst
[array names commfd
] {
457 proc stop_rev_list
{view
} {
460 foreach inst
$viewinstances($view) {
463 set viewinstances
($view) {}
466 proc reset_pending_select
{selid
} {
467 global pending_select mainheadid selectheadid
470 set pending_select
$selid
471 } elseif
{$selectheadid ne
{}} {
472 set pending_select
$selectheadid
474 set pending_select
$mainheadid
478 proc getcommits
{selid
} {
479 global canv curview need_redisplay viewactive
482 if {[start_rev_list
$curview]} {
483 reset_pending_select
$selid
484 show_status
[mc
"Reading commits..."]
487 show_status
[mc
"No commits selected"]
491 proc updatecommits
{} {
492 global curview vcanopt vorigargs vfilelimit viewinstances
493 global viewactive viewcomplete tclencoding
494 global startmsecs showneartags showlocalchanges
495 global mainheadid viewmainheadid viewmainheadid_orig pending_select
497 global varcid vposids vnegids vflags vrevs
500 set hasworktree
[hasworktree
]
503 if {$mainheadid ne
$viewmainheadid_orig($view)} {
504 if {$showlocalchanges} {
507 set viewmainheadid
($view) $mainheadid
508 set viewmainheadid_orig
($view) $mainheadid
509 if {$vfilelimit($view) ne
{}} {
510 get_viewmainhead
$view
513 if {$showlocalchanges} {
516 if {$vcanopt($view)} {
517 set oldpos
$vposids($view)
518 set oldneg
$vnegids($view)
519 set revs
[parseviewrevs
$view $vrevs($view)]
523 # note: getting the delta when negative refs change is hard,
524 # and could require multiple git log invocations, so in that
525 # case we ask git log for all the commits (not just the delta)
526 if {$oldneg eq
$vnegids($view)} {
529 # take out positive refs that we asked for before or
530 # that we have already seen
532 if {[string length
$rev] == 40} {
533 if {[lsearch
-exact $oldpos $rev] < 0
534 && ![info exists varcid
($view,$rev)]} {
539 lappend
$newrevs $rev
542 if {$npos == 0} return
544 set vposids
($view) [lsort
-unique [concat
$oldpos $vposids($view)]]
546 set args
[concat
$vflags($view) $revs --not $oldpos]
548 set args
$vorigargs($view)
551 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$show_notes \
552 --parents --boundary $args "--" $vfilelimit($view)] r
]
554 error_popup
"[mc "Error executing git log
:"] $err"
557 if {$viewactive($view) == 0} {
558 set startmsecs
[clock clicks
-milliseconds]
560 set i
[reg_instance
$fd]
561 lappend viewinstances
($view) $i
562 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
563 if {$tclencoding != {}} {
564 fconfigure
$fd -encoding $tclencoding
566 filerun
$fd [list getcommitlines
$fd $i $view 1]
567 incr viewactive
($view)
568 set viewcomplete
($view) 0
569 reset_pending_select
{}
570 nowbusy
$view [mc
"Reading"]
576 proc reloadcommits
{} {
577 global curview viewcomplete selectedline currentid thickerline
578 global showneartags treediffs commitinterest cached_commitrow
582 if {$selectedline ne
{}} {
586 if {!$viewcomplete($curview)} {
587 stop_rev_list
$curview
591 catch
{unset currentid
}
592 catch
{unset thickerline
}
593 catch
{unset treediffs
}
600 catch
{unset commitinterest
}
601 catch
{unset cached_commitrow
}
602 catch
{unset targetid
}
608 # This makes a string representation of a positive integer which
609 # sorts as a string in numerical order
612 return [format
"%x" $n]
613 } elseif
{$n < 256} {
614 return [format
"x%.2x" $n]
615 } elseif
{$n < 65536} {
616 return [format
"y%.4x" $n]
618 return [format
"z%.8x" $n]
621 # Procedures used in reordering commits from git log (without
622 # --topo-order) into the order for display.
624 proc varcinit
{view
} {
625 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
626 global vtokmod varcmod vrowmod varcix vlastins
628 set varcstart
($view) {{}}
629 set vupptr
($view) {0}
630 set vdownptr
($view) {0}
631 set vleftptr
($view) {0}
632 set vbackptr
($view) {0}
633 set varctok
($view) {{}}
634 set varcrow
($view) {{}}
635 set vtokmod
($view) {}
638 set varcix
($view) {{}}
639 set vlastins
($view) {0}
642 proc resetvarcs
{view
} {
643 global varcid varccommits parents children vseedcount ordertok
645 foreach vid
[array names varcid
$view,*] {
650 # some commits might have children but haven't been seen yet
651 foreach vid
[array names children
$view,*] {
654 foreach va
[array names varccommits
$view,*] {
655 unset varccommits
($va)
657 foreach vd
[array names vseedcount
$view,*] {
658 unset vseedcount
($vd)
660 catch
{unset ordertok
}
663 # returns a list of the commits with no children
665 global vdownptr vleftptr varcstart
668 set a
[lindex
$vdownptr($v) 0]
670 lappend ret
[lindex
$varcstart($v) $a]
671 set a
[lindex
$vleftptr($v) $a]
676 proc newvarc
{view id
} {
677 global varcid varctok parents children vdatemode
678 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
679 global commitdata commitinfo vseedcount varccommits vlastins
681 set a
[llength
$varctok($view)]
683 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
684 if {![info exists commitinfo
($id)]} {
685 parsecommit
$id $commitdata($id) 1
687 set cdate
[lindex
[lindex
$commitinfo($id) 4] 0]
688 if {![string is integer
-strict $cdate]} {
691 if {![info exists vseedcount
($view,$cdate)]} {
692 set vseedcount
($view,$cdate) -1
694 set c
[incr vseedcount
($view,$cdate)]
695 set cdate
[expr {$cdate ^
0xffffffff}]
696 set tok
"s[strrep $cdate][strrep $c]"
701 if {[llength
$children($vid)] > 0} {
702 set kid
[lindex
$children($vid) end
]
703 set k
$varcid($view,$kid)
704 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
707 set tok
[lindex
$varctok($view) $k]
711 set i
[lsearch
-exact $parents($view,$ki) $id]
712 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
713 append tok
[strrep
$j]
715 set c
[lindex
$vlastins($view) $ka]
716 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
718 set b
[lindex
$vdownptr($view) $ka]
720 set b
[lindex
$vleftptr($view) $c]
722 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
724 set b
[lindex
$vleftptr($view) $c]
727 lset vdownptr
($view) $ka $a
728 lappend vbackptr
($view) 0
730 lset vleftptr
($view) $c $a
731 lappend vbackptr
($view) $c
733 lset vlastins
($view) $ka $a
734 lappend vupptr
($view) $ka
735 lappend vleftptr
($view) $b
737 lset vbackptr
($view) $b $a
739 lappend varctok
($view) $tok
740 lappend varcstart
($view) $id
741 lappend vdownptr
($view) 0
742 lappend varcrow
($view) {}
743 lappend varcix
($view) {}
744 set varccommits
($view,$a) {}
745 lappend vlastins
($view) 0
749 proc splitvarc
{p v
} {
750 global varcid varcstart varccommits varctok vtokmod
751 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
753 set oa
$varcid($v,$p)
754 set otok
[lindex
$varctok($v) $oa]
755 set ac
$varccommits($v,$oa)
756 set i
[lsearch
-exact $varccommits($v,$oa) $p]
758 set na
[llength
$varctok($v)]
759 # "%" sorts before "0"...
760 set tok
"$otok%[strrep $i]"
761 lappend varctok
($v) $tok
762 lappend varcrow
($v) {}
763 lappend varcix
($v) {}
764 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
765 set varccommits
($v,$na) [lrange
$ac $i end
]
766 lappend varcstart
($v) $p
767 foreach id
$varccommits($v,$na) {
768 set varcid
($v,$id) $na
770 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
771 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
772 lset vdownptr
($v) $oa $na
773 lset vlastins
($v) $oa 0
774 lappend vupptr
($v) $oa
775 lappend vleftptr
($v) 0
776 lappend vbackptr
($v) 0
777 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
778 lset vupptr
($v) $b $na
780 if {[string compare
$otok $vtokmod($v)] <= 0} {
785 proc renumbervarc
{a v
} {
786 global parents children varctok varcstart varccommits
787 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
789 set t1
[clock clicks
-milliseconds]
795 if {[info exists isrelated
($a)]} {
797 set id
[lindex
$varccommits($v,$a) end
]
798 foreach p
$parents($v,$id) {
799 if {[info exists varcid
($v,$p)]} {
800 set isrelated
($varcid($v,$p)) 1
805 set b
[lindex
$vdownptr($v) $a]
808 set b
[lindex
$vleftptr($v) $a]
810 set a
[lindex
$vupptr($v) $a]
816 if {![info exists kidchanged
($a)]} continue
817 set id
[lindex
$varcstart($v) $a]
818 if {[llength
$children($v,$id)] > 1} {
819 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
822 set oldtok
[lindex
$varctok($v) $a]
823 if {!$vdatemode($v)} {
829 set kid
[last_real_child
$v,$id]
831 set k
$varcid($v,$kid)
832 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
835 set tok
[lindex
$varctok($v) $k]
839 set i
[lsearch
-exact $parents($v,$ki) $id]
840 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
841 append tok
[strrep
$j]
843 if {$tok eq
$oldtok} {
846 set id
[lindex
$varccommits($v,$a) end
]
847 foreach p
$parents($v,$id) {
848 if {[info exists varcid
($v,$p)]} {
849 set kidchanged
($varcid($v,$p)) 1
854 lset varctok
($v) $a $tok
855 set b
[lindex
$vupptr($v) $a]
857 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
860 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
863 set c
[lindex
$vbackptr($v) $a]
864 set d
[lindex
$vleftptr($v) $a]
866 lset vdownptr
($v) $b $d
868 lset vleftptr
($v) $c $d
871 lset vbackptr
($v) $d $c
873 if {[lindex
$vlastins($v) $b] == $a} {
874 lset vlastins
($v) $b $c
876 lset vupptr
($v) $a $ka
877 set c
[lindex
$vlastins($v) $ka]
879 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
881 set b
[lindex
$vdownptr($v) $ka]
883 set b
[lindex
$vleftptr($v) $c]
886 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
888 set b
[lindex
$vleftptr($v) $c]
891 lset vdownptr
($v) $ka $a
892 lset vbackptr
($v) $a 0
894 lset vleftptr
($v) $c $a
895 lset vbackptr
($v) $a $c
897 lset vleftptr
($v) $a $b
899 lset vbackptr
($v) $b $a
901 lset vlastins
($v) $ka $a
904 foreach id
[array names sortkids
] {
905 if {[llength
$children($v,$id)] > 1} {
906 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
910 set t2
[clock clicks
-milliseconds]
911 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
914 # Fix up the graph after we have found out that in view $v,
915 # $p (a commit that we have already seen) is actually the parent
916 # of the last commit in arc $a.
917 proc fix_reversal
{p a v
} {
918 global varcid varcstart varctok vupptr
920 set pa
$varcid($v,$p)
921 if {$p ne
[lindex
$varcstart($v) $pa]} {
923 set pa
$varcid($v,$p)
925 # seeds always need to be renumbered
926 if {[lindex
$vupptr($v) $pa] == 0 ||
927 [string compare
[lindex
$varctok($v) $a] \
928 [lindex
$varctok($v) $pa]] > 0} {
933 proc insertrow
{id p v
} {
934 global cmitlisted children parents varcid varctok vtokmod
935 global varccommits ordertok commitidx numcommits curview
936 global targetid targetrow
940 set cmitlisted
($vid) 1
941 set children
($vid) {}
942 set parents
($vid) [list
$p]
943 set a
[newvarc
$v $id]
945 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
948 lappend varccommits
($v,$a) $id
950 if {[llength
[lappend children
($vp) $id]] > 1} {
951 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
952 catch
{unset ordertok
}
954 fix_reversal
$p $a $v
956 if {$v == $curview} {
957 set numcommits
$commitidx($v)
959 if {[info exists targetid
]} {
960 if {![comes_before
$targetid $p]} {
967 proc insertfakerow
{id p
} {
968 global varcid varccommits parents children cmitlisted
969 global commitidx varctok vtokmod targetid targetrow curview numcommits
973 set i
[lsearch
-exact $varccommits($v,$a) $p]
975 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
978 set children
($v,$id) {}
979 set parents
($v,$id) [list
$p]
980 set varcid
($v,$id) $a
981 lappend children
($v,$p) $id
982 set cmitlisted
($v,$id) 1
983 set numcommits
[incr commitidx
($v)]
984 # note we deliberately don't update varcstart($v) even if $i == 0
985 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
987 if {[info exists targetid
]} {
988 if {![comes_before
$targetid $p]} {
996 proc removefakerow
{id
} {
997 global varcid varccommits parents children commitidx
998 global varctok vtokmod cmitlisted currentid selectedline
999 global targetid curview numcommits
1002 if {[llength
$parents($v,$id)] != 1} {
1003 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1006 set p
[lindex
$parents($v,$id) 0]
1007 set a
$varcid($v,$id)
1008 set i
[lsearch
-exact $varccommits($v,$a) $id]
1010 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
1013 unset varcid
($v,$id)
1014 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
1015 unset parents
($v,$id)
1016 unset children
($v,$id)
1017 unset cmitlisted
($v,$id)
1018 set numcommits
[incr commitidx
($v) -1]
1019 set j
[lsearch
-exact $children($v,$p) $id]
1021 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
1024 if {[info exist currentid
] && $id eq
$currentid} {
1028 if {[info exists targetid
] && $targetid eq
$id} {
1035 proc real_children
{vp
} {
1036 global children nullid nullid2
1039 foreach id
$children($vp) {
1040 if {$id ne
$nullid && $id ne
$nullid2} {
1047 proc first_real_child
{vp
} {
1048 global children nullid nullid2
1050 foreach id
$children($vp) {
1051 if {$id ne
$nullid && $id ne
$nullid2} {
1058 proc last_real_child
{vp
} {
1059 global children nullid nullid2
1061 set kids
$children($vp)
1062 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
1063 set id
[lindex
$kids $i]
1064 if {$id ne
$nullid && $id ne
$nullid2} {
1071 proc vtokcmp
{v a b
} {
1072 global varctok varcid
1074 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1075 [lindex
$varctok($v) $varcid($v,$b)]]
1078 # This assumes that if lim is not given, the caller has checked that
1079 # arc a's token is less than $vtokmod($v)
1080 proc modify_arc
{v a
{lim
{}}} {
1081 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1084 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
1087 set r
[lindex
$varcrow($v) $a]
1088 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
1091 set vtokmod
($v) [lindex
$varctok($v) $a]
1093 if {$v == $curview} {
1094 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
1095 set a
[lindex
$vupptr($v) $a]
1101 set lim
[llength
$varccommits($v,$a)]
1103 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
1110 proc update_arcrows
{v
} {
1111 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1112 global varcid vrownum varcorder varcix varccommits
1113 global vupptr vdownptr vleftptr varctok
1114 global displayorder parentlist curview cached_commitrow
1116 if {$vrowmod($v) == $commitidx($v)} return
1117 if {$v == $curview} {
1118 if {[llength
$displayorder] > $vrowmod($v)} {
1119 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
1120 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
1122 catch
{unset cached_commitrow
}
1124 set narctot
[expr {[llength
$varctok($v)] - 1}]
1126 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
1127 # go up the tree until we find something that has a row number,
1128 # or we get to a seed
1129 set a
[lindex
$vupptr($v) $a]
1132 set a
[lindex
$vdownptr($v) 0]
1135 set varcorder
($v) [list
$a]
1136 lset varcix
($v) $a 0
1137 lset varcrow
($v) $a 0
1141 set arcn
[lindex
$varcix($v) $a]
1142 if {[llength
$vrownum($v)] > $arcn + 1} {
1143 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
1144 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
1146 set row
[lindex
$varcrow($v) $a]
1150 incr row
[llength
$varccommits($v,$a)]
1151 # go down if possible
1152 set b
[lindex
$vdownptr($v) $a]
1154 # if not, go left, or go up until we can go left
1156 set b
[lindex
$vleftptr($v) $a]
1158 set a
[lindex
$vupptr($v) $a]
1164 lappend vrownum
($v) $row
1165 lappend varcorder
($v) $a
1166 lset varcix
($v) $a $arcn
1167 lset varcrow
($v) $a $row
1169 set vtokmod
($v) [lindex
$varctok($v) $p]
1171 set vrowmod
($v) $row
1172 if {[info exists currentid
]} {
1173 set selectedline
[rowofcommit
$currentid]
1177 # Test whether view $v contains commit $id
1178 proc commitinview
{id v
} {
1181 return [info exists varcid
($v,$id)]
1184 # Return the row number for commit $id in the current view
1185 proc rowofcommit
{id
} {
1186 global varcid varccommits varcrow curview cached_commitrow
1187 global varctok vtokmod
1190 if {![info exists varcid
($v,$id)]} {
1191 puts
"oops rowofcommit no arc for [shortids $id]"
1194 set a
$varcid($v,$id)
1195 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
1198 if {[info exists cached_commitrow
($id)]} {
1199 return $cached_commitrow($id)
1201 set i
[lsearch
-exact $varccommits($v,$a) $id]
1203 puts
"oops didn't find commit [shortids $id] in arc $a"
1206 incr i
[lindex
$varcrow($v) $a]
1207 set cached_commitrow
($id) $i
1211 # Returns 1 if a is on an earlier row than b, otherwise 0
1212 proc comes_before
{a b
} {
1213 global varcid varctok curview
1216 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
1217 ![info exists varcid
($v,$b)]} {
1220 if {$varcid($v,$a) != $varcid($v,$b)} {
1221 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1222 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
1224 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
1227 proc bsearch
{l elt
} {
1228 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
1233 while {$hi - $lo > 1} {
1234 set mid
[expr {int
(($lo + $hi) / 2)}]
1235 set t
[lindex
$l $mid]
1238 } elseif
{$elt > $t} {
1247 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1248 proc make_disporder
{start end
} {
1249 global vrownum curview commitidx displayorder parentlist
1250 global varccommits varcorder parents vrowmod varcrow
1251 global d_valid_start d_valid_end
1253 if {$end > $vrowmod($curview)} {
1254 update_arcrows
$curview
1256 set ai
[bsearch
$vrownum($curview) $start]
1257 set start
[lindex
$vrownum($curview) $ai]
1258 set narc
[llength
$vrownum($curview)]
1259 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
1260 set a
[lindex
$varcorder($curview) $ai]
1261 set l
[llength
$displayorder]
1262 set al
[llength
$varccommits($curview,$a)]
1263 if {$l < $r + $al} {
1265 set pad
[ntimes
[expr {$r - $l}] {}]
1266 set displayorder
[concat
$displayorder $pad]
1267 set parentlist
[concat
$parentlist $pad]
1268 } elseif
{$l > $r} {
1269 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
1270 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
1272 foreach id
$varccommits($curview,$a) {
1273 lappend displayorder
$id
1274 lappend parentlist
$parents($curview,$id)
1276 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
1278 foreach id
$varccommits($curview,$a) {
1279 lset displayorder
$i $id
1280 lset parentlist
$i $parents($curview,$id)
1288 proc commitonrow
{row
} {
1291 set id
[lindex
$displayorder $row]
1293 make_disporder
$row [expr {$row + 1}]
1294 set id
[lindex
$displayorder $row]
1299 proc closevarcs
{v
} {
1300 global varctok varccommits varcid parents children
1301 global cmitlisted commitidx vtokmod
1303 set missing_parents
0
1305 set narcs
[llength
$varctok($v)]
1306 for {set a
1} {$a < $narcs} {incr a
} {
1307 set id
[lindex
$varccommits($v,$a) end
]
1308 foreach p
$parents($v,$id) {
1309 if {[info exists varcid
($v,$p)]} continue
1310 # add p as a new commit
1311 incr missing_parents
1312 set cmitlisted
($v,$p) 0
1313 set parents
($v,$p) {}
1314 if {[llength
$children($v,$p)] == 1 &&
1315 [llength
$parents($v,$id)] == 1} {
1318 set b
[newvarc
$v $p]
1320 set varcid
($v,$p) $b
1321 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1324 lappend varccommits
($v,$b) $p
1326 set scripts
[check_interest
$p $scripts]
1329 if {$missing_parents > 0} {
1330 foreach s
$scripts {
1336 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1337 # Assumes we already have an arc for $rwid.
1338 proc rewrite_commit
{v id rwid
} {
1339 global children parents varcid varctok vtokmod varccommits
1341 foreach ch
$children($v,$id) {
1342 # make $rwid be $ch's parent in place of $id
1343 set i
[lsearch
-exact $parents($v,$ch) $id]
1345 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1347 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1348 # add $ch to $rwid's children and sort the list if necessary
1349 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1350 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1351 $children($v,$rwid)]
1353 # fix the graph after joining $id to $rwid
1354 set a
$varcid($v,$ch)
1355 fix_reversal
$rwid $a $v
1356 # parentlist is wrong for the last element of arc $a
1357 # even if displayorder is right, hence the 3rd arg here
1358 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1362 # Mechanism for registering a command to be executed when we come
1363 # across a particular commit. To handle the case when only the
1364 # prefix of the commit is known, the commitinterest array is now
1365 # indexed by the first 4 characters of the ID. Each element is a
1366 # list of id, cmd pairs.
1367 proc interestedin
{id cmd
} {
1368 global commitinterest
1370 lappend commitinterest
([string range
$id 0 3]) $id $cmd
1373 proc check_interest
{id scripts
} {
1374 global commitinterest
1376 set prefix
[string range
$id 0 3]
1377 if {[info exists commitinterest
($prefix)]} {
1379 foreach
{i
script} $commitinterest($prefix) {
1380 if {[string match
"$i*" $id]} {
1381 lappend scripts
[string map
[list
"%I" $id "%P" $i] $script]
1383 lappend newlist
$i $script
1386 if {$newlist ne
{}} {
1387 set commitinterest
($prefix) $newlist
1389 unset commitinterest
($prefix)
1395 proc getcommitlines
{fd inst view updating
} {
1396 global cmitlisted leftover
1397 global commitidx commitdata vdatemode
1398 global parents children curview hlview
1399 global idpending ordertok
1400 global varccommits varcid varctok vtokmod vfilelimit
1402 set stuff
[read $fd 500000]
1403 # git log doesn't terminate the last commit with a null...
1404 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1411 global commfd viewcomplete viewactive viewname
1412 global viewinstances
1414 set i
[lsearch
-exact $viewinstances($view) $inst]
1416 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1418 # set it blocking so we wait for the process to terminate
1419 fconfigure
$fd -blocking 1
1420 if {[catch
{close
$fd} err
]} {
1422 if {$view != $curview} {
1423 set fv
" for the \"$viewname($view)\" view"
1425 if {[string range
$err 0 4] == "usage"} {
1426 set err
"Gitk: error reading commits$fv:\
1427 bad arguments to git log."
1428 if {$viewname($view) eq
"Command line"} {
1430 " (Note: arguments to gitk are passed to git log\
1431 to allow selection of commits to be displayed.)"
1434 set err
"Error reading commits$fv: $err"
1438 if {[incr viewactive
($view) -1] <= 0} {
1439 set viewcomplete
($view) 1
1440 # Check if we have seen any ids listed as parents that haven't
1441 # appeared in the list
1445 if {$view == $curview} {
1454 set i
[string first
"\0" $stuff $start]
1456 append leftover
($inst) [string range
$stuff $start end
]
1460 set cmit
$leftover($inst)
1461 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1462 set leftover
($inst) {}
1464 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1466 set start
[expr {$i + 1}]
1467 set j
[string first
"\n" $cmit]
1470 if {$j >= 0 && [string match
"commit *" $cmit]} {
1471 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1472 if {[string match
{[-^
<>]*} $ids]} {
1473 switch
-- [string index
$ids 0] {
1479 set ids
[string range
$ids 1 end
]
1483 if {[string length
$id] != 40} {
1491 if {[string length
$shortcmit] > 80} {
1492 set shortcmit
"[string range $shortcmit 0 80]..."
1494 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1497 set id [lindex $ids 0]
1500 if {!$listed && $updating && ![info exists varcid($vid)] &&
1501 $vfilelimit($view) ne {}} {
1502 # git log doesn't rewrite parents
for unlisted commits
1503 # when doing path limiting, so work around that here
1504 # by working out the rewritten parent with git rev-list
1505 # and if we already know about it, using the rewritten
1506 # parent as a substitute parent for $id's children.
1508 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1509 $id -- $vfilelimit($view)]
1511 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1512 # use $rwid in place of $id
1513 rewrite_commit
$view $id $rwid
1520 if {[info exists varcid
($vid)]} {
1521 if {$cmitlisted($vid) ||
!$listed} continue
1525 set olds
[lrange
$ids 1 end
]
1529 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1530 set cmitlisted
($vid) $listed
1531 set parents
($vid) $olds
1532 if {![info exists children
($vid)]} {
1533 set children
($vid) {}
1534 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1535 set k
[lindex
$children($vid) 0]
1536 if {[llength
$parents($view,$k)] == 1 &&
1537 (!$vdatemode($view) ||
1538 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1539 set a
$varcid($view,$k)
1544 set a
[newvarc
$view $id]
1546 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1549 if {![info exists varcid
($vid)]} {
1551 lappend varccommits
($view,$a) $id
1552 incr commitidx
($view)
1557 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1559 if {[llength
[lappend children
($vp) $id]] > 1 &&
1560 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1561 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1563 catch
{unset ordertok
}
1565 if {[info exists varcid
($view,$p)]} {
1566 fix_reversal
$p $a $view
1572 set scripts
[check_interest
$id $scripts]
1576 global numcommits hlview
1578 if {$view == $curview} {
1579 set numcommits
$commitidx($view)
1582 if {[info exists hlview
] && $view == $hlview} {
1583 # we never actually get here...
1586 foreach s
$scripts {
1593 proc chewcommits
{} {
1594 global curview hlview viewcomplete
1595 global pending_select
1598 if {$viewcomplete($curview)} {
1599 global commitidx varctok
1600 global numcommits startmsecs
1602 if {[info exists pending_select
]} {
1604 reset_pending_select
{}
1606 if {[commitinview
$pending_select $curview]} {
1607 selectline
[rowofcommit
$pending_select] 1
1609 set row
[first_real_row
]
1613 if {$commitidx($curview) > 0} {
1614 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1615 #puts "overall $ms ms for $numcommits commits"
1616 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1618 show_status
[mc
"No commits selected"]
1625 proc do_readcommit
{id
} {
1628 # Invoke git-log to handle automatic encoding conversion
1629 set fd
[open
[concat | git log
--no-color --pretty=raw
-1 $id] r
]
1630 # Read the results using i18n.logoutputencoding
1631 fconfigure
$fd -translation lf
-eofchar {}
1632 if {$tclencoding != {}} {
1633 fconfigure
$fd -encoding $tclencoding
1635 set contents
[read $fd]
1637 # Remove the heading line
1638 regsub
{^commit
[0-9a-f]+\n} $contents {} contents
1643 proc readcommit
{id
} {
1644 if {[catch
{set contents
[do_readcommit
$id]}]} return
1645 parsecommit
$id $contents 1
1648 proc parsecommit
{id contents listed
} {
1658 set hdrend
[string first
"\n\n" $contents]
1660 # should never happen...
1661 set hdrend
[string length
$contents]
1663 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1664 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1665 foreach line
[split $header "\n"] {
1666 set line
[split $line " "]
1667 set tag
[lindex
$line 0]
1668 if {$tag == "author"} {
1669 set audate
[lrange
$line end-1 end
]
1670 set auname
[join [lrange
$line 1 end-2
] " "]
1671 } elseif
{$tag == "committer"} {
1672 set comdate
[lrange
$line end-1 end
]
1673 set comname
[join [lrange
$line 1 end-2
] " "]
1677 # take the first non-blank line of the comment as the headline
1678 set headline
[string trimleft
$comment]
1679 set i
[string first
"\n" $headline]
1681 set headline
[string range
$headline 0 $i]
1683 set headline
[string trimright
$headline]
1684 set i
[string first
"\r" $headline]
1686 set headline
[string trimright
[string range
$headline 0 $i]]
1689 # git log indents the comment by 4 spaces;
1690 # if we got this via git cat-file, add the indentation
1692 foreach line
[split $comment "\n"] {
1693 append newcomment
" "
1694 append newcomment
$line
1695 append newcomment
"\n"
1697 set comment
$newcomment
1699 set hasnote
[string first
"\nNotes:\n" $contents]
1700 set commitinfo
($id) [list
$headline $auname $audate \
1701 $comname $comdate $comment $hasnote]
1704 proc getcommit
{id
} {
1705 global commitdata commitinfo
1707 if {[info exists commitdata
($id)]} {
1708 parsecommit
$id $commitdata($id) 1
1711 if {![info exists commitinfo
($id)]} {
1712 set commitinfo
($id) [list
[mc
"No commit information available"]]
1718 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1719 # and are present in the current view.
1720 # This is fairly slow...
1721 proc longid
{prefix
} {
1722 global varcid curview
1725 foreach match
[array names varcid
"$curview,$prefix*"] {
1726 lappend ids
[lindex
[split $match ","] 1]
1732 global tagids idtags headids idheads tagobjid
1733 global otherrefids idotherrefs mainhead mainheadid
1734 global selecthead selectheadid
1737 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1740 set refd
[open
[list | git show-ref
-d] r
]
1741 while {[gets
$refd line
] >= 0} {
1742 if {[string index
$line 40] ne
" "} continue
1743 set id
[string range
$line 0 39]
1744 set ref
[string range
$line 41 end
]
1745 if {![string match
"refs/*" $ref]} continue
1746 set name
[string range
$ref 5 end
]
1747 if {[string match
"remotes/*" $name]} {
1748 if {![string match
"*/HEAD" $name] && !$hideremotes} {
1749 set headids
($name) $id
1750 lappend idheads
($id) $name
1752 } elseif
{[string match
"heads/*" $name]} {
1753 set name
[string range
$name 6 end
]
1754 set headids
($name) $id
1755 lappend idheads
($id) $name
1756 } elseif
{[string match
"tags/*" $name]} {
1757 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1758 # which is what we want since the former is the commit ID
1759 set name
[string range
$name 5 end
]
1760 if {[string match
"*^{}" $name]} {
1761 set name
[string range
$name 0 end-3
]
1763 set tagobjid
($name) $id
1765 set tagids
($name) $id
1766 lappend idtags
($id) $name
1768 set otherrefids
($name) $id
1769 lappend idotherrefs
($id) $name
1776 set mainheadid
[exec git rev-parse HEAD
]
1777 set thehead
[exec git symbolic-ref HEAD
]
1778 if {[string match
"refs/heads/*" $thehead]} {
1779 set mainhead
[string range
$thehead 11 end
]
1783 if {$selecthead ne
{}} {
1785 set selectheadid
[exec git rev-parse
--verify $selecthead]
1790 # skip over fake commits
1791 proc first_real_row
{} {
1792 global nullid nullid2 numcommits
1794 for {set row
0} {$row < $numcommits} {incr row
} {
1795 set id
[commitonrow
$row]
1796 if {$id ne
$nullid && $id ne
$nullid2} {
1803 # update things for a head moved to a child of its previous location
1804 proc movehead
{id name
} {
1805 global headids idheads
1807 removehead
$headids($name) $name
1808 set headids
($name) $id
1809 lappend idheads
($id) $name
1812 # update things when a head has been removed
1813 proc removehead
{id name
} {
1814 global headids idheads
1816 if {$idheads($id) eq
$name} {
1819 set i
[lsearch
-exact $idheads($id) $name]
1821 set idheads
($id) [lreplace
$idheads($id) $i $i]
1824 unset headids
($name)
1827 proc ttk_toplevel
{w args
} {
1829 eval [linsert
$args 0 ::toplevel
$w]
1831 place
[ttk
::frame
$w._toplevel_background
] -x 0 -y 0 -relwidth 1 -relheight 1
1836 proc make_transient
{window origin
} {
1839 # In MacOS Tk 8.4 transient appears to work by setting
1840 # overrideredirect, which is utterly useless, since the
1841 # windows get no border, and are not even kept above
1843 if {!$have_tk85 && [tk windowingsystem
] eq
{aqua
}} return
1845 wm transient
$window $origin
1847 # Windows fails to place transient windows normally, so
1848 # schedule a callback to center them on the parent.
1849 if {[tk windowingsystem
] eq
{win32
}} {
1850 after idle
[list tk
::PlaceWindow
$window widget
$origin]
1854 proc show_error
{w top msg
{mc mc
}} {
1856 if {![info exists NS
]} {set NS
""}
1857 if {[wm state
$top] eq
"withdrawn"} { wm deiconify
$top }
1858 message
$w.m
-text $msg -justify center
-aspect 400
1859 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1860 ${NS}::button
$w.ok
-default active
-text [$mc OK
] -command "destroy $top"
1861 pack
$w.ok
-side bottom
-fill x
1862 bind $top <Visibility
> "grab $top; focus $top"
1863 bind $top <Key-Return
> "destroy $top"
1864 bind $top <Key-space
> "destroy $top"
1865 bind $top <Key-Escape
> "destroy $top"
1869 proc error_popup
{msg
{owner .
}} {
1870 if {[tk windowingsystem
] eq
"win32"} {
1871 tk_messageBox
-icon error
-type ok
-title [wm title .
] \
1872 -parent $owner -message $msg
1876 make_transient
$w $owner
1877 show_error
$w $w $msg
1881 proc confirm_popup
{msg
{owner .
}} {
1882 global confirm_ok NS
1886 make_transient
$w $owner
1887 message
$w.m
-text $msg -justify center
-aspect 400
1888 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1889 ${NS}::button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1890 pack
$w.ok
-side left
-fill x
1891 ${NS}::button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1892 pack
$w.cancel
-side right
-fill x
1893 bind $w <Visibility
> "grab $w; focus $w"
1894 bind $w <Key-Return
> "set confirm_ok 1; destroy $w"
1895 bind $w <Key-space
> "set confirm_ok 1; destroy $w"
1896 bind $w <Key-Escape
> "destroy $w"
1897 tk
::PlaceWindow
$w widget
$owner
1902 proc setoptions
{} {
1903 if {[tk windowingsystem
] ne
"win32"} {
1904 option add
*Panedwindow.showHandle
1 startupFile
1905 option add
*Panedwindow.sashRelief raised startupFile
1906 if {[tk windowingsystem
] ne
"aqua"} {
1907 option add
*Menu.font uifont startupFile
1910 option add
*Menu.TearOff
0 startupFile
1912 option add
*Button.font uifont startupFile
1913 option add
*Checkbutton.font uifont startupFile
1914 option add
*Radiobutton.font uifont startupFile
1915 option add
*Menubutton.font uifont startupFile
1916 option add
*Label.font uifont startupFile
1917 option add
*Message.font uifont startupFile
1918 option add
*Entry.font textfont startupFile
1919 option add
*Text.font textfont startupFile
1920 option add
*Labelframe.font uifont startupFile
1921 option add
*Spinbox.font textfont startupFile
1922 option add
*Listbox.font mainfont startupFile
1925 # Make a menu and submenus.
1926 # m is the window name for the menu, items is the list of menu items to add.
1927 # Each item is a list {mc label type description options...}
1928 # mc is ignored; it's so we can put mc there to alert xgettext
1929 # label is the string that appears in the menu
1930 # type is cascade, command or radiobutton (should add checkbutton)
1931 # description depends on type; it's the sublist for cascade, the
1932 # command to invoke for command, or {variable value} for radiobutton
1933 proc makemenu
{m items
} {
1935 if {[tk windowingsystem
] eq
{aqua
}} {
1941 set name
[mc
[lindex
$i 1]]
1942 set type [lindex
$i 2]
1943 set thing
[lindex
$i 3]
1944 set params
[list
$type]
1946 set u
[string first
"&" [string map
{&& x
} $name]]
1947 lappend params
-label [string map
{&& & & {}} $name]
1949 lappend params
-underline $u
1954 set submenu
[string tolower
[string map
{& ""} [lindex
$i 1]]]
1955 lappend params
-menu $m.
$submenu
1958 lappend params
-command $thing
1961 lappend params
-variable [lindex
$thing 0] \
1962 -value [lindex
$thing 1]
1965 set tail [lrange
$i 4 end
]
1966 regsub
-all {\yMeta1\y
} $tail $Meta1 tail
1967 eval $m add
$params $tail
1968 if {$type eq
"cascade"} {
1969 makemenu
$m.
$submenu $thing
1974 # translate string and remove ampersands
1976 return [string map
{&& & & {}} [mc
$str]]
1979 proc makedroplist
{w varname args
} {
1983 foreach label
$args {
1984 set cx
[string length
$label]
1985 if {$cx > $width} {set width
$cx}
1987 set gm
[ttk
::combobox
$w -width $width -state readonly\
1988 -textvariable $varname -values $args]
1990 set gm
[eval [linsert
$args 0 tk_optionMenu
$w $varname]]
1995 proc makewindow
{} {
1996 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1998 global findtype findtypemenu findloc findstring fstring geometry
1999 global entries sha1entry sha1string sha1but
2000 global diffcontextstring diffcontext
2002 global maincursor textcursor curtextcursor
2003 global rowctxmenu fakerowmenu mergemax wrapcomment
2004 global highlight_files gdttype
2005 global searchstring sstring
2006 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2007 global headctxmenu progresscanv progressitem progresscoords statusw
2008 global fprogitem fprogcoord lastprogupdate progupdatepending
2009 global rprogitem rprogcoord rownumsel numcommits
2010 global have_tk85 use_ttk NS
2014 # The "mc" arguments here are purely so that xgettext
2015 # sees the following string as needing to be translated
2018 {mc
"Update" command updatecommits
-accelerator F5
}
2019 {mc
"Reload" command reloadcommits
-accelerator Meta1-F5
}
2020 {mc
"Reread references" command rereadrefs
}
2021 {mc
"List references" command showrefs
-accelerator F2
}
2023 {mc
"Start git gui" command {exec git gui
&}}
2025 {mc
"Quit" command doquit
-accelerator Meta1-Q
}
2029 {mc
"Preferences" command doprefs
}
2033 {mc
"New view..." command {newview
0} -accelerator Shift-F4
}
2034 {mc
"Edit view..." command editview
-state disabled
-accelerator F4
}
2035 {mc
"Delete view" command delview
-state disabled
}
2037 {mc
"All files" radiobutton
{selectedview
0} -command {showview
0}}
2039 if {[tk windowingsystem
] ne
"aqua"} {
2042 {mc
"About gitk" command about
}
2043 {mc
"Key bindings" command keys
}
2045 set bar
[list
$file $edit $view $help]
2047 proc
::tk
::mac
::ShowPreferences
{} {doprefs
}
2048 proc
::tk
::mac
::Quit
{} {doquit
}
2049 lset
file end
[lreplace
[lindex
$file end
] end-1 end
]
2051 xx
"Apple" cascade
{
2052 {mc
"About gitk" command about
}
2057 {mc
"Key bindings" command keys
}
2059 set bar
[list
$apple $file $view $help]
2062 . configure
-menu .bar
2065 # cover the non-themed toplevel with a themed frame.
2066 place
[ttk
::frame ._main_background
] -x 0 -y 0 -relwidth 1 -relheight 1
2069 # the gui has upper and lower half, parts of a paned window.
2070 ${NS}::panedwindow .ctop
-orient vertical
2072 # possibly use assumed geometry
2073 if {![info exists geometry
(pwsash0
)]} {
2074 set geometry
(topheight
) [expr {15 * $linespc}]
2075 set geometry
(topwidth
) [expr {80 * $charspc}]
2076 set geometry
(botheight
) [expr {15 * $linespc}]
2077 set geometry
(botwidth
) [expr {50 * $charspc}]
2078 set geometry
(pwsash0
) [list
[expr {40 * $charspc}] 2]
2079 set geometry
(pwsash1
) [list
[expr {60 * $charspc}] 2]
2082 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2083 ${NS}::frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
2084 ${NS}::frame .tf.histframe
2085 ${NS}::panedwindow .tf.histframe.pwclist
-orient horizontal
2087 .tf.histframe.pwclist configure
-sashpad 0 -handlesize 4
2090 # create three canvases
2091 set cscroll .tf.histframe.csb
2092 set canv .tf.histframe.pwclist.canv
2094 -selectbackground $selectbgcolor \
2095 -background $bgcolor -bd 0 \
2096 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2097 .tf.histframe.pwclist add
$canv
2098 set canv2 .tf.histframe.pwclist.canv2
2100 -selectbackground $selectbgcolor \
2101 -background $bgcolor -bd 0 -yscrollincr $linespc
2102 .tf.histframe.pwclist add
$canv2
2103 set canv3 .tf.histframe.pwclist.canv3
2105 -selectbackground $selectbgcolor \
2106 -background $bgcolor -bd 0 -yscrollincr $linespc
2107 .tf.histframe.pwclist add
$canv3
2109 bind .tf.histframe.pwclist
<Map
> {
2111 .tf.histframe.pwclist sashpos
1 [lindex $
::geometry
(pwsash1
) 0]
2112 .tf.histframe.pwclist sashpos
0 [lindex $
::geometry
(pwsash0
) 0]
2115 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
2116 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
2119 # a scroll bar to rule them
2120 ${NS}::scrollbar
$cscroll -command {allcanvs yview
}
2121 if {!$use_ttk} {$cscroll configure
-highlightthickness 0}
2122 pack
$cscroll -side right
-fill y
2123 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
2124 lappend bglist
$canv $canv2 $canv3
2125 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
2127 # we have two button bars at bottom of top frame. Bar 1
2128 ${NS}::frame .tf.bar
2129 ${NS}::frame .tf.lbar
-height 15
2131 set sha1entry .tf.bar.sha1
2132 set entries
$sha1entry
2133 set sha1but .tf.bar.sha1label
2134 button
$sha1but -text "[mc "SHA1 ID
:"] " -state disabled
-relief flat \
2135 -command gotocommit
-width 8
2136 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
2137 pack .tf.bar.sha1label
-side left
2138 ${NS}::entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
2139 trace add variable sha1string
write sha1change
2140 pack
$sha1entry -side left
-pady 2
2142 image create bitmap bm-left
-data {
2143 #define left_width 16
2144 #define left_height 16
2145 static unsigned char left_bits
[] = {
2146 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2147 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2148 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2150 image create bitmap bm-right
-data {
2151 #define right_width 16
2152 #define right_height 16
2153 static unsigned char right_bits
[] = {
2154 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2155 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2156 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2158 ${NS}::button .tf.bar.leftbut
-image bm-left
-command goback \
2159 -state disabled
-width 26
2160 pack .tf.bar.leftbut
-side left
-fill y
2161 ${NS}::button .tf.bar.rightbut
-image bm-right
-command goforw \
2162 -state disabled
-width 26
2163 pack .tf.bar.rightbut
-side left
-fill y
2165 ${NS}::label .tf.bar.rowlabel
-text [mc
"Row"]
2167 ${NS}::label .tf.bar.rownum
-width 7 -textvariable rownumsel \
2168 -relief sunken
-anchor e
2169 ${NS}::label .tf.bar.rowlabel2
-text "/"
2170 ${NS}::label .tf.bar.numcommits
-width 7 -textvariable numcommits \
2171 -relief sunken
-anchor e
2172 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2175 foreach w
{rownum numcommits
} {.tf.bar.
$w configure
-font textfont
}
2178 trace add variable selectedline
write selectedline_change
2180 # Status label and progress bar
2181 set statusw .tf.bar.status
2182 ${NS}::label
$statusw -width 15 -relief sunken
2183 pack
$statusw -side left
-padx 5
2185 set progresscanv
[ttk
::progressbar .tf.bar.progress
]
2187 set h
[expr {[font metrics uifont
-linespace] + 2}]
2188 set progresscanv .tf.bar.progress
2189 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
2190 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
2191 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
2192 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
2194 pack
$progresscanv -side right
-expand 1 -fill x
-padx {0 2}
2195 set progresscoords
{0 0}
2198 bind $progresscanv <Configure
> adjustprogress
2199 set lastprogupdate
[clock clicks
-milliseconds]
2200 set progupdatepending
0
2202 # build up the bottom bar of upper window
2203 ${NS}::label .tf.lbar.flabel
-text "[mc "Find
"] "
2204 ${NS}::button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
2205 ${NS}::button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
2206 ${NS}::label .tf.lbar.flab2
-text " [mc "commit
"] "
2207 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2209 set gdttype
[mc
"containing:"]
2210 set gm
[makedroplist .tf.lbar.gdttype gdttype \
2211 [mc
"containing:"] \
2212 [mc
"touching paths:"] \
2213 [mc
"adding/removing string:"]]
2214 trace add variable gdttype
write gdttype_change
2215 pack .tf.lbar.gdttype
-side left
-fill y
2218 set fstring .tf.lbar.findstring
2219 lappend entries
$fstring
2220 ${NS}::entry
$fstring -width 30 -textvariable findstring
2221 trace add variable findstring
write find_change
2222 set findtype
[mc
"Exact"]
2223 set findtypemenu
[makedroplist .tf.lbar.findtype \
2224 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
2225 trace add variable findtype
write findcom_change
2226 set findloc
[mc
"All fields"]
2227 makedroplist .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
2228 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
2229 trace add variable findloc
write find_change
2230 pack .tf.lbar.findloc
-side right
2231 pack .tf.lbar.findtype
-side right
2232 pack
$fstring -side left
-expand 1 -fill x
2234 # Finish putting the upper half of the viewer together
2235 pack .tf.lbar
-in .tf
-side bottom
-fill x
2236 pack .tf.bar
-in .tf
-side bottom
-fill x
2237 pack .tf.histframe
-fill both
-side top
-expand 1
2240 .ctop paneconfigure .tf
-height $geometry(topheight
)
2241 .ctop paneconfigure .tf
-width $geometry(topwidth
)
2244 # now build up the bottom
2245 ${NS}::panedwindow .pwbottom
-orient horizontal
2247 # lower left, a text box over search bar, scroll bar to the right
2248 # if we know window height, then that will set the lower text height, otherwise
2249 # we set lower text height which will drive window height
2250 if {[info exists geometry
(main
)]} {
2251 ${NS}::frame .bleft
-width $geometry(botwidth
)
2253 ${NS}::frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
2255 ${NS}::frame .bleft.top
2256 ${NS}::frame .bleft.mid
2257 ${NS}::frame .bleft.bottom
2259 ${NS}::button .bleft.top.search
-text [mc
"Search"] -command dosearch
2260 pack .bleft.top.search
-side left
-padx 5
2261 set sstring .bleft.top.sstring
2263 ${NS}::entry
$sstring -width 20 -textvariable searchstring
2264 lappend entries
$sstring
2265 trace add variable searchstring
write incrsearch
2266 pack
$sstring -side left
-expand 1 -fill x
2267 ${NS}::radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
2268 -command changediffdisp
-variable diffelide
-value {0 0}
2269 ${NS}::radiobutton .bleft.mid.old
-text [mc
"Old version"] \
2270 -command changediffdisp
-variable diffelide
-value {0 1}
2271 ${NS}::radiobutton .bleft.mid.new
-text [mc
"New version"] \
2272 -command changediffdisp
-variable diffelide
-value {1 0}
2273 ${NS}::label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
2274 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
2275 spinbox .bleft.mid.diffcontext
-width 5 \
2276 -from 0 -increment 1 -to 10000000 \
2277 -validate all
-validatecommand "diffcontextvalidate %P" \
2278 -textvariable diffcontextstring
2279 .bleft.mid.diffcontext
set $diffcontext
2280 trace add variable diffcontextstring
write diffcontextchange
2281 lappend entries .bleft.mid.diffcontext
2282 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
2283 ${NS}::checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
2284 -command changeignorespace
-variable ignorespace
2285 pack .bleft.mid.ignspace
-side left
-padx 5
2287 set worddiff
[mc
"Line diff"]
2288 if {[package vcompare
$git_version "1.7.2"] >= 0} {
2289 makedroplist .bleft.mid.worddiff worddiff
[mc
"Line diff"] \
2290 [mc
"Markup words"] [mc
"Color words"]
2291 trace add variable worddiff
write changeworddiff
2292 pack .bleft.mid.worddiff
-side left
-padx 5
2295 set ctext .bleft.bottom.ctext
2296 text
$ctext -background $bgcolor -foreground $fgcolor \
2297 -state disabled
-font textfont \
2298 -yscrollcommand scrolltext
-wrap none \
2299 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2301 $ctext conf
-tabstyle wordprocessor
2303 ${NS}::scrollbar .bleft.bottom.sb
-command "$ctext yview"
2304 ${NS}::scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h
2305 pack .bleft.top
-side top
-fill x
2306 pack .bleft.mid
-side top
-fill x
2307 grid
$ctext .bleft.bottom.sb
-sticky nsew
2308 grid .bleft.bottom.sbhorizontal
-sticky ew
2309 grid columnconfigure .bleft.bottom
0 -weight 1
2310 grid rowconfigure .bleft.bottom
0 -weight 1
2311 grid rowconfigure .bleft.bottom
1 -weight 0
2312 pack .bleft.bottom
-side top
-fill both
-expand 1
2313 lappend bglist
$ctext
2314 lappend fglist
$ctext
2316 $ctext tag conf comment
-wrap $wrapcomment
2317 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
2318 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
2319 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
2320 $ctext tag conf dresult
-fore [lindex
$diffcolors 1]
2321 $ctext tag conf m0
-fore red
2322 $ctext tag conf m1
-fore blue
2323 $ctext tag conf m2
-fore green
2324 $ctext tag conf m3
-fore purple
2325 $ctext tag conf
m4 -fore brown
2326 $ctext tag conf m5
-fore "#009090"
2327 $ctext tag conf m6
-fore magenta
2328 $ctext tag conf m7
-fore "#808000"
2329 $ctext tag conf m8
-fore "#009000"
2330 $ctext tag conf m9
-fore "#ff0080"
2331 $ctext tag conf m10
-fore cyan
2332 $ctext tag conf m11
-fore "#b07070"
2333 $ctext tag conf m12
-fore "#70b0f0"
2334 $ctext tag conf m13
-fore "#70f0b0"
2335 $ctext tag conf m14
-fore "#f0b070"
2336 $ctext tag conf m15
-fore "#ff70b0"
2337 $ctext tag conf mmax
-fore darkgrey
2339 $ctext tag conf mresult
-font textfontbold
2340 $ctext tag conf msep
-font textfontbold
2341 $ctext tag conf found
-back yellow
2343 .pwbottom add .bleft
2345 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
2349 ${NS}::frame .bright
2350 ${NS}::frame .bright.mode
2351 ${NS}::radiobutton .bright.mode.
patch -text [mc
"Patch"] \
2352 -command reselectline
-variable cmitmode
-value "patch"
2353 ${NS}::radiobutton .bright.mode.tree
-text [mc
"Tree"] \
2354 -command reselectline
-variable cmitmode
-value "tree"
2355 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
2356 pack .bright.mode
-side top
-fill x
2357 set cflist .bright.cfiles
2358 set indent
[font measure mainfont
"nn"]
2360 -selectbackground $selectbgcolor \
2361 -background $bgcolor -foreground $fgcolor \
2363 -tabs [list
$indent [expr {2 * $indent}]] \
2364 -yscrollcommand ".bright.sb set" \
2365 -cursor [. cget
-cursor] \
2366 -spacing1 1 -spacing3 1
2367 lappend bglist
$cflist
2368 lappend fglist
$cflist
2369 ${NS}::scrollbar .bright.sb
-command "$cflist yview"
2370 pack .bright.sb
-side right
-fill y
2371 pack
$cflist -side left
-fill both
-expand 1
2372 $cflist tag configure highlight \
2373 -background [$cflist cget
-selectbackground]
2374 $cflist tag configure bold
-font mainfontbold
2376 .pwbottom add .bright
2379 # restore window width & height if known
2380 if {[info exists geometry
(main
)]} {
2381 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
2382 if {$w > [winfo screenwidth .
]} {
2383 set w
[winfo screenwidth .
]
2385 if {$h > [winfo screenheight .
]} {
2386 set h
[winfo screenheight .
]
2388 wm geometry .
"${w}x$h"
2392 if {[info exists geometry
(state
)] && $geometry(state
) eq
"zoomed"} {
2393 wm state .
$geometry(state
)
2396 if {[tk windowingsystem
] eq
{aqua
}} {
2407 %W sashpos
0 $
::geometry
(topheight
)
2409 bind .pwbottom
<Map
> {
2411 %W sashpos
0 $
::geometry
(botwidth
)
2415 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2416 pack .ctop
-fill both
-expand 1
2417 bindall
<1> {selcanvline
%W
%x
%y
}
2418 #bindall <B1-Motion> {selcanvline %W %x %y}
2419 if {[tk windowingsystem
] == "win32"} {
2420 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2421 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2423 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2424 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2425 if {[tk windowingsystem
] eq
"aqua"} {
2426 bindall
<MouseWheel
> {
2427 set delta
[expr {- (%D
)}]
2428 allcanvs yview scroll
$delta units
2430 bindall
<Shift-MouseWheel
> {
2431 set delta
[expr {- (%D
)}]
2432 $canv xview scroll
$delta units
2436 bindall
<$
::BM
> "canvscan mark %W %x %y"
2437 bindall
<B$
::BM-Motion
> "canvscan dragto %W %x %y"
2438 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2439 bind .
<$M1B-Key-w> doquit
2440 bindkey
<Home
> selfirstline
2441 bindkey
<End
> sellastline
2442 bind .
<Key-Up
> "selnextline -1"
2443 bind .
<Key-Down
> "selnextline 1"
2444 bind .
<Shift-Key-Up
> "dofind -1 0"
2445 bind .
<Shift-Key-Down
> "dofind 1 0"
2446 bindkey
<Key-Right
> "goforw"
2447 bindkey
<Key-Left
> "goback"
2448 bind .
<Key-Prior
> "selnextpage -1"
2449 bind .
<Key-Next
> "selnextpage 1"
2450 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2451 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2452 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2453 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2454 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2455 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2456 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2457 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2458 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2459 bindkey p
"selnextline -1"
2460 bindkey n
"selnextline 1"
2463 bindkey k
"selnextline -1"
2464 bindkey j
"selnextline 1"
2468 bindkey d
"$ctext yview scroll 18 units"
2469 bindkey u
"$ctext yview scroll -18 units"
2470 bindkey
/ {focus
$fstring}
2471 bindkey
<Key-KP_Divide
> {focus
$fstring}
2472 bindkey
<Key-Return
> {dofind
1 1}
2473 bindkey ?
{dofind
-1 1}
2475 bind .
<F5
> updatecommits
2476 bind .
<$M1B-F5> reloadcommits
2477 bind .
<F2
> showrefs
2478 bind .
<Shift-F4
> {newview
0}
2479 catch
{ bind .
<Shift-Key-XF86_Switch_VT_4
> {newview
0} }
2480 bind .
<F4
> edit_or_newview
2481 bind .
<$M1B-q> doquit
2482 bind .
<$M1B-f> {dofind
1 1}
2483 bind .
<$M1B-g> {dofind
1 0}
2484 bind .
<$M1B-r> dosearchback
2485 bind .
<$M1B-s> dosearch
2486 bind .
<$M1B-equal> {incrfont
1}
2487 bind .
<$M1B-plus> {incrfont
1}
2488 bind .
<$M1B-KP_Add> {incrfont
1}
2489 bind .
<$M1B-minus> {incrfont
-1}
2490 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2491 wm protocol . WM_DELETE_WINDOW doquit
2492 bind .
<Destroy
> {stop_backends
}
2493 bind .
<Button-1
> "click %W"
2494 bind $fstring <Key-Return
> {dofind
1 1}
2495 bind $sha1entry <Key-Return
> {gotocommit
; break}
2496 bind $sha1entry <<PasteSelection>> clearsha1
2497 bind $cflist <1> {sel_flist %W %x %y; break}
2498 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2499 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2501 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2502 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2503 bind $ctext <Button-1> {focus %W}
2505 set maincursor [. cget -cursor]
2506 set textcursor [$ctext cget -cursor]
2507 set curtextcursor $textcursor
2509 set rowctxmenu .rowctxmenu
2510 makemenu $rowctxmenu {
2511 {mc "Diff this -> selected" command {diffvssel 0}}
2512 {mc "Diff selected -> this" command {diffvssel 1}}
2513 {mc "Make patch" command mkpatch}
2514 {mc "Create tag" command mktag}
2515 {mc "Write commit to file" command writecommit}
2516 {mc "Create new branch" command mkbranch}
2517 {mc "Cherry-pick this commit" command cherrypick}
2518 {mc "Reset HEAD branch to here" command resethead}
2519 {mc "Mark this commit" command markhere}
2520 {mc "Return to mark" command gotomark}
2521 {mc "Find descendant of this and mark" command find_common_desc}
2522 {mc "Compare with marked commit" command compare_commits}
2524 $rowctxmenu configure -tearoff 0
2526 set fakerowmenu .fakerowmenu
2527 makemenu $fakerowmenu {
2528 {mc "Diff this -> selected" command {diffvssel 0}}
2529 {mc "Diff selected -> this" command {diffvssel 1}}
2530 {mc "Make patch" command mkpatch}
2532 $fakerowmenu configure -tearoff 0
2534 set headctxmenu .headctxmenu
2535 makemenu $headctxmenu {
2536 {mc "Check out this branch" command cobranch}
2537 {mc "Remove this branch" command rmbranch}
2539 $headctxmenu configure -tearoff 0
2542 set flist_menu .flistctxmenu
2543 makemenu $flist_menu {
2544 {mc "Highlight this too" command {flist_hl 0}}
2545 {mc "Highlight this only" command {flist_hl 1}}
2546 {mc "External diff" command {external_diff}}
2547 {mc "Blame parent commit" command {external_blame 1}}
2549 $flist_menu configure -tearoff 0
2552 set diff_menu .diffctxmenu
2553 makemenu $diff_menu {
2554 {mc "Show origin of this line" command show_line_source}
2555 {mc "Run git gui blame on this line" command {external_blame_diff}}
2557 $diff_menu configure -tearoff 0
2560 # Windows sends all mouse wheel events to the current focused window, not
2561 # the one where the mouse hovers, so bind those events here and redirect
2562 # to the correct window
2563 proc windows_mousewheel_redirector {W X Y D} {
2564 global canv canv2 canv3
2565 set w [winfo containing -displayof $W $X $Y]
2567 set u [expr {$D < 0 ? 5 : -5}]
2568 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2569 allcanvs yview scroll $u units
2572 $w yview scroll $u units
2578 # Update row number label when selectedline changes
2579 proc selectedline_change {n1 n2 op} {
2580 global selectedline rownumsel
2582 if {$selectedline eq {}} {
2585 set rownumsel [expr {$selectedline + 1}]
2589 # mouse-2 makes all windows scan vertically, but only the one
2590 # the cursor is in scans horizontally
2591 proc canvscan {op w x y} {
2592 global canv canv2 canv3
2593 foreach c [list $canv $canv2 $canv3] {
2602 proc scrollcanv {cscroll f0 f1} {
2603 $cscroll set $f0 $f1
2608 # when we make a key binding for the toplevel, make sure
2609 # it doesn't get triggered when that key is pressed in the
2610 # find string entry widget.
2611 proc bindkey {ev script} {
2614 set escript [bind Entry $ev]
2615 if {$escript == {}} {
2616 set escript [bind Entry <Key>]
2618 foreach e $entries {
2619 bind $e $ev "$escript; break"
2623 # set the focus back to the toplevel for any click outside
2626 global ctext entries
2627 foreach e [concat $entries $ctext] {
2628 if {$w == $e} return
2633 # Adjust the progress bar for a change in requested extent or canvas size
2634 proc adjustprogress {} {
2635 global progresscanv progressitem progresscoords
2636 global fprogitem fprogcoord lastprogupdate progupdatepending
2637 global rprogitem rprogcoord use_ttk
2640 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2644 set w [expr {[winfo width $progresscanv] - 4}]
2645 set x0 [expr {$w * [lindex $progresscoords 0]}]
2646 set x1 [expr {$w * [lindex $progresscoords 1]}]
2647 set h [winfo height $progresscanv]
2648 $progresscanv coords $progressitem $x0 0 $x1 $h
2649 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2650 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2651 set now [clock clicks -milliseconds]
2652 if {$now >= $lastprogupdate + 100} {
2653 set progupdatepending 0
2655 } elseif {!$progupdatepending} {
2656 set progupdatepending 1
2657 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2661 proc doprogupdate {} {
2662 global lastprogupdate progupdatepending
2664 if {$progupdatepending} {
2665 set progupdatepending 0
2666 set lastprogupdate [clock clicks -milliseconds]
2671 proc savestuff {w} {
2672 global canv canv2 canv3 mainfont textfont uifont tabstop
2673 global stuffsaved findmergefiles maxgraphpct
2674 global maxwidth showneartags showlocalchanges
2675 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2676 global cmitmode wrapcomment datetimeformat limitdiffs
2677 global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2678 global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2679 global hideremotes want_ttk
2681 if {$stuffsaved} return
2682 if {![winfo viewable .]} return
2684 if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2685 set f [open "~/.gitk-new" w]
2686 if {$::tcl_platform(platform) eq {windows}} {
2687 file attributes "~/.gitk-new" -hidden true
2689 puts $f [list set mainfont $mainfont]
2690 puts $f [list set textfont $textfont]
2691 puts $f [list set uifont $uifont]
2692 puts $f [list set tabstop $tabstop]
2693 puts $f [list set findmergefiles $findmergefiles]
2694 puts $f [list set maxgraphpct $maxgraphpct]
2695 puts $f [list set maxwidth $maxwidth]
2696 puts $f [list set cmitmode $cmitmode]
2697 puts $f [list set wrapcomment $wrapcomment]
2698 puts $f [list set autoselect $autoselect]
2699 puts $f [list set autosellen $autosellen]
2700 puts $f [list set showneartags $showneartags]
2701 puts $f [list set hideremotes $hideremotes]
2702 puts $f [list set showlocalchanges $showlocalchanges]
2703 puts $f [list set datetimeformat $datetimeformat]
2704 puts $f [list set limitdiffs $limitdiffs]
2705 puts $f [list set uicolor $uicolor]
2706 puts $f [list set want_ttk $want_ttk]
2707 puts $f [list set bgcolor $bgcolor]
2708 puts $f [list set fgcolor $fgcolor]
2709 puts $f [list set colors $colors]
2710 puts $f [list set diffcolors $diffcolors]
2711 puts $f [list set markbgcolor $markbgcolor]
2712 puts $f [list set diffcontext $diffcontext]
2713 puts $f [list set selectbgcolor $selectbgcolor]
2714 puts $f [list set extdifftool $extdifftool]
2715 puts $f [list set perfile_attrs $perfile_attrs]
2717 puts $f "set geometry(main) [wm geometry .]"
2718 puts $f "set geometry(state) [wm state .]"
2719 puts $f "set geometry(topwidth) [winfo width .tf]"
2720 puts $f "set geometry(topheight) [winfo height .tf]"
2722 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2723 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2725 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2726 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2728 puts $f "set geometry(botwidth) [winfo width .bleft]"
2729 puts $f "set geometry(botheight) [winfo height .bleft]"
2731 puts -nonewline $f "set permviews {"
2732 for {set v 0} {$v < $nextviewnum} {incr v} {
2733 if {$viewperm($v)} {
2734 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2739 file rename -force "~/.gitk-new" "~/.gitk"
2744 proc resizeclistpanes {win w} {
2745 global oldwidth use_ttk
2746 if {[info exists oldwidth($win)]} {
2748 set s0 [$win sashpos 0]
2749 set s1 [$win sashpos 1]
2751 set s0 [$win sash coord 0]
2752 set s1 [$win sash coord 1]
2755 set sash0 [expr {int($w/2 - 2)}]
2756 set sash1 [expr {int($w*5/6 - 2)}]
2758 set factor [expr {1.0 * $w / $oldwidth($win)}]
2759 set sash0 [expr {int($factor * [lindex $s0 0])}]
2760 set sash1 [expr {int($factor * [lindex $s1 0])}]
2764 if {$sash1 < $sash0 + 20} {
2765 set sash1 [expr {$sash0 + 20}]
2767 if {$sash1 > $w - 10} {
2768 set sash1 [expr {$w - 10}]
2769 if {$sash0 > $sash1 - 20} {
2770 set sash0 [expr {$sash1 - 20}]
2775 $win sashpos 0 $sash0
2776 $win sashpos 1 $sash1
2778 $win sash place 0 $sash0 [lindex $s0 1]
2779 $win sash place 1 $sash1 [lindex $s1 1]
2782 set oldwidth($win) $w
2785 proc resizecdetpanes {win w} {
2786 global oldwidth use_ttk
2787 if {[info exists oldwidth($win)]} {
2789 set s0 [$win sashpos 0]
2791 set s0 [$win sash coord 0]
2794 set sash0 [expr {int($w*3/4 - 2)}]
2796 set factor [expr {1.0 * $w / $oldwidth($win)}]
2797 set sash0 [expr {int($factor * [lindex $s0 0])}]
2801 if {$sash0 > $w - 15} {
2802 set sash0 [expr {$w - 15}]
2806 $win sashpos 0 $sash0
2808 $win sash place 0 $sash0 [lindex $s0 1]
2811 set oldwidth($win) $w
2814 proc allcanvs args {
2815 global canv canv2 canv3
2821 proc bindall {event action} {
2822 global canv canv2 canv3
2823 bind $canv $event $action
2824 bind $canv2 $event $action
2825 bind $canv3 $event $action
2831 if {[winfo exists $w]} {
2836 wm title $w [mc "About gitk"]
2838 message $w.m -text [mc "
2839 Gitk - a commit viewer for git
2841 Copyright \u00a9 2005-2011 Paul Mackerras
2843 Use and redistribute under the terms of the GNU General Public License"] \
2844 -justify center -aspect 400 -border 2 -bg white -relief groove
2845 pack $w.m -side top -fill x -padx 2 -pady 2
2846 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2847 pack $w.ok -side bottom
2848 bind $w <Visibility> "focus $w.ok"
2849 bind $w <Key-Escape> "destroy $w"
2850 bind $w <Key-Return> "destroy $w"
2851 tk::PlaceWindow $w widget .
2857 if {[winfo exists $w]} {
2861 if {[tk windowingsystem] eq {aqua}} {
2867 wm title $w [mc "Gitk key bindings"]
2869 message $w.m -text "
2870 [mc "Gitk key bindings:"]
2872 [mc "<%s-Q> Quit" $M1T]
2873 [mc "<%s-W> Close window" $M1T]
2874 [mc "<Home> Move to first commit"]
2875 [mc "<End> Move to last commit"]
2876 [mc "<Up>, p, k Move up one commit"]
2877 [mc "<Down>, n, j Move down one commit"]
2878 [mc "<Left>, z, h Go back in history list"]
2879 [mc "<Right>, x, l Go forward in history list"]
2880 [mc "<PageUp> Move up one page in commit list"]
2881 [mc "<PageDown> Move down one page in commit list"]
2882 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2883 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2884 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2885 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2886 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2887 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2888 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2889 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2890 [mc "<Delete>, b Scroll diff view up one page"]
2891 [mc "<Backspace> Scroll diff view up one page"]
2892 [mc "<Space> Scroll diff view down one page"]
2893 [mc "u Scroll diff view up 18 lines"]
2894 [mc "d Scroll diff view down 18 lines"]
2895 [mc "<%s-F> Find" $M1T]
2896 [mc "<%s-G> Move to next find hit" $M1T]
2897 [mc "<Return> Move to next find hit"]
2898 [mc "/ Focus the search box"]
2899 [mc "? Move to previous find hit"]
2900 [mc "f Scroll diff view to next file"]
2901 [mc "<%s-S> Search for next hit in diff view" $M1T]
2902 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2903 [mc "<%s-KP+> Increase font size" $M1T]
2904 [mc "<%s-plus> Increase font size" $M1T]
2905 [mc "<%s-KP-> Decrease font size" $M1T]
2906 [mc "<%s-minus> Decrease font size" $M1T]
2909 -justify left -bg white -border 2 -relief groove
2910 pack $w.m -side top -fill both -padx 2 -pady 2
2911 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2912 bind $w <Key-Escape> [list destroy $w]
2913 pack $w.ok -side bottom
2914 bind $w <Visibility> "focus $w.ok"
2915 bind $w <Key-Escape> "destroy $w"
2916 bind $w <Key-Return> "destroy $w"
2919 # Procedures for manipulating the file list window at the
2920 # bottom right of the overall window.
2922 proc treeview {w l openlevs} {
2923 global treecontents treediropen treeheight treeparent treeindex
2933 set treecontents() {}
2934 $w conf -state normal
2936 while {[string range $f 0 $prefixend] ne $prefix} {
2937 if {$lev <= $openlevs} {
2938 $w mark set e:$treeindex($prefix) "end -1c"
2939 $w mark gravity e:$treeindex($prefix) left
2941 set treeheight($prefix) $ht
2942 incr ht [lindex $htstack end]
2943 set htstack [lreplace $htstack end end]
2944 set prefixend [lindex $prefendstack end]
2945 set prefendstack [lreplace $prefendstack end end]
2946 set prefix [string range $prefix 0 $prefixend]
2949 set tail [string range $f [expr {$prefixend+1}] end]
2950 while {[set slash [string first "/" $tail]] >= 0} {
2953 lappend prefendstack $prefixend
2954 incr prefixend [expr {$slash + 1}]
2955 set d [string range $tail 0 $slash]
2956 lappend treecontents($prefix) $d
2957 set oldprefix $prefix
2959 set treecontents($prefix) {}
2960 set treeindex($prefix) [incr ix]
2961 set treeparent($prefix) $oldprefix
2962 set tail [string range $tail [expr {$slash+1}] end]
2963 if {$lev <= $openlevs} {
2965 set treediropen($prefix) [expr {$lev < $openlevs}]
2966 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2967 $w mark set d:$ix "end -1c"
2968 $w mark gravity d:$ix left
2970 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2972 $w image create end -align center -image $bm -padx 1 \
2974 $w insert end $d [highlight_tag $prefix]
2975 $w mark set s:$ix "end -1c"
2976 $w mark gravity s:$ix left
2981 if {$lev <= $openlevs} {
2984 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2986 $w insert end $tail [highlight_tag $f]
2988 lappend treecontents($prefix) $tail
2991 while {$htstack ne {}} {
2992 set treeheight($prefix) $ht
2993 incr ht [lindex $htstack end]
2994 set htstack [lreplace $htstack end end]
2995 set prefixend [lindex $prefendstack end]
2996 set prefendstack [lreplace $prefendstack end end]
2997 set prefix [string range $prefix 0 $prefixend]
2999 $w conf -state disabled
3002 proc linetoelt {l} {
3003 global treeheight treecontents
3008 foreach e $treecontents($prefix) {
3013 if {[string index $e end] eq "/"} {
3014 set n $treeheight($prefix$e)
3026 proc highlight_tree {y prefix} {
3027 global treeheight treecontents cflist
3029 foreach e $treecontents($prefix) {
3031 if {[highlight_tag $path] ne {}} {
3032 $cflist tag add bold $y.0 "$y.0 lineend"
3035 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3036 set y [highlight_tree $y $path]
3042 proc treeclosedir {w dir} {
3043 global treediropen treeheight treeparent treeindex
3045 set ix $treeindex($dir)
3046 $w conf -state normal
3047 $w delete s:$ix e:$ix
3048 set treediropen($dir) 0
3049 $w image configure a:$ix -image tri-rt
3050 $w conf -state disabled
3051 set n [expr {1 - $treeheight($dir)}]
3052 while {$dir ne {}} {
3053 incr treeheight($dir) $n
3054 set dir $treeparent($dir)
3058 proc treeopendir {w dir} {
3059 global treediropen treeheight treeparent treecontents treeindex
3061 set ix $treeindex($dir)
3062 $w conf -state normal
3063 $w image configure a:$ix -image tri-dn
3064 $w mark set e:$ix s:$ix
3065 $w mark gravity e:$ix right
3068 set n [llength $treecontents($dir)]
3069 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3072 incr treeheight($x) $n
3074 foreach e $treecontents($dir) {
3076 if {[string index $e end] eq "/"} {
3077 set iy $treeindex($de)
3078 $w mark set d:$iy e:$ix
3079 $w mark gravity d:$iy left
3080 $w insert e:$ix $str
3081 set treediropen($de) 0
3082 $w image create e:$ix -align center -image tri-rt -padx 1 \
3084 $w insert e:$ix $e [highlight_tag $de]
3085 $w mark set s:$iy e:$ix
3086 $w mark gravity s:$iy left
3087 set treeheight($de) 1
3089 $w insert e:$ix $str
3090 $w insert e:$ix $e [highlight_tag $de]
3093 $w mark gravity e:$ix right
3094 $w conf -state disabled
3095 set treediropen($dir) 1
3096 set top [lindex [split [$w index @0,0] .] 0]
3097 set ht [$w cget -height]
3098 set l [lindex [split [$w index s:$ix] .] 0]
3101 } elseif {$l + $n + 1 > $top + $ht} {
3102 set top [expr {$l + $n + 2 - $ht}]
3110 proc treeclick {w x y} {
3111 global treediropen cmitmode ctext cflist cflist_top
3113 if {$cmitmode ne "tree"} return
3114 if {![info exists cflist_top]} return
3115 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3116 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3117 $cflist tag add highlight $l.0 "$l.0 lineend"
3123 set e [linetoelt $l]
3124 if {[string index $e end] ne "/"} {
3126 } elseif {$treediropen($e)} {
3133 proc setfilelist {id} {
3134 global treefilelist cflist jump_to_here
3136 treeview $cflist $treefilelist($id) 0
3137 if {$jump_to_here ne {}} {
3138 set f [lindex $jump_to_here 0]
3139 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3145 image create bitmap tri-rt -background black -foreground blue -data {
3146 #define tri-rt_width 13
3147 #define tri-rt_height 13
3148 static unsigned char tri-rt_bits[] = {
3149 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3150 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3153 #define tri-rt-mask_width 13
3154 #define tri-rt-mask_height 13
3155 static unsigned char tri-rt-mask_bits[] = {
3156 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3157 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3160 image create bitmap tri-dn -background black -foreground blue -data {
3161 #define tri-dn_width 13
3162 #define tri-dn_height 13
3163 static unsigned char tri-dn_bits[] = {
3164 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3165 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3168 #define tri-dn-mask_width 13
3169 #define tri-dn-mask_height 13
3170 static unsigned char tri-dn-mask_bits[] = {
3171 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3172 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3176 image create bitmap reficon-T -background black -foreground yellow -data {
3177 #define tagicon_width 13
3178 #define tagicon_height 9
3179 static unsigned char tagicon_bits[] = {
3180 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3181 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3183 #define tagicon-mask_width 13
3184 #define tagicon-mask_height 9
3185 static unsigned char tagicon-mask_bits[] = {
3186 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3187 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3190 #define headicon_width 13
3191 #define headicon_height 9
3192 static unsigned char headicon_bits[] = {
3193 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3194 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3197 #define headicon-mask_width 13
3198 #define headicon-mask_height 9
3199 static unsigned char headicon-mask_bits[] = {
3200 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3201 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3203 image create bitmap reficon-H -background black -foreground green \
3204 -data $rectdata -maskdata $rectmask
3205 image create bitmap reficon-o -background black -foreground "#ddddff" \
3206 -data $rectdata -maskdata $rectmask
3208 proc init_flist {first} {
3209 global cflist cflist_top difffilestart
3211 $cflist conf -state normal
3212 $cflist delete 0.0 end
3214 $cflist insert end $first
3216 $cflist tag add highlight 1.0 "1.0 lineend"
3218 catch {unset cflist_top}
3220 $cflist conf -state disabled
3221 set difffilestart {}
3224 proc highlight_tag {f} {
3225 global highlight_paths
3227 foreach p $highlight_paths {
3228 if {[string match $p $f]} {
3235 proc highlight_filelist {} {
3236 global cmitmode cflist
3238 $cflist conf -state normal
3239 if {$cmitmode ne "tree"} {
3240 set end [lindex [split [$cflist index end] .] 0]
3241 for {set l 2} {$l < $end} {incr l} {
3242 set line [$cflist get $l.0 "$l.0 lineend"]
3243 if {[highlight_tag $line] ne {}} {
3244 $cflist tag add bold $l.0 "$l.0 lineend"
3250 $cflist conf -state disabled
3253 proc unhighlight_filelist {} {
3256 $cflist conf -state normal
3257 $cflist tag remove bold 1.0 end
3258 $cflist conf -state disabled
3261 proc add_flist {fl} {
3264 $cflist conf -state normal
3266 $cflist insert end "\n"
3267 $cflist insert end $f [highlight_tag $f]
3269 $cflist conf -state disabled
3272 proc sel_flist {w x y} {
3273 global ctext difffilestart cflist cflist_top cmitmode
3275 if {$cmitmode eq "tree"} return
3276 if {![info exists cflist_top]} return
3277 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3278 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3279 $cflist tag add highlight $l.0 "$l.0 lineend"
3284 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3288 proc pop_flist_menu {w X Y x y} {
3289 global ctext cflist cmitmode flist_menu flist_menu_file
3290 global treediffs diffids
3293 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3295 if {$cmitmode eq "tree"} {
3296 set e [linetoelt $l]
3297 if {[string index $e end] eq "/"} return
3299 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3301 set flist_menu_file $e
3302 set xdiffstate "normal"
3303 if {$cmitmode eq "tree"} {
3304 set xdiffstate "disabled"
3306 # Disable "External diff" item in tree mode
3307 $flist_menu entryconf 2 -state $xdiffstate
3308 tk_popup $flist_menu $X $Y
3311 proc find_ctext_fileinfo {line} {
3312 global ctext_file_names ctext_file_lines
3314 set ok [bsearch $ctext_file_lines $line]
3315 set tline [lindex $ctext_file_lines $ok]
3317 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3320 return [list [lindex $ctext_file_names $ok] $tline]
3324 proc pop_diff_menu {w X Y x y} {
3325 global ctext diff_menu flist_menu_file
3326 global diff_menu_txtpos diff_menu_line
3327 global diff_menu_filebase
3329 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3330 set diff_menu_line [lindex $diff_menu_txtpos 0]
3331 # don't pop up the menu on hunk-separator or file-separator lines
3332 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3336 set f [find_ctext_fileinfo $diff_menu_line]
3337 if {$f eq {}} return
3338 set flist_menu_file [lindex $f 0]
3339 set diff_menu_filebase [lindex $f 1]
3340 tk_popup $diff_menu $X $Y
3343 proc flist_hl {only} {
3344 global flist_menu_file findstring gdttype
3346 set x [shellquote $flist_menu_file]
3347 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3350 append findstring " " $x
3352 set gdttype [mc "touching paths:"]
3355 proc gitknewtmpdir {} {
3356 global diffnum gitktmpdir gitdir
3358 if {![info exists gitktmpdir]} {
3359 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3360 if {[catch {file mkdir $gitktmpdir} err]} {
3361 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3368 set diffdir [file join $gitktmpdir $diffnum]
3369 if {[catch {file mkdir $diffdir} err]} {
3370 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3376 proc save_file_from_commit {filename output what} {
3379 if {[catch {exec git show $filename -- > $output} err]} {
3380 if {[string match "fatal: bad revision *" $err]} {
3383 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3389 proc external_diff_get_one_file {diffid filename diffdir} {
3390 global nullid nullid2 nullfile
3393 if {$diffid == $nullid} {
3394 set difffile [file join $worktree $filename]
3395 if {[file exists $difffile]} {
3400 if {$diffid == $nullid2} {
3401 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3402 return [save_file_from_commit :$filename $difffile index]
3404 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3405 return [save_file_from_commit $diffid:$filename $difffile \
3409 proc external_diff {} {
3410 global nullid nullid2
3411 global flist_menu_file
3415 if {[llength $diffids] == 1} {
3416 # no reference commit given
3417 set diffidto [lindex $diffids 0]
3418 if {$diffidto eq $nullid} {
3419 # diffing working copy with index
3420 set diffidfrom $nullid2
3421 } elseif {$diffidto eq $nullid2} {
3422 # diffing index with HEAD
3423 set diffidfrom "HEAD"
3425 # use first parent commit
3426 global parentlist selectedline
3427 set diffidfrom [lindex $parentlist $selectedline 0]
3430 set diffidfrom [lindex $diffids 0]
3431 set diffidto [lindex $diffids 1]
3434 # make sure that several diffs wont collide
3435 set diffdir [gitknewtmpdir]
3436 if {$diffdir eq {}} return
3438 # gather files to diff
3439 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3440 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3442 if {$difffromfile ne {} && $difftofile ne {}} {
3443 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3444 if {[catch {set fl [open |$cmd r]} err]} {
3445 file delete -force $diffdir
3446 error_popup "$extdifftool: [mc "command failed:"] $err"
3448 fconfigure $fl -blocking 0
3449 filerun $fl [list delete_at_eof $fl $diffdir]
3454 proc find_hunk_blamespec {base line} {
3457 # Find and parse the hunk header
3458 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3459 if {$s_lix eq {}} return
3461 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3462 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3463 s_line old_specs osz osz1 new_line nsz]} {
3467 # base lines for the parents
3468 set base_lines [list $new_line]
3469 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3470 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3471 old_spec old_line osz]} {
3474 lappend base_lines $old_line
3477 # Now scan the lines to determine offset within the hunk
3478 set max_parent [expr {[llength $base_lines]-2}]
3480 set s_lno [lindex [split $s_lix "."] 0]
3482 # Determine if the line is removed
3483 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3484 if {[string match {[-+ ]*} $chunk]} {
3485 set removed_idx [string first "-" $chunk]
3486 # Choose a parent index
3487 if {$removed_idx >= 0} {
3488 set parent $removed_idx
3490 set unchanged_idx [string first " " $chunk]
3491 if {$unchanged_idx >= 0} {
3492 set parent $unchanged_idx
3494 # blame the current commit
3498 # then count other lines that belong to it
3499 for {set i $line} {[incr i -1] > $s_lno} {} {
3500 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3501 # Determine if the line is removed
3502 set removed_idx [string first "-" $chunk]
3504 set code [string index $chunk $parent]
3505 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3509 if {$removed_idx < 0} {
3519 incr dline [lindex $base_lines $parent]
3520 return [list $parent $dline]
3523 proc external_blame_diff {} {
3524 global currentid cmitmode
3525 global diff_menu_txtpos diff_menu_line
3526 global diff_menu_filebase flist_menu_file
3528 if {$cmitmode eq "tree"} {
3530 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3532 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3534 set parent_idx [lindex $hinfo 0]
3535 set line [lindex $hinfo 1]
3542 external_blame $parent_idx $line
3545 # Find the SHA1 ID of the blob for file $fname in the index
3547 proc index_sha1 {fname} {
3548 set f [open [list | git ls-files -s $fname] r]
3549 while {[gets $f line] >= 0} {
3550 set info [lindex [split $line "\t"] 0]
3551 set stage [lindex $info 2]
3552 if {$stage eq "0" || $stage eq "2"} {
3554 return [lindex $info 1]
3561 # Turn an absolute path into one relative to the current directory
3562 proc make_relative {f} {
3563 if {[file pathtype $f] eq "relative"} {
3566 set elts [file split $f]
3567 set here [file split [pwd]]
3572 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3579 set elts [concat $res [lrange $elts $ei end]]
3580 return [eval file join $elts]
3583 proc external_blame {parent_idx {line {}}} {
3584 global flist_menu_file cdup
3585 global nullid nullid2
3586 global parentlist selectedline currentid
3588 if {$parent_idx > 0} {
3589 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3591 set base_commit $currentid
3594 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3595 error_popup [mc "No such commit"]
3599 set cmdline [list git gui blame]
3600 if {$line ne {} && $line > 1} {
3601 lappend cmdline "--line=$line"
3603 set f [file join $cdup $flist_menu_file]
3604 # Unfortunately it seems git gui blame doesn't like
3605 # being given an absolute path...
3606 set f [make_relative $f]
3607 lappend cmdline $base_commit $f
3608 if {[catch {eval exec $cmdline &} err]} {
3609 error_popup "[mc "git gui blame: command failed:"] $err"
3613 proc show_line_source {} {
3614 global cmitmode currentid parents curview blamestuff blameinst
3615 global diff_menu_line diff_menu_filebase flist_menu_file
3616 global nullid nullid2 gitdir cdup
3619 if {$cmitmode eq "tree"} {
3621 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3623 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3624 if {$h eq {}} return
3625 set pi [lindex $h 0]
3627 mark_ctext_line $diff_menu_line
3631 if {$currentid eq $nullid} {
3633 # must be a merge in progress...
3635 # get the last line from .git/MERGE_HEAD
3636 set f [open [file join $gitdir MERGE_HEAD] r]
3637 set id [lindex [split [read $f] "\n"] end-1]
3640 error_popup [mc "Couldn't read merge head: %s" $err]
3643 } elseif {$parents($curview,$currentid) eq $nullid2} {
3644 # need to do the blame from the index
3646 set from_index [index_sha1 $flist_menu_file]
3648 error_popup [mc "Error reading index: %s" $err]
3652 set id $parents($curview,$currentid)
3655 set id [lindex $parents($curview,$currentid) $pi]
3657 set line [lindex $h 1]
3660 if {$from_index ne {}} {
3661 lappend blameargs | git cat-file blob $from_index
3663 lappend blameargs | git blame -p -L$line,+1
3664 if {$from_index ne {}} {
3665 lappend blameargs --contents -
3667 lappend blameargs $id
3669 lappend blameargs -- [file join $cdup $flist_menu_file]
3671 set f [open $blameargs r]
3673 error_popup [mc "Couldn't start git blame: %s" $err]
3676 nowbusy blaming [mc "Searching"]
3677 fconfigure $f -blocking 0
3678 set i [reg_instance $f]
3679 set blamestuff($i) {}
3681 filerun $f [list read_line_source $f $i]
3684 proc stopblaming {} {
3687 if {[info exists blameinst]} {
3688 stop_instance $blameinst
3694 proc read_line_source {fd inst} {
3695 global blamestuff curview commfd blameinst nullid nullid2
3697 while {[gets $fd line] >= 0} {
3698 lappend blamestuff($inst) $line
3706 fconfigure $fd -blocking 1
3707 if {[catch {close $fd} err]} {
3708 error_popup [mc "Error running git blame: %s" $err]
3713 set line [split [lindex $blamestuff($inst) 0] " "]
3714 set id [lindex $line 0]
3715 set lnum [lindex $line 1]
3716 if {[string length $id] == 40 && [string is xdigit $id] &&
3717 [string is digit -strict $lnum]} {
3718 # look for "filename" line
3719 foreach l $blamestuff($inst) {
3720 if {[string match "filename *" $l]} {
3721 set fname [string range $l 9 end]
3727 # all looks good, select it
3728 if {$id eq $nullid} {
3729 # blame uses all-zeroes to mean not committed,
3730 # which would mean a change in the index
3733 if {[commitinview $id $curview]} {
3734 selectline [rowofcommit $id] 1 [list $fname $lnum]
3736 error_popup [mc "That line comes from commit %s, \
3737 which is not in this view" [shortids $id]]
3740 puts "oops couldn't parse git blame output"
3745 # delete $dir when we see eof on $f (presumably because the child has exited)
3746 proc delete_at_eof {f dir} {
3747 while {[gets $f line] >= 0} {}
3749 if {[catch {close $f} err]} {
3750 error_popup "[mc "External diff viewer failed:"] $err"
3752 file delete -force $dir
3758 # Functions for adding and removing shell-type quoting
3760 proc shellquote {str} {
3761 if {![string match "*\['\"\\ \t]*" $str]} {
3764 if {![string match "*\['\"\\]*" $str]} {
3767 if {![string match "*'*" $str]} {
3770 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3773 proc shellarglist {l} {
3779 append str [shellquote $a]
3784 proc shelldequote {str} {
3789 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3790 append ret [string range $str $used end]
3791 set used [string length $str]
3794 set first [lindex $first 0]
3795 set ch [string index $str $first]
3796 if {$first > $used} {
3797 append ret [string range $str $used [expr {$first - 1}]]
3800 if {$ch eq " " || $ch eq "\t"} break
3803 set first [string first "'" $str $used]
3805 error "unmatched single-quote"
3807 append ret [string range $str $used [expr {$first - 1}]]
3812 if {$used >= [string length $str]} {
3813 error "trailing backslash"
3815 append ret [string index $str $used]
3820 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3821 error "unmatched double-quote"
3823 set first [lindex $first 0]
3824 set ch [string index $str $first]
3825 if {$first > $used} {
3826 append ret [string range $str $used [expr {$first - 1}]]
3829 if {$ch eq "\""} break
3831 append ret [string index $str $used]
3835 return [list $used $ret]
3838 proc shellsplit {str} {
3841 set str [string trimleft $str]
3842 if {$str eq {}} break
3843 set dq [shelldequote $str]
3844 set n [lindex $dq 0]
3845 set word [lindex $dq 1]
3846 set str [string range $str $n end]
3852 # Code to implement multiple views
3854 proc newview {ishighlight} {
3855 global nextviewnum newviewname newishighlight
3856 global revtreeargs viewargscmd newviewopts curview
3858 set newishighlight $ishighlight
3860 if {[winfo exists $top]} {
3864 decode_view_opts $nextviewnum $revtreeargs
3865 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3866 set newviewopts($nextviewnum,perm) 0
3867 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3868 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3871 set known_view_options {
3872 {perm b . {} {mc "Remember this view"}}
3873 {reflabel l + {} {mc "References (space separated list):"}}
3874 {refs t15 .. {} {mc "Branches & tags:"}}
3875 {allrefs b *. "--all" {mc "All refs"}}
3876 {branches b . "--branches" {mc "All (local) branches"}}
3877 {tags b . "--tags" {mc "All tags"}}
3878 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
3879 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
3880 {author t15 .. "--author=*" {mc "Author:"}}
3881 {committer t15 . "--committer=*" {mc "Committer:"}}
3882 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
3883 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
3884 {changes_l l + {} {mc "Changes to Files:"}}
3885 {pickaxe_s r0 . {} {mc "Fixed String"}}
3886 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
3887 {pickaxe t15 .. "-S*" {mc "Search string:"}}
3888 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3889 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
3890 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
3891 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
3892 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
3893 {skip t10 . "--skip=*" {mc "Number to skip:"}}
3894 {misc_lbl l + {} {mc "Miscellaneous options:"}}
3895 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
3896 {lright b . "--left-right" {mc "Mark branch sides"}}
3897 {first b . "--first-parent" {mc "Limit to first parent"}}
3898 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
3899 {args t50 *. {} {mc "Additional arguments to git log:"}}
3900 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
3901 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3904 # Convert $newviewopts($n, ...) into args for git log.
3905 proc encode_view_opts {n} {
3906 global known_view_options newviewopts
3909 foreach opt $known_view_options {
3910 set patterns [lindex $opt 3]
3911 if {$patterns eq {}} continue
3912 set pattern [lindex $patterns 0]
3914 if {[lindex $opt 1] eq "b"} {
3915 set val $newviewopts($n,[lindex $opt 0])
3917 lappend rargs $pattern
3919 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
3920 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
3921 set val $newviewopts($n,$button_id)
3922 if {$val eq $value} {
3923 lappend rargs $pattern
3926 set val $newviewopts($n,[lindex $opt 0])
3927 set val [string trim $val]
3929 set pfix [string range $pattern 0 end-1]
3930 lappend rargs $pfix$val
3934 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
3935 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3938 # Fill $newviewopts($n, ...) based on args for git log.
3939 proc decode_view_opts {n view_args} {
3940 global known_view_options newviewopts
3942 foreach opt $known_view_options {
3943 set id [lindex $opt 0]
3944 if {[lindex $opt 1] eq "b"} {
3947 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
3949 regexp {^(.*_)} $id uselessvar id
3955 set newviewopts($n,$id) $val
3959 foreach arg $view_args {
3960 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3961 && ![info exists found(limit)]} {
3962 set newviewopts($n,limit) $cnt
3967 foreach opt $known_view_options {
3968 set id [lindex $opt 0]
3969 if {[info exists found($id)]} continue
3970 foreach pattern [lindex $opt 3] {
3971 if {![string match $pattern $arg]} continue
3972 if {[lindex $opt 1] eq "b"} {
3975 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
3977 regexp {^(.*_)} $id uselessvar id
3981 set size [string length $pattern]
3982 set val [string range $arg [expr {$size-1}] end]
3984 set newviewopts($n,$id) $val
3988 if {[info exists val]} break
3990 if {[info exists val]} continue
3991 if {[regexp {^-} $arg]} {
3994 lappend refargs $arg
3997 set newviewopts($n,refs) [shellarglist $refargs]
3998 set newviewopts($n,args) [shellarglist $oargs]
4001 proc edit_or_newview {} {
4013 global viewname viewperm newviewname newviewopts
4014 global viewargs viewargscmd
4016 set top .gitkvedit-$curview
4017 if {[winfo exists $top]} {
4021 decode_view_opts $curview $viewargs($curview)
4022 set newviewname($curview) $viewname($curview)
4023 set newviewopts($curview,perm) $viewperm($curview)
4024 set newviewopts($curview,cmd) $viewargscmd($curview)
4025 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4028 proc vieweditor {top n title} {
4029 global newviewname newviewopts viewfiles bgcolor
4030 global known_view_options NS
4033 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4034 make_transient $top .
4037 ${NS}::frame $top.nfr
4038 ${NS}::label $top.nl -text [mc "View Name"]
4039 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4040 pack $top.nfr -in $top -fill x -pady 5 -padx 3
4041 pack $top.nl -in $top.nfr -side left -padx {0 5}
4042 pack $top.name -in $top.nfr -side left -padx {0 25}
4048 foreach opt $known_view_options {
4049 set id [lindex $opt 0]
4050 set type [lindex $opt 1]
4051 set flags [lindex $opt 2]
4052 set title [eval [lindex $opt 4]]
4055 if {$flags eq "+" || $flags eq "*"} {
4056 set cframe $top.fr$cnt
4058 ${NS}::frame $cframe
4059 pack $cframe -in $top -fill x -pady 3 -padx 3
4060 set cexpand [expr {$flags eq "*"}]
4061 } elseif {$flags eq ".." || $flags eq "*."} {
4062 set cframe $top.fr$cnt
4064 ${NS}::frame $cframe
4065 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4066 set cexpand [expr {$flags eq "*."}]
4072 ${NS}::label $cframe.l_$id -text $title
4073 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4074 } elseif {$type eq "b"} {
4075 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4076 pack $cframe.c_$id -in $cframe -side left \
4077 -padx [list $lxpad 0] -expand $cexpand -anchor w
4078 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4079 regexp {^(.*_)} $id uselessvar button_id
4080 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4081 pack $cframe.c_$id -in $cframe -side left \
4082 -padx [list $lxpad 0] -expand $cexpand -anchor w
4083 } elseif {[regexp {^t(\d+)$} $type type sz]} {
4084 ${NS}::label $cframe.l_$id -text $title
4085 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4086 -textvariable newviewopts($n,$id)
4087 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4088 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4089 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4090 ${NS}::label $cframe.l_$id -text $title
4091 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4092 -textvariable newviewopts($n,$id)
4093 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4094 pack $cframe.e_$id -in $cframe -side top -fill x
4095 } elseif {$type eq "path"} {
4096 ${NS}::label $top.l -text $title
4097 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4098 text $top.t -width 40 -height 5 -background $bgcolor
4099 if {[info exists viewfiles($n)]} {
4100 foreach f $viewfiles($n) {
4101 $top.t insert end $f
4102 $top.t insert end "\n"
4104 $top.t delete {end - 1c} end
4105 $top.t mark set insert 0.0
4107 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4111 ${NS}::frame $top.buts
4112 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4113 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4114 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4115 bind $top <Control-Return> [list newviewok $top $n]
4116 bind $top <F5> [list newviewok $top $n 1]
4117 bind $top <Escape> [list destroy $top]
4118 grid $top.buts.ok $top.buts.apply $top.buts.can
4119 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4120 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4121 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4122 pack $top.buts -in $top -side top -fill x
4126 proc doviewmenu {m first cmd op argv} {
4127 set nmenu [$m index end]
4128 for {set i $first} {$i <= $nmenu} {incr i} {
4129 if {[$m entrycget $i -command] eq $cmd} {
4130 eval $m $op $i $argv
4136 proc allviewmenus {n op args} {
4139 doviewmenu .bar.view 5 [list showview $n] $op $args
4140 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4143 proc newviewok {top n {apply 0}} {
4144 global nextviewnum newviewperm newviewname newishighlight
4145 global viewname viewfiles viewperm selectedview curview
4146 global viewargs viewargscmd newviewopts viewhlmenu
4149 set newargs [encode_view_opts $n]
4151 error_popup "[mc "Error in commit selection arguments:"] $err" $top
4155 foreach f [split [$top.t get 0.0 end] "\n"] {
4156 set ft [string trim $f]
4161 if {![info exists viewfiles($n)]} {
4162 # creating a new view
4164 set viewname($n) $newviewname($n)
4165 set viewperm($n) $newviewopts($n,perm)
4166 set viewfiles($n) $files
4167 set viewargs($n) $newargs
4168 set viewargscmd($n) $newviewopts($n,cmd)
4170 if {!$newishighlight} {
4173 run addvhighlight $n
4176 # editing an existing view
4177 set viewperm($n) $newviewopts($n,perm)
4178 if {$newviewname($n) ne $viewname($n)} {
4179 set viewname($n) $newviewname($n)
4180 doviewmenu .bar.view 5 [list showview $n] \
4181 entryconf [list -label $viewname($n)]
4182 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4183 # entryconf [list -label $viewname($n) -value $viewname($n)]
4185 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4186 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4187 set viewfiles($n) $files
4188 set viewargs($n) $newargs
4189 set viewargscmd($n) $newviewopts($n,cmd)
4190 if {$curview == $n} {
4196 catch {destroy $top}
4200 global curview viewperm hlview selectedhlview
4202 if {$curview == 0} return
4203 if {[info exists hlview] && $hlview == $curview} {
4204 set selectedhlview [mc "None"]
4207 allviewmenus $curview delete
4208 set viewperm($curview) 0
4212 proc addviewmenu {n} {
4213 global viewname viewhlmenu
4215 .bar.view add radiobutton -label $viewname($n) \
4216 -command [list showview $n] -variable selectedview -value $n
4217 #$viewhlmenu add radiobutton -label $viewname($n) \
4218 # -command [list addvhighlight $n] -variable selectedhlview
4222 global curview cached_commitrow ordertok
4223 global displayorder parentlist rowidlist rowisopt rowfinal
4224 global colormap rowtextx nextcolor canvxmax
4225 global numcommits viewcomplete
4226 global selectedline currentid canv canvy0
4228 global pending_select mainheadid
4231 global hlview selectedhlview commitinterest
4233 if {$n == $curview} return
4235 set ymax [lindex [$canv cget -scrollregion] 3]
4236 set span [$canv yview]
4237 set ytop [expr {[lindex $span 0] * $ymax}]
4238 set ybot [expr {[lindex $span 1] * $ymax}]
4239 set yscreen [expr {($ybot - $ytop) / 2}]
4240 if {$selectedline ne {}} {
4241 set selid $currentid
4242 set y [yc $selectedline]
4243 if {$ytop < $y && $y < $ybot} {
4244 set yscreen [expr {$y - $ytop}]
4246 } elseif {[info exists pending_select]} {
4247 set selid $pending_select
4248 unset pending_select
4252 catch {unset treediffs}
4254 if {[info exists hlview] && $hlview == $n} {
4256 set selectedhlview [mc "None"]
4258 catch {unset commitinterest}
4259 catch {unset cached_commitrow}
4260 catch {unset ordertok}
4264 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4265 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4268 if {![info exists viewcomplete($n)]} {
4278 set numcommits $commitidx($n)
4280 catch {unset colormap}
4281 catch {unset rowtextx}
4283 set canvxmax [$canv cget -width]
4289 if {$selid ne {} && [commitinview $selid $n]} {
4290 set row [rowofcommit $selid]
4291 # try to get the selected row in the same position on the screen
4292 set ymax [lindex [$canv cget -scrollregion] 3]
4293 set ytop [expr {[yc $row] - $yscreen}]
4297 set yf [expr {$ytop * 1.0 / $ymax}]
4299 allcanvs yview moveto $yf
4303 } elseif {!$viewcomplete($n)} {
4304 reset_pending_select $selid
4306 reset_pending_select {}
4308 if {[commitinview $pending_select $curview]} {
4309 selectline [rowofcommit $pending_select] 1
4311 set row [first_real_row]
4312 if {$row < $numcommits} {
4317 if {!$viewcomplete($n)} {
4318 if {$numcommits == 0} {
4319 show_status [mc "Reading commits..."]
4321 } elseif {$numcommits == 0} {
4322 show_status [mc "No commits selected"]
4326 # Stuff relating to the highlighting facility
4328 proc ishighlighted {id} {
4329 global vhighlights fhighlights nhighlights rhighlights
4331 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4332 return $nhighlights($id)
4334 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4335 return $vhighlights($id)
4337 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4338 return $fhighlights($id)
4340 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4341 return $rhighlights($id)
4346 proc bolden {id font} {
4347 global canv linehtag currentid boldids need_redisplay markedid
4349 # need_redisplay = 1 means the display is stale and about to be redrawn
4350 if {$need_redisplay} return
4352 $canv itemconf $linehtag($id) -font $font
4353 if {[info exists currentid] && $id eq $currentid} {
4355 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4356 -outline {{}} -tags secsel \
4357 -fill [$canv cget -selectbackground]]
4360 if {[info exists markedid] && $id eq $markedid} {
4365 proc bolden_name {id font} {
4366 global canv2 linentag currentid boldnameids need_redisplay
4368 if {$need_redisplay} return
4369 lappend boldnameids $id
4370 $canv2 itemconf $linentag($id) -font $font
4371 if {[info exists currentid] && $id eq $currentid} {
4372 $canv2 delete secsel
4373 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4374 -outline {{}} -tags secsel \
4375 -fill [$canv2 cget -selectbackground]]
4384 foreach id $boldids {
4385 if {![ishighlighted $id]} {
4388 lappend stillbold $id
4391 set boldids $stillbold
4394 proc addvhighlight {n} {
4395 global hlview viewcomplete curview vhl_done commitidx
4397 if {[info exists hlview]} {
4401 if {$n != $curview && ![info exists viewcomplete($n)]} {
4404 set vhl_done $commitidx($hlview)
4405 if {$vhl_done > 0} {
4410 proc delvhighlight {} {
4411 global hlview vhighlights
4413 if {![info exists hlview]} return
4415 catch {unset vhighlights}
4419 proc vhighlightmore {} {
4420 global hlview vhl_done commitidx vhighlights curview
4422 set max $commitidx($hlview)
4423 set vr [visiblerows]
4424 set r0 [lindex $vr 0]
4425 set r1 [lindex $vr 1]
4426 for {set i $vhl_done} {$i < $max} {incr i} {
4427 set id [commitonrow $i $hlview]
4428 if {[commitinview $id $curview]} {
4429 set row [rowofcommit $id]
4430 if {$r0 <= $row && $row <= $r1} {
4431 if {![highlighted $row]} {
4432 bolden $id mainfontbold
4434 set vhighlights($id) 1
4442 proc askvhighlight {row id} {
4443 global hlview vhighlights iddrawn
4445 if {[commitinview $id $hlview]} {
4446 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4447 bolden $id mainfontbold
4449 set vhighlights($id) 1
4451 set vhighlights($id) 0
4455 proc hfiles_change {} {
4456 global highlight_files filehighlight fhighlights fh_serial
4457 global highlight_paths
4459 if {[info exists filehighlight]} {
4460 # delete previous highlights
4461 catch {close $filehighlight}
4463 catch {unset fhighlights}
4465 unhighlight_filelist
4467 set highlight_paths {}
4468 after cancel do_file_hl $fh_serial
4470 if {$highlight_files ne {}} {
4471 after 300 do_file_hl $fh_serial
4475 proc gdttype_change {name ix op} {
4476 global gdttype highlight_files findstring findpattern
4479 if {$findstring ne {}} {
4480 if {$gdttype eq [mc "containing:"]} {
4481 if {$highlight_files ne {}} {
4482 set highlight_files {}
4487 if {$findpattern ne {}} {
4491 set highlight_files $findstring
4496 # enable/disable findtype/findloc menus too
4499 proc find_change {name ix op} {
4500 global gdttype findstring highlight_files
4503 if {$gdttype eq [mc "containing:"]} {
4506 if {$highlight_files ne $findstring} {
4507 set highlight_files $findstring
4514 proc findcom_change args {
4515 global nhighlights boldnameids
4516 global findpattern findtype findstring gdttype
4519 # delete previous highlights, if any
4520 foreach id $boldnameids {
4521 bolden_name $id mainfont
4524 catch {unset nhighlights}
4527 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4529 } elseif {$findtype eq [mc "Regexp"]} {
4530 set findpattern $findstring
4532 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4534 set findpattern "*$e*"
4538 proc makepatterns {l} {
4541 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4542 if {[string index $ee end] eq "/"} {
4552 proc do_file_hl {serial} {
4553 global highlight_files filehighlight highlight_paths gdttype fhl_list
4554 global cdup findtype
4556 if {$gdttype eq [mc "touching paths:"]} {
4557 # If "exact" match then convert backslashes to forward slashes.
4558 # Most useful to support Windows-flavoured file paths.
4559 if {$findtype eq [mc "Exact"]} {
4560 set highlight_files [string map {"\\" "/"} $highlight_files]
4562 if {[catch {set paths [shellsplit $highlight_files]}]} return
4563 set highlight_paths [makepatterns $paths]
4565 set relative_paths {}
4566 foreach path $paths {
4567 lappend relative_paths [file join $cdup $path]
4569 set gdtargs [concat -- $relative_paths]
4570 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4571 set gdtargs [list "-S$highlight_files"]
4573 # must be "containing:", i.e. we're searching commit info
4576 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4577 set filehighlight [open $cmd r+]
4578 fconfigure $filehighlight -blocking 0
4579 filerun $filehighlight readfhighlight
4585 proc flushhighlights {} {
4586 global filehighlight fhl_list
4588 if {[info exists filehighlight]} {
4590 puts $filehighlight ""
4591 flush $filehighlight
4595 proc askfilehighlight {row id} {
4596 global filehighlight fhighlights fhl_list
4598 lappend fhl_list $id
4599 set fhighlights($id) -1
4600 puts $filehighlight $id
4603 proc readfhighlight {} {
4604 global filehighlight fhighlights curview iddrawn
4605 global fhl_list find_dirn
4607 if {![info exists filehighlight]} {
4611 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4612 set line [string trim $line]
4613 set i [lsearch -exact $fhl_list $line]
4614 if {$i < 0} continue
4615 for {set j 0} {$j < $i} {incr j} {
4616 set id [lindex $fhl_list $j]
4617 set fhighlights($id) 0
4619 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4620 if {$line eq {}} continue
4621 if {![commitinview $line $curview]} continue
4622 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4623 bolden $line mainfontbold
4625 set fhighlights($line) 1
4627 if {[eof $filehighlight]} {
4629 puts "oops, git diff-tree died"
4630 catch {close $filehighlight}
4634 if {[info exists find_dirn]} {
4640 proc doesmatch {f} {
4641 global findtype findpattern
4643 if {$findtype eq [mc "Regexp"]} {
4644 return [regexp $findpattern $f]
4645 } elseif {$findtype eq [mc "IgnCase"]} {
4646 return [string match -nocase $findpattern $f]
4648 return [string match $findpattern $f]
4652 proc askfindhighlight {row id} {
4653 global nhighlights commitinfo iddrawn
4655 global markingmatches
4657 if {![info exists commitinfo($id)]} {
4660 set info $commitinfo($id)
4662 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4663 foreach f $info ty $fldtypes {
4664 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4666 if {$ty eq [mc "Author"]} {
4673 if {$isbold && [info exists iddrawn($id)]} {
4674 if {![ishighlighted $id]} {
4675 bolden $id mainfontbold
4677 bolden_name $id mainfontbold
4680 if {$markingmatches} {
4681 markrowmatches $row $id
4684 set nhighlights($id) $isbold
4687 proc markrowmatches {row id} {
4688 global canv canv2 linehtag linentag commitinfo findloc
4690 set headline [lindex $commitinfo($id) 0]
4691 set author [lindex $commitinfo($id) 1]
4692 $canv delete match$row
4693 $canv2 delete match$row
4694 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4695 set m [findmatches $headline]
4697 markmatches $canv $row $headline $linehtag($id) $m \
4698 [$canv itemcget $linehtag($id) -font] $row
4701 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4702 set m [findmatches $author]
4704 markmatches $canv2 $row $author $linentag($id) $m \
4705 [$canv2 itemcget $linentag($id) -font] $row
4710 proc vrel_change {name ix op} {
4711 global highlight_related
4714 if {$highlight_related ne [mc "None"]} {
4719 # prepare for testing whether commits are descendents or ancestors of a
4720 proc rhighlight_sel {a} {
4721 global descendent desc_todo ancestor anc_todo
4722 global highlight_related
4724 catch {unset descendent}
4725 set desc_todo [list $a]
4726 catch {unset ancestor}
4727 set anc_todo [list $a]
4728 if {$highlight_related ne [mc "None"]} {
4734 proc rhighlight_none {} {
4737 catch {unset rhighlights}
4741 proc is_descendent {a} {
4742 global curview children descendent desc_todo
4745 set la [rowofcommit $a]
4749 for {set i 0} {$i < [llength $todo]} {incr i} {
4750 set do [lindex $todo $i]
4751 if {[rowofcommit $do] < $la} {
4752 lappend leftover $do
4755 foreach nk $children($v,$do) {
4756 if {![info exists descendent($nk)]} {
4757 set descendent($nk) 1
4765 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4769 set descendent($a) 0
4770 set desc_todo $leftover
4773 proc is_ancestor {a} {
4774 global curview parents ancestor anc_todo
4777 set la [rowofcommit $a]
4781 for {set i 0} {$i < [llength $todo]} {incr i} {
4782 set do [lindex $todo $i]
4783 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4784 lappend leftover $do
4787 foreach np $parents($v,$do) {
4788 if {![info exists ancestor($np)]} {
4797 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4802 set anc_todo $leftover
4805 proc askrelhighlight {row id} {
4806 global descendent highlight_related iddrawn rhighlights
4807 global selectedline ancestor
4809 if {$selectedline eq {}} return
4811 if {$highlight_related eq [mc "Descendant"] ||
4812 $highlight_related eq [mc "Not descendant"]} {
4813 if {![info exists descendent($id)]} {
4816 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4819 } elseif {$highlight_related eq [mc "Ancestor"] ||
4820 $highlight_related eq [mc "Not ancestor"]} {
4821 if {![info exists ancestor($id)]} {
4824 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4828 if {[info exists iddrawn($id)]} {
4829 if {$isbold && ![ishighlighted $id]} {
4830 bolden $id mainfontbold
4833 set rhighlights($id) $isbold
4836 # Graph layout functions
4838 proc shortids {ids} {
4841 if {[llength $id] > 1} {
4842 lappend res [shortids $id]
4843 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4844 lappend res [string range $id 0 7]
4855 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4856 if {($n & $mask) != 0} {
4857 set ret [concat $ret $o]
4859 set o [concat $o $o]
4864 proc ordertoken {id} {
4865 global ordertok curview varcid varcstart varctok curview parents children
4866 global nullid nullid2
4868 if {[info exists ordertok($id)]} {
4869 return $ordertok($id)
4874 if {[info exists varcid($curview,$id)]} {
4875 set a $varcid($curview,$id)
4876 set p [lindex $varcstart($curview) $a]
4878 set p [lindex $children($curview,$id) 0]
4880 if {[info exists ordertok($p)]} {
4881 set tok $ordertok($p)
4884 set id [first_real_child $curview,$p]
4887 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4890 if {[llength $parents($curview,$id)] == 1} {
4891 lappend todo [list $p {}]
4893 set j [lsearch -exact $parents($curview,$id) $p]
4895 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4897 lappend todo [list $p [strrep $j]]
4900 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4901 set p [lindex $todo $i 0]
4902 append tok [lindex $todo $i 1]
4903 set ordertok($p) $tok
4905 set ordertok($origid) $tok
4909 # Work out where id should go in idlist so that order-token
4910 # values increase from left to right
4911 proc idcol {idlist id {i 0}} {
4912 set t [ordertoken $id]
4916 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4917 if {$i > [llength $idlist]} {
4918 set i [llength $idlist]
4920 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4923 if {$t > [ordertoken [lindex $idlist $i]]} {
4924 while {[incr i] < [llength $idlist] &&
4925 $t >= [ordertoken [lindex $idlist $i]]} {}
4931 proc initlayout {} {
4932 global rowidlist rowisopt rowfinal displayorder parentlist
4933 global numcommits canvxmax canv
4935 global colormap rowtextx
4944 set canvxmax [$canv cget -width]
4945 catch {unset colormap}
4946 catch {unset rowtextx}
4950 proc setcanvscroll {} {
4951 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4952 global lastscrollset lastscrollrows
4954 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4955 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4956 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4957 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4958 set lastscrollset [clock clicks -milliseconds]
4959 set lastscrollrows $numcommits
4962 proc visiblerows {} {
4963 global canv numcommits linespc
4965 set ymax [lindex [$canv cget -scrollregion] 3]
4966 if {$ymax eq {} || $ymax == 0} return
4968 set y0 [expr {int([lindex $f 0] * $ymax)}]
4969 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4973 set y1 [expr {int([lindex $f 1] * $ymax)}]
4974 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4975 if {$r1 >= $numcommits} {
4976 set r1 [expr {$numcommits - 1}]
4978 return [list $r0 $r1]
4981 proc layoutmore {} {
4982 global commitidx viewcomplete curview
4983 global numcommits pending_select curview
4984 global lastscrollset lastscrollrows
4986 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4987 [clock clicks -milliseconds] - $lastscrollset > 500} {
4990 if {[info exists pending_select] &&
4991 [commitinview $pending_select $curview]} {
4993 selectline [rowofcommit $pending_select] 1
4998 # With path limiting, we mightn't get the actual HEAD commit,
4999 # so ask git rev-list what is the first ancestor of HEAD that
5000 # touches a file in the path limit.
5001 proc get_viewmainhead {view} {
5002 global viewmainheadid vfilelimit viewinstances mainheadid
5005 set rfd [open [concat | git rev-list -1 $mainheadid \
5006 -- $vfilelimit($view)] r]
5007 set j [reg_instance $rfd]
5008 lappend viewinstances($view) $j
5009 fconfigure $rfd -blocking 0
5010 filerun $rfd [list getviewhead $rfd $j $view]
5011 set viewmainheadid($curview) {}
5015 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5016 proc getviewhead {fd inst view} {
5017 global viewmainheadid commfd curview viewinstances showlocalchanges
5020 if {[gets $fd line] < 0} {
5024 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5027 set viewmainheadid($view) $id
5030 set i [lsearch -exact $viewinstances($view) $inst]
5032 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5034 if {$showlocalchanges && $id ne {} && $view == $curview} {
5040 proc doshowlocalchanges {} {
5041 global curview viewmainheadid
5043 if {$viewmainheadid($curview) eq {}} return
5044 if {[commitinview $viewmainheadid($curview) $curview]} {
5047 interestedin $viewmainheadid($curview) dodiffindex
5051 proc dohidelocalchanges {} {
5052 global nullid nullid2 lserial curview
5054 if {[commitinview $nullid $curview]} {
5055 removefakerow $nullid
5057 if {[commitinview $nullid2 $curview]} {
5058 removefakerow $nullid2
5063 # spawn off a process to do git diff-index --cached HEAD
5064 proc dodiffindex {} {
5065 global lserial showlocalchanges vfilelimit curview
5068 if {!$showlocalchanges || !$hasworktree} return
5070 set cmd "|git diff-index --cached HEAD"
5071 if {$vfilelimit($curview) ne {}} {
5072 set cmd [concat $cmd -- $vfilelimit($curview)]
5074 set fd [open $cmd r]
5075 fconfigure $fd -blocking 0
5076 set i [reg_instance $fd]
5077 filerun $fd [list readdiffindex $fd $lserial $i]
5080 proc readdiffindex {fd serial inst} {
5081 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5085 if {[gets $fd line] < 0} {
5091 # we only need to see one line and we don't really care what it says...
5094 if {$serial != $lserial} {
5098 # now see if there are any local changes not checked in to the index
5099 set cmd "|git diff-files"
5100 if {$vfilelimit($curview) ne {}} {
5101 set cmd [concat $cmd -- $vfilelimit($curview)]
5103 set fd [open $cmd r]
5104 fconfigure $fd -blocking 0
5105 set i [reg_instance $fd]
5106 filerun $fd [list readdifffiles $fd $serial $i]
5108 if {$isdiff && ![commitinview $nullid2 $curview]} {
5109 # add the line for the changes in the index to the graph
5110 set hl [mc "Local changes checked in to index but not committed"]
5111 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5112 set commitdata($nullid2) "\n $hl\n"
5113 if {[commitinview $nullid $curview]} {
5114 removefakerow $nullid
5116 insertfakerow $nullid2 $viewmainheadid($curview)
5117 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5118 if {[commitinview $nullid $curview]} {
5119 removefakerow $nullid
5121 removefakerow $nullid2
5126 proc readdifffiles {fd serial inst} {
5127 global viewmainheadid nullid nullid2 curview
5128 global commitinfo commitdata lserial
5131 if {[gets $fd line] < 0} {
5137 # we only need to see one line and we don't really care what it says...
5140 if {$serial != $lserial} {
5144 if {$isdiff && ![commitinview $nullid $curview]} {
5145 # add the line for the local diff to the graph
5146 set hl [mc "Local uncommitted changes, not checked in to index"]
5147 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5148 set commitdata($nullid) "\n $hl\n"
5149 if {[commitinview $nullid2 $curview]} {
5152 set p $viewmainheadid($curview)
5154 insertfakerow $nullid $p
5155 } elseif {!$isdiff && [commitinview $nullid $curview]} {
5156 removefakerow $nullid
5161 proc nextuse {id row} {
5162 global curview children
5164 if {[info exists children($curview,$id)]} {
5165 foreach kid $children($curview,$id) {
5166 if {![commitinview $kid $curview]} {
5169 if {[rowofcommit $kid] > $row} {
5170 return [rowofcommit $kid]
5174 if {[commitinview $id $curview]} {
5175 return [rowofcommit $id]
5180 proc prevuse {id row} {
5181 global curview children
5184 if {[info exists children($curview,$id)]} {
5185 foreach kid $children($curview,$id) {
5186 if {![commitinview $kid $curview]} break
5187 if {[rowofcommit $kid] < $row} {
5188 set ret [rowofcommit $kid]
5195 proc make_idlist {row} {
5196 global displayorder parentlist uparrowlen downarrowlen mingaplen
5197 global commitidx curview children
5199 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5203 set ra [expr {$row - $downarrowlen}]
5207 set rb [expr {$row + $uparrowlen}]
5208 if {$rb > $commitidx($curview)} {
5209 set rb $commitidx($curview)
5211 make_disporder $r [expr {$rb + 1}]
5213 for {} {$r < $ra} {incr r} {
5214 set nextid [lindex $displayorder [expr {$r + 1}]]
5215 foreach p [lindex $parentlist $r] {
5216 if {$p eq $nextid} continue
5217 set rn [nextuse $p $r]
5219 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5220 lappend ids [list [ordertoken $p] $p]
5224 for {} {$r < $row} {incr r} {
5225 set nextid [lindex $displayorder [expr {$r + 1}]]
5226 foreach p [lindex $parentlist $r] {
5227 if {$p eq $nextid} continue
5228 set rn [nextuse $p $r]
5229 if {$rn < 0 || $rn >= $row} {
5230 lappend ids [list [ordertoken $p] $p]
5234 set id [lindex $displayorder $row]
5235 lappend ids [list [ordertoken $id] $id]
5237 foreach p [lindex $parentlist $r] {
5238 set firstkid [lindex $children($curview,$p) 0]
5239 if {[rowofcommit $firstkid] < $row} {
5240 lappend ids [list [ordertoken $p] $p]
5244 set id [lindex $displayorder $r]
5246 set firstkid [lindex $children($curview,$id) 0]
5247 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5248 lappend ids [list [ordertoken $id] $id]
5253 foreach idx [lsort -unique $ids] {
5254 lappend idlist [lindex $idx 1]
5259 proc rowsequal {a b} {
5260 while {[set i [lsearch -exact $a {}]] >= 0} {
5261 set a [lreplace $a $i $i]
5263 while {[set i [lsearch -exact $b {}]] >= 0} {
5264 set b [lreplace $b $i $i]
5266 return [expr {$a eq $b}]
5269 proc makeupline {id row rend col} {
5270 global rowidlist uparrowlen downarrowlen mingaplen
5272 for {set r $rend} {1} {set r $rstart} {
5273 set rstart [prevuse $id $r]
5274 if {$rstart < 0} return
5275 if {$rstart < $row} break
5277 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5278 set rstart [expr {$rend - $uparrowlen - 1}]
5280 for {set r $rstart} {[incr r] <= $row} {} {
5281 set idlist [lindex $rowidlist $r]
5282 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5283 set col [idcol $idlist $id $col]
5284 lset rowidlist $r [linsert $idlist $col $id]
5290 proc layoutrows {row endrow} {
5291 global rowidlist rowisopt rowfinal displayorder
5292 global uparrowlen downarrowlen maxwidth mingaplen
5293 global children parentlist
5294 global commitidx viewcomplete curview
5296 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5299 set rm1 [expr {$row - 1}]
5300 foreach id [lindex $rowidlist $rm1] {
5305 set final [lindex $rowfinal $rm1]
5307 for {} {$row < $endrow} {incr row} {
5308 set rm1 [expr {$row - 1}]
5309 if {$rm1 < 0 || $idlist eq {}} {
5310 set idlist [make_idlist $row]
5313 set id [lindex $displayorder $rm1]
5314 set col [lsearch -exact $idlist $id]
5315 set idlist [lreplace $idlist $col $col]
5316 foreach p [lindex $parentlist $rm1] {
5317 if {[lsearch -exact $idlist $p] < 0} {
5318 set col [idcol $idlist $p $col]
5319 set idlist [linsert $idlist $col $p]
5320 # if not the first child, we have to insert a line going up
5321 if {$id ne [lindex $children($curview,$p) 0]} {
5322 makeupline $p $rm1 $row $col
5326 set id [lindex $displayorder $row]
5327 if {$row > $downarrowlen} {
5328 set termrow [expr {$row - $downarrowlen - 1}]
5329 foreach p [lindex $parentlist $termrow] {
5330 set i [lsearch -exact $idlist $p]
5331 if {$i < 0} continue
5332 set nr [nextuse $p $termrow]
5333 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5334 set idlist [lreplace $idlist $i $i]
5338 set col [lsearch -exact $idlist $id]
5340 set col [idcol $idlist $id]
5341 set idlist [linsert $idlist $col $id]
5342 if {$children($curview,$id) ne {}} {
5343 makeupline $id $rm1 $row $col
5346 set r [expr {$row + $uparrowlen - 1}]
5347 if {$r < $commitidx($curview)} {
5349 foreach p [lindex $parentlist $r] {
5350 if {[lsearch -exact $idlist $p] >= 0} continue
5351 set fk [lindex $children($curview,$p) 0]
5352 if {[rowofcommit $fk] < $row} {
5353 set x [idcol $idlist $p $x]
5354 set idlist [linsert $idlist $x $p]
5357 if {[incr r] < $commitidx($curview)} {
5358 set p [lindex $displayorder $r]
5359 if {[lsearch -exact $idlist $p] < 0} {
5360 set fk [lindex $children($curview,$p) 0]
5361 if {$fk ne {} && [rowofcommit $fk] < $row} {
5362 set x [idcol $idlist $p $x]
5363 set idlist [linsert $idlist $x $p]
5369 if {$final && !$viewcomplete($curview) &&
5370 $row + $uparrowlen + $mingaplen + $downarrowlen
5371 >= $commitidx($curview)} {
5374 set l [llength $rowidlist]
5376 lappend rowidlist $idlist
5378 lappend rowfinal $final
5379 } elseif {$row < $l} {
5380 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5381 lset rowidlist $row $idlist
5384 lset rowfinal $row $final
5386 set pad [ntimes [expr {$row - $l}] {}]
5387 set rowidlist [concat $rowidlist $pad]
5388 lappend rowidlist $idlist
5389 set rowfinal [concat $rowfinal $pad]
5390 lappend rowfinal $final
5391 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5397 proc changedrow {row} {
5398 global displayorder iddrawn rowisopt need_redisplay
5400 set l [llength $rowisopt]
5402 lset rowisopt $row 0
5403 if {$row + 1 < $l} {
5404 lset rowisopt [expr {$row + 1}] 0
5405 if {$row + 2 < $l} {
5406 lset rowisopt [expr {$row + 2}] 0
5410 set id [lindex $displayorder $row]
5411 if {[info exists iddrawn($id)]} {
5412 set need_redisplay 1
5416 proc insert_pad {row col npad} {
5419 set pad [ntimes $npad {}]
5420 set idlist [lindex $rowidlist $row]
5421 set bef [lrange $idlist 0 [expr {$col - 1}]]
5422 set aft [lrange $idlist $col end]
5423 set i [lsearch -exact $aft {}]
5425 set aft [lreplace $aft $i $i]
5427 lset rowidlist $row [concat $bef $pad $aft]
5431 proc optimize_rows {row col endrow} {
5432 global rowidlist rowisopt displayorder curview children
5437 for {} {$row < $endrow} {incr row; set col 0} {
5438 if {[lindex $rowisopt $row]} continue
5440 set y0 [expr {$row - 1}]
5441 set ym [expr {$row - 2}]
5442 set idlist [lindex $rowidlist $row]
5443 set previdlist [lindex $rowidlist $y0]
5444 if {$idlist eq {} || $previdlist eq {}} continue
5446 set pprevidlist [lindex $rowidlist $ym]
5447 if {$pprevidlist eq {}} continue
5453 for {} {$col < [llength $idlist]} {incr col} {
5454 set id [lindex $idlist $col]
5455 if {[lindex $previdlist $col] eq $id} continue
5460 set x0 [lsearch -exact $previdlist $id]
5461 if {$x0 < 0} continue
5462 set z [expr {$x0 - $col}]
5466 set xm [lsearch -exact $pprevidlist $id]
5468 set z0 [expr {$xm - $x0}]
5472 # if row y0 is the first child of $id then it's not an arrow
5473 if {[lindex $children($curview,$id) 0] ne
5474 [lindex $displayorder $y0]} {
5478 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5479 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5482 # Looking at lines from this row to the previous row,
5483 # make them go straight up if they end in an arrow on
5484 # the previous row; otherwise make them go straight up
5486 if {$z < -1 || ($z < 0 && $isarrow)} {
5487 # Line currently goes left too much;
5488 # insert pads in the previous row, then optimize it
5489 set npad [expr {-1 - $z + $isarrow}]
5490 insert_pad $y0 $x0 $npad
5492 optimize_rows $y0 $x0 $row
5494 set previdlist [lindex $rowidlist $y0]
5495 set x0 [lsearch -exact $previdlist $id]
5496 set z [expr {$x0 - $col}]
5498 set pprevidlist [lindex $rowidlist $ym]
5499 set xm [lsearch -exact $pprevidlist $id]
5500 set z0 [expr {$xm - $x0}]
5502 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5503 # Line currently goes right too much;
5504 # insert pads in this line
5505 set npad [expr {$z - 1 + $isarrow}]
5506 insert_pad $row $col $npad
5507 set idlist [lindex $rowidlist $row]
5509 set z [expr {$x0 - $col}]
5512 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5513 # this line links to its first child on row $row-2
5514 set id [lindex $displayorder $ym]
5515 set xc [lsearch -exact $pprevidlist $id]
5517 set z0 [expr {$xc - $x0}]
5520 # avoid lines jigging left then immediately right
5521 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5522 insert_pad $y0 $x0 1
5524 optimize_rows $y0 $x0 $row
5525 set previdlist [lindex $rowidlist $y0]
5529 # Find the first column that doesn't have a line going right
5530 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5531 set id [lindex $idlist $col]
5532 if {$id eq {}} break
5533 set x0 [lsearch -exact $previdlist $id]
5535 # check if this is the link to the first child
5536 set kid [lindex $displayorder $y0]
5537 if {[lindex $children($curview,$id) 0] eq $kid} {
5538 # it is, work out offset to child
5539 set x0 [lsearch -exact $previdlist $kid]
5542 if {$x0 <= $col} break
5544 # Insert a pad at that column as long as it has a line and
5545 # isn't the last column
5546 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5547 set idlist [linsert $idlist $col {}]
5548 lset rowidlist $row $idlist
5556 global canvx0 linespc
5557 return [expr {$canvx0 + $col * $linespc}]
5561 global canvy0 linespc
5562 return [expr {$canvy0 + $row * $linespc}]
5565 proc linewidth {id} {
5566 global thickerline lthickness
5569 if {[info exists thickerline] && $id eq $thickerline} {
5570 set wid [expr {2 * $lthickness}]
5575 proc rowranges {id} {
5576 global curview children uparrowlen downarrowlen
5579 set kids $children($curview,$id)
5585 foreach child $kids {
5586 if {![commitinview $child $curview]} break
5587 set row [rowofcommit $child]
5588 if {![info exists prev]} {
5589 lappend ret [expr {$row + 1}]
5591 if {$row <= $prevrow} {
5592 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5594 # see if the line extends the whole way from prevrow to row
5595 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5596 [lsearch -exact [lindex $rowidlist \
5597 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5598 # it doesn't, see where it ends
5599 set r [expr {$prevrow + $downarrowlen}]
5600 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5601 while {[incr r -1] > $prevrow &&
5602 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5604 while {[incr r] <= $row &&
5605 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5609 # see where it starts up again
5610 set r [expr {$row - $uparrowlen}]
5611 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5612 while {[incr r] < $row &&
5613 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5615 while {[incr r -1] >= $prevrow &&
5616 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5622 if {$child eq $id} {
5631 proc drawlineseg {id row endrow arrowlow} {
5632 global rowidlist displayorder iddrawn linesegs
5633 global canv colormap linespc curview maxlinelen parentlist
5635 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5636 set le [expr {$row + 1}]
5639 set c [lsearch -exact [lindex $rowidlist $le] $id]
5645 set x [lindex $displayorder $le]
5650 if {[info exists iddrawn($x)] || $le == $endrow} {
5651 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5667 if {[info exists linesegs($id)]} {
5668 set lines $linesegs($id)
5670 set r0 [lindex $li 0]
5672 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5682 set li [lindex $lines [expr {$i-1}]]
5683 set r1 [lindex $li 1]
5684 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5689 set x [lindex $cols [expr {$le - $row}]]
5690 set xp [lindex $cols [expr {$le - 1 - $row}]]
5691 set dir [expr {$xp - $x}]
5693 set ith [lindex $lines $i 2]
5694 set coords [$canv coords $ith]
5695 set ah [$canv itemcget $ith -arrow]
5696 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5697 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5698 if {$x2 ne {} && $x - $x2 == $dir} {
5699 set coords [lrange $coords 0 end-2]
5702 set coords [list [xc $le $x] [yc $le]]
5705 set itl [lindex $lines [expr {$i-1}] 2]
5706 set al [$canv itemcget $itl -arrow]
5707 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5708 } elseif {$arrowlow} {
5709 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5710 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5714 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5715 for {set y $le} {[incr y -1] > $row} {} {
5717 set xp [lindex $cols [expr {$y - 1 - $row}]]
5718 set ndir [expr {$xp - $x}]
5719 if {$dir != $ndir || $xp < 0} {
5720 lappend coords [xc $y $x] [yc $y]
5726 # join parent line to first child
5727 set ch [lindex $displayorder $row]
5728 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5730 puts "oops: drawlineseg: child $ch not on row $row"
5731 } elseif {$xc != $x} {
5732 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5733 set d [expr {int(0.5 * $linespc)}]
5736 set x2 [expr {$x1 - $d}]
5738 set x2 [expr {$x1 + $d}]
5741 set y1 [expr {$y2 + $d}]
5742 lappend coords $x1 $y1 $x2 $y2
5743 } elseif {$xc < $x - 1} {
5744 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5745 } elseif {$xc > $x + 1} {
5746 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5750 lappend coords [xc $row $x] [yc $row]
5752 set xn [xc $row $xp]
5754 lappend coords $xn $yn
5758 set t [$canv create line $coords -width [linewidth $id] \
5759 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5762 set lines [linsert $lines $i [list $row $le $t]]
5764 $canv coords $ith $coords
5765 if {$arrow ne $ah} {
5766 $canv itemconf $ith -arrow $arrow
5768 lset lines $i 0 $row
5771 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5772 set ndir [expr {$xo - $xp}]
5773 set clow [$canv coords $itl]
5774 if {$dir == $ndir} {
5775 set clow [lrange $clow 2 end]
5777 set coords [concat $coords $clow]
5779 lset lines [expr {$i-1}] 1 $le
5781 # coalesce two pieces
5783 set b [lindex $lines [expr {$i-1}] 0]
5784 set e [lindex $lines $i 1]
5785 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5787 $canv coords $itl $coords
5788 if {$arrow ne $al} {
5789 $canv itemconf $itl -arrow $arrow
5793 set linesegs($id) $lines
5797 proc drawparentlinks {id row} {
5798 global rowidlist canv colormap curview parentlist
5799 global idpos linespc
5801 set rowids [lindex $rowidlist $row]
5802 set col [lsearch -exact $rowids $id]
5803 if {$col < 0} return
5804 set olds [lindex $parentlist $row]
5805 set row2 [expr {$row + 1}]
5806 set x [xc $row $col]
5809 set d [expr {int(0.5 * $linespc)}]
5810 set ymid [expr {$y + $d}]
5811 set ids [lindex $rowidlist $row2]
5812 # rmx = right-most X coord used
5815 set i [lsearch -exact $ids $p]
5817 puts "oops, parent $p of $id not in list"
5820 set x2 [xc $row2 $i]
5824 set j [lsearch -exact $rowids $p]
5826 # drawlineseg will do this one for us
5830 # should handle duplicated parents here...
5831 set coords [list $x $y]
5833 # if attaching to a vertical segment, draw a smaller
5834 # slant for visual distinctness
5837 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5839 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5841 } elseif {$i < $col && $i < $j} {
5842 # segment slants towards us already
5843 lappend coords [xc $row $j] $y
5845 if {$i < $col - 1} {
5846 lappend coords [expr {$x2 + $linespc}] $y
5847 } elseif {$i > $col + 1} {
5848 lappend coords [expr {$x2 - $linespc}] $y
5850 lappend coords $x2 $y2
5853 lappend coords $x2 $y2
5855 set t [$canv create line $coords -width [linewidth $p] \
5856 -fill $colormap($p) -tags lines.$p]
5860 if {$rmx > [lindex $idpos($id) 1]} {
5861 lset idpos($id) 1 $rmx
5866 proc drawlines {id} {
5869 $canv itemconf lines.$id -width [linewidth $id]
5872 proc drawcmittext {id row col} {
5873 global linespc canv canv2 canv3 fgcolor curview
5874 global cmitlisted commitinfo rowidlist parentlist
5875 global rowtextx idpos idtags idheads idotherrefs
5876 global linehtag linentag linedtag selectedline
5877 global canvxmax boldids boldnameids fgcolor markedid
5878 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5880 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5881 set listed $cmitlisted($curview,$id)
5882 if {$id eq $nullid} {
5884 } elseif {$id eq $nullid2} {
5886 } elseif {$id eq $mainheadid} {
5889 set ofill [lindex $circlecolors $listed]
5891 set x [xc $row $col]
5893 set orad [expr {$linespc / 3}]
5895 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5896 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5897 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5898 } elseif {$listed == 3} {
5899 # triangle pointing left for left-side commits
5900 set t [$canv create polygon \
5901 [expr {$x - $orad}] $y \
5902 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5903 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5904 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5906 # triangle pointing right for right-side commits
5907 set t [$canv create polygon \
5908 [expr {$x + $orad - 1}] $y \
5909 [expr {$x - $orad}] [expr {$y - $orad}] \
5910 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5911 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5913 set circleitem($row) $t
5915 $canv bind $t <1> {selcanvline {} %x %y}
5916 set rmx [llength [lindex $rowidlist $row]]
5917 set olds [lindex $parentlist $row]
5919 set nextids [lindex $rowidlist [expr {$row + 1}]]
5921 set i [lsearch -exact $nextids $p]
5927 set xt [xc $row $rmx]
5928 set rowtextx($row) $xt
5929 set idpos($id) [list $x $xt $y]
5930 if {[info exists idtags($id)] || [info exists idheads($id)]
5931 || [info exists idotherrefs($id)]} {
5932 set xt [drawtags $id $x $xt $y]
5934 if {[lindex $commitinfo($id) 6] > 0} {
5935 set xt [drawnotesign $xt $y]
5937 set headline [lindex $commitinfo($id) 0]
5938 set name [lindex $commitinfo($id) 1]
5939 set date [lindex $commitinfo($id) 2]
5940 set date [formatdate $date]
5943 set isbold [ishighlighted $id]
5946 set font mainfontbold
5948 lappend boldnameids $id
5949 set nfont mainfontbold
5952 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5953 -text $headline -font $font -tags text]
5954 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5955 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5956 -text $name -font $nfont -tags text]
5957 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5958 -text $date -font mainfont -tags text]
5959 if {$selectedline == $row} {
5962 if {[info exists markedid] && $markedid eq $id} {
5965 set xr [expr {$xt + [font measure $font $headline]}]
5966 if {$xr > $canvxmax} {
5972 proc drawcmitrow {row} {
5973 global displayorder rowidlist nrows_drawn
5974 global iddrawn markingmatches
5975 global commitinfo numcommits
5976 global filehighlight fhighlights findpattern nhighlights
5977 global hlview vhighlights
5978 global highlight_related rhighlights
5980 if {$row >= $numcommits} return
5982 set id [lindex $displayorder $row]
5983 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5984 askvhighlight $row $id
5986 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5987 askfilehighlight $row $id
5989 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5990 askfindhighlight $row $id
5992 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5993 askrelhighlight $row $id
5995 if {![info exists iddrawn($id)]} {
5996 set col [lsearch -exact [lindex $rowidlist $row] $id]
5998 puts "oops, row $row id $id not in list"
6001 if {![info exists commitinfo($id)]} {
6005 drawcmittext $id $row $col
6009 if {$markingmatches} {
6010 markrowmatches $row $id
6014 proc drawcommits {row {endrow {}}} {
6015 global numcommits iddrawn displayorder curview need_redisplay
6016 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6021 if {$endrow eq {}} {
6024 if {$endrow >= $numcommits} {
6025 set endrow [expr {$numcommits - 1}]
6028 set rl1 [expr {$row - $downarrowlen - 3}]
6032 set ro1 [expr {$row - 3}]
6036 set r2 [expr {$endrow + $uparrowlen + 3}]
6037 if {$r2 > $numcommits} {
6040 for {set r $rl1} {$r < $r2} {incr r} {
6041 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6045 set rl1 [expr {$r + 1}]
6051 optimize_rows $ro1 0 $r2
6052 if {$need_redisplay || $nrows_drawn > 2000} {
6056 # make the lines join to already-drawn rows either side
6057 set r [expr {$row - 1}]
6058 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6061 set er [expr {$endrow + 1}]
6062 if {$er >= $numcommits ||
6063 ![info exists iddrawn([lindex $displayorder $er])]} {
6066 for {} {$r <= $er} {incr r} {
6067 set id [lindex $displayorder $r]
6068 set wasdrawn [info exists iddrawn($id)]
6070 if {$r == $er} break
6071 set nextid [lindex $displayorder [expr {$r + 1}]]
6072 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6073 drawparentlinks $id $r
6075 set rowids [lindex $rowidlist $r]
6076 foreach lid $rowids {
6077 if {$lid eq {}} continue
6078 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6080 # see if this is the first child of any of its parents
6081 foreach p [lindex $parentlist $r] {
6082 if {[lsearch -exact $rowids $p] < 0} {
6083 # make this line extend up to the child
6084 set lineend($p) [drawlineseg $p $r $er 0]
6088 set lineend($lid) [drawlineseg $lid $r $er 1]
6094 proc undolayout {row} {
6095 global uparrowlen mingaplen downarrowlen
6096 global rowidlist rowisopt rowfinal need_redisplay
6098 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6102 if {[llength $rowidlist] > $r} {
6104 set rowidlist [lrange $rowidlist 0 $r]
6105 set rowfinal [lrange $rowfinal 0 $r]
6106 set rowisopt [lrange $rowisopt 0 $r]
6107 set need_redisplay 1
6112 proc drawvisible {} {
6113 global canv linespc curview vrowmod selectedline targetrow targetid
6114 global need_redisplay cscroll numcommits
6116 set fs [$canv yview]
6117 set ymax [lindex [$canv cget -scrollregion] 3]
6118 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6119 set f0 [lindex $fs 0]
6120 set f1 [lindex $fs 1]
6121 set y0 [expr {int($f0 * $ymax)}]
6122 set y1 [expr {int($f1 * $ymax)}]
6124 if {[info exists targetid]} {
6125 if {[commitinview $targetid $curview]} {
6126 set r [rowofcommit $targetid]
6127 if {$r != $targetrow} {
6128 # Fix up the scrollregion and change the scrolling position
6129 # now that our target row has moved.
6130 set diff [expr {($r - $targetrow) * $linespc}]
6133 set ymax [lindex [$canv cget -scrollregion] 3]
6136 set f0 [expr {$y0 / $ymax}]
6137 set f1 [expr {$y1 / $ymax}]
6138 allcanvs yview moveto $f0
6139 $cscroll set $f0 $f1
6140 set need_redisplay 1
6147 set row [expr {int(($y0 - 3) / $linespc) - 1}]
6148 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6149 if {$endrow >= $vrowmod($curview)} {
6150 update_arcrows $curview
6152 if {$selectedline ne {} &&
6153 $row <= $selectedline && $selectedline <= $endrow} {
6154 set targetrow $selectedline
6155 } elseif {[info exists targetid]} {
6156 set targetrow [expr {int(($row + $endrow) / 2)}]
6158 if {[info exists targetrow]} {
6159 if {$targetrow >= $numcommits} {
6160 set targetrow [expr {$numcommits - 1}]
6162 set targetid [commitonrow $targetrow]
6164 drawcommits $row $endrow
6167 proc clear_display {} {
6168 global iddrawn linesegs need_redisplay nrows_drawn
6169 global vhighlights fhighlights nhighlights rhighlights
6170 global linehtag linentag linedtag boldids boldnameids
6173 catch {unset iddrawn}
6174 catch {unset linesegs}
6175 catch {unset linehtag}
6176 catch {unset linentag}
6177 catch {unset linedtag}
6180 catch {unset vhighlights}
6181 catch {unset fhighlights}
6182 catch {unset nhighlights}
6183 catch {unset rhighlights}
6184 set need_redisplay 0
6188 proc findcrossings {id} {
6189 global rowidlist parentlist numcommits displayorder
6193 foreach {s e} [rowranges $id] {
6194 if {$e >= $numcommits} {
6195 set e [expr {$numcommits - 1}]
6197 if {$e <= $s} continue
6198 for {set row $e} {[incr row -1] >= $s} {} {
6199 set x [lsearch -exact [lindex $rowidlist $row] $id]
6201 set olds [lindex $parentlist $row]
6202 set kid [lindex $displayorder $row]
6203 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6204 if {$kidx < 0} continue
6205 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6207 set px [lsearch -exact $nextrow $p]
6208 if {$px < 0} continue
6209 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6210 if {[lsearch -exact $ccross $p] >= 0} continue
6211 if {$x == $px + ($kidx < $px? -1: 1)} {
6213 } elseif {[lsearch -exact $cross $p] < 0} {
6220 return [concat $ccross {{}} $cross]
6223 proc assigncolor {id} {
6224 global colormap colors nextcolor
6225 global parents children children curview
6227 if {[info exists colormap($id)]} return
6228 set ncolors [llength $colors]
6229 if {[info exists children($curview,$id)]} {
6230 set kids $children($curview,$id)
6234 if {[llength $kids] == 1} {
6235 set child [lindex $kids 0]
6236 if {[info exists colormap($child)]
6237 && [llength $parents($curview,$child)] == 1} {
6238 set colormap($id) $colormap($child)
6244 foreach x [findcrossings $id] {
6246 # delimiter between corner crossings and other crossings
6247 if {[llength $badcolors] >= $ncolors - 1} break
6248 set origbad $badcolors
6250 if {[info exists colormap($x)]
6251 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6252 lappend badcolors $colormap($x)
6255 if {[llength $badcolors] >= $ncolors} {
6256 set badcolors $origbad
6258 set origbad $badcolors
6259 if {[llength $badcolors] < $ncolors - 1} {
6260 foreach child $kids {
6261 if {[info exists colormap($child)]
6262 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6263 lappend badcolors $colormap($child)
6265 foreach p $parents($curview,$child) {
6266 if {[info exists colormap($p)]
6267 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6268 lappend badcolors $colormap($p)
6272 if {[llength $badcolors] >= $ncolors} {
6273 set badcolors $origbad
6276 for {set i 0} {$i <= $ncolors} {incr i} {
6277 set c [lindex $colors $nextcolor]
6278 if {[incr nextcolor] >= $ncolors} {
6281 if {[lsearch -exact $badcolors $c]} break
6283 set colormap($id) $c
6286 proc bindline {t id} {
6289 $canv bind $t <Enter> "lineenter %x %y $id"
6290 $canv bind $t <Motion> "linemotion %x %y $id"
6291 $canv bind $t <Leave> "lineleave $id"
6292 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6295 proc drawtags {id x xt y1} {
6296 global idtags idheads idotherrefs mainhead
6297 global linespc lthickness
6298 global canv rowtextx curview fgcolor bgcolor ctxbut
6303 if {[info exists idtags($id)]} {
6304 set marks $idtags($id)
6305 set ntags [llength $marks]
6307 if {[info exists idheads($id)]} {
6308 set marks [concat $marks $idheads($id)]
6309 set nheads [llength $idheads($id)]
6311 if {[info exists idotherrefs($id)]} {
6312 set marks [concat $marks $idotherrefs($id)]
6318 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6319 set yt [expr {$y1 - 0.5 * $linespc}]
6320 set yb [expr {$yt + $linespc - 1}]
6324 foreach tag $marks {
6326 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6327 set wid [font measure mainfontbold $tag]
6329 set wid [font measure mainfont $tag]
6333 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6335 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6336 -width $lthickness -fill black -tags tag.$id]
6338 foreach tag $marks x $xvals wid $wvals {
6339 set tag_quoted [string map {% %%} $tag]
6340 set xl [expr {$x + $delta}]
6341 set xr [expr {$x + $delta + $wid + $lthickness}]
6343 if {[incr ntags -1] >= 0} {
6345 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6346 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6347 -width 1 -outline black -fill yellow -tags tag.$id]
6348 $canv bind $t <1> [list showtag $tag_quoted 1]
6349 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6351 # draw a head or other ref
6352 if {[incr nheads -1] >= 0} {
6354 if {$tag eq $mainhead} {
6355 set font mainfontbold
6360 set xl [expr {$xl - $delta/2}]
6361 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6362 -width 1 -outline black -fill $col -tags tag.$id
6363 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6364 set rwid [font measure mainfont $remoteprefix]
6365 set xi [expr {$x + 1}]
6366 set yti [expr {$yt + 1}]
6367 set xri [expr {$x + $rwid}]
6368 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6369 -width 0 -fill "#ffddaa" -tags tag.$id
6372 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6373 -font $font -tags [list tag.$id text]]
6375 $canv bind $t <1> [list showtag $tag_quoted 1]
6376 } elseif {$nheads >= 0} {
6377 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6383 proc drawnotesign {xt y} {
6384 global linespc canv fgcolor
6386 set orad [expr {$linespc / 3}]
6387 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6388 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6389 -fill yellow -outline $fgcolor -width 1 -tags circle]
6390 set xt [expr {$xt + $orad * 3}]
6394 proc xcoord {i level ln} {
6395 global canvx0 xspc1 xspc2
6397 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6398 if {$i > 0 && $i == $level} {
6399 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6400 } elseif {$i > $level} {
6401 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6406 proc show_status {msg} {
6410 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6411 -tags text -fill $fgcolor
6414 # Don't change the text pane cursor if it is currently the hand cursor,
6415 # showing that we are over a sha1 ID link.
6416 proc settextcursor {c} {
6417 global ctext curtextcursor
6419 if {[$ctext cget -cursor] == $curtextcursor} {
6420 $ctext config -cursor $c
6422 set curtextcursor $c
6425 proc nowbusy {what {name {}}} {
6426 global isbusy busyname statusw
6428 if {[array names isbusy] eq {}} {
6429 . config -cursor watch
6433 set busyname($what) $name
6435 $statusw conf -text $name
6439 proc notbusy {what} {
6440 global isbusy maincursor textcursor busyname statusw
6444 if {$busyname($what) ne {} &&
6445 [$statusw cget -text] eq $busyname($what)} {
6446 $statusw conf -text {}
6449 if {[array names isbusy] eq {}} {
6450 . config -cursor $maincursor
6451 settextcursor $textcursor
6455 proc findmatches {f} {
6456 global findtype findstring
6457 if {$findtype == [mc "Regexp"]} {
6458 set matches [regexp -indices -all -inline $findstring $f]
6461 if {$findtype == [mc "IgnCase"]} {
6462 set f [string tolower $f]
6463 set fs [string tolower $fs]
6467 set l [string length $fs]
6468 while {[set j [string first $fs $f $i]] >= 0} {
6469 lappend matches [list $j [expr {$j+$l-1}]]
6470 set i [expr {$j + $l}]
6476 proc dofind {{dirn 1} {wrap 1}} {
6477 global findstring findstartline findcurline selectedline numcommits
6478 global gdttype filehighlight fh_serial find_dirn findallowwrap
6480 if {[info exists find_dirn]} {
6481 if {$find_dirn == $dirn} return
6485 if {$findstring eq {} || $numcommits == 0} return
6486 if {$selectedline eq {}} {
6487 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6489 set findstartline $selectedline
6491 set findcurline $findstartline
6492 nowbusy finding [mc "Searching"]
6493 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6494 after cancel do_file_hl $fh_serial
6495 do_file_hl $fh_serial
6498 set findallowwrap $wrap
6502 proc stopfinding {} {
6503 global find_dirn findcurline fprogcoord
6505 if {[info exists find_dirn]} {
6516 global commitdata commitinfo numcommits findpattern findloc
6517 global findstartline findcurline findallowwrap
6518 global find_dirn gdttype fhighlights fprogcoord
6519 global curview varcorder vrownum varccommits vrowmod
6521 if {![info exists find_dirn]} {
6524 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6527 if {$find_dirn > 0} {
6529 if {$l >= $numcommits} {
6532 if {$l <= $findstartline} {
6533 set lim [expr {$findstartline + 1}]
6536 set moretodo $findallowwrap
6543 if {$l >= $findstartline} {
6544 set lim [expr {$findstartline - 1}]
6547 set moretodo $findallowwrap
6550 set n [expr {($lim - $l) * $find_dirn}]
6555 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6556 update_arcrows $curview
6560 set ai [bsearch $vrownum($curview) $l]
6561 set a [lindex $varcorder($curview) $ai]
6562 set arow [lindex $vrownum($curview) $ai]
6563 set ids [lindex $varccommits($curview,$a)]
6564 set arowend [expr {$arow + [llength $ids]}]
6565 if {$gdttype eq [mc "containing:"]} {
6566 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6567 if {$l < $arow || $l >= $arowend} {
6569 set a [lindex $varcorder($curview) $ai]
6570 set arow [lindex $vrownum($curview) $ai]
6571 set ids [lindex $varccommits($curview,$a)]
6572 set arowend [expr {$arow + [llength $ids]}]
6574 set id [lindex $ids [expr {$l - $arow}]]
6575 # shouldn't happen unless git log doesn't give all the commits...
6576 if {![info exists commitdata($id)] ||
6577 ![doesmatch $commitdata($id)]} {
6580 if {![info exists commitinfo($id)]} {
6583 set info $commitinfo($id)
6584 foreach f $info ty $fldtypes {
6585 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6594 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6595 if {$l < $arow || $l >= $arowend} {
6597 set a [lindex $varcorder($curview) $ai]
6598 set arow [lindex $vrownum($curview) $ai]
6599 set ids [lindex $varccommits($curview,$a)]
6600 set arowend [expr {$arow + [llength $ids]}]
6602 set id [lindex $ids [expr {$l - $arow}]]
6603 if {![info exists fhighlights($id)]} {
6604 # this sets fhighlights($id) to -1
6605 askfilehighlight $l $id
6607 if {$fhighlights($id) > 0} {
6611 if {$fhighlights($id) < 0} {
6614 set findcurline [expr {$l - $find_dirn}]
6619 if {$found || ($domore && !$moretodo)} {
6635 set findcurline [expr {$l - $find_dirn}]
6637 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6641 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6646 proc findselectline {l} {
6647 global findloc commentend ctext findcurline markingmatches gdttype
6649 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6652 if {$markingmatches &&
6653 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6654 # highlight the matches in the comments
6655 set f [$ctext get 1.0 $commentend]
6656 set matches [findmatches $f]
6657 foreach match $matches {
6658 set start [lindex $match 0]
6659 set end [expr {[lindex $match 1] + 1}]
6660 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6666 # mark the bits of a headline or author that match a find string
6667 proc markmatches {canv l str tag matches font row} {
6670 set bbox [$canv bbox $tag]
6671 set x0 [lindex $bbox 0]
6672 set y0 [lindex $bbox 1]
6673 set y1 [lindex $bbox 3]
6674 foreach match $matches {
6675 set start [lindex $match 0]
6676 set end [lindex $match 1]
6677 if {$start > $end} continue
6678 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6679 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6680 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6681 [expr {$x0+$xlen+2}] $y1 \
6682 -outline {} -tags [list match$l matches] -fill yellow]
6684 if {$row == $selectedline} {
6685 $canv raise $t secsel
6690 proc unmarkmatches {} {
6691 global markingmatches
6693 allcanvs delete matches
6694 set markingmatches 0
6698 proc selcanvline {w x y} {
6699 global canv canvy0 ctext linespc
6701 set ymax [lindex [$canv cget -scrollregion] 3]
6702 if {$ymax == {}} return
6703 set yfrac [lindex [$canv yview] 0]
6704 set y [expr {$y + $yfrac * $ymax}]
6705 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6710 set xmax [lindex [$canv cget -scrollregion] 2]
6711 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6712 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6718 proc commit_descriptor {p} {
6720 if {![info exists commitinfo($p)]} {
6724 if {[llength $commitinfo($p)] > 1} {
6725 set l [lindex $commitinfo($p) 0]
6730 # append some text to the ctext widget, and make any SHA1 ID
6731 # that we know about be a clickable link.
6732 proc appendwithlinks {text tags} {
6733 global ctext linknum curview
6735 set start [$ctext index "end - 1c"]
6736 $ctext insert end $text $tags
6737 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6741 set linkid [string range $text $s $e]
6743 $ctext tag delete link$linknum
6744 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6745 setlink $linkid link$linknum
6750 proc setlink {id lk} {
6751 global curview ctext pendinglinks
6754 if {[string length $id] < 40} {
6755 set matches [longid $id]
6756 if {[llength $matches] > 0} {
6757 if {[llength $matches] > 1} return
6759 set id [lindex $matches 0]
6762 set known [commitinview $id $curview]
6765 $ctext tag conf $lk -foreground blue -underline 1
6766 $ctext tag bind $lk <1> [list selbyid $id]
6767 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6768 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6770 lappend pendinglinks($id) $lk
6771 interestedin $id {makelink %P}
6775 proc appendshortlink {id {pre {}} {post {}}} {
6776 global ctext linknum
6778 $ctext insert end $pre
6779 $ctext tag delete link$linknum
6780 $ctext insert end [string range $id 0 7] link$linknum
6781 $ctext insert end $post
6782 setlink $id link$linknum
6786 proc makelink {id} {
6789 if {![info exists pendinglinks($id)]} return
6790 foreach lk $pendinglinks($id) {
6793 unset pendinglinks($id)
6796 proc linkcursor {w inc} {
6797 global linkentercount curtextcursor
6799 if {[incr linkentercount $inc] > 0} {
6800 $w configure -cursor hand2
6802 $w configure -cursor $curtextcursor
6803 if {$linkentercount < 0} {
6804 set linkentercount 0
6809 proc viewnextline {dir} {
6813 set ymax [lindex [$canv cget -scrollregion] 3]
6814 set wnow [$canv yview]
6815 set wtop [expr {[lindex $wnow 0] * $ymax}]
6816 set newtop [expr {$wtop + $dir * $linespc}]
6819 } elseif {$newtop > $ymax} {
6822 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6825 # add a list of tag or branch names at position pos
6826 # returns the number of names inserted
6827 proc appendrefs {pos ids var} {
6828 global ctext linknum curview $var maxrefs
6830 if {[catch {$ctext index $pos}]} {
6833 $ctext conf -state normal
6834 $ctext delete $pos "$pos lineend"
6837 foreach tag [set $var\($id\)] {
6838 lappend tags [list $tag $id]
6841 if {[llength $tags] > $maxrefs} {
6842 $ctext insert $pos "[mc "many"] ([llength $tags])"
6844 set tags [lsort -index 0 -decreasing $tags]
6847 set id [lindex $ti 1]
6850 $ctext tag delete $lk
6851 $ctext insert $pos $sep
6852 $ctext insert $pos [lindex $ti 0] $lk
6857 $ctext conf -state disabled
6858 return [llength $tags]
6861 # called when we have finished computing the nearby tags
6862 proc dispneartags {delay} {
6863 global selectedline currentid showneartags tagphase
6865 if {$selectedline eq {} || !$showneartags} return
6866 after cancel dispnexttag
6868 after 200 dispnexttag
6871 after idle dispnexttag
6876 proc dispnexttag {} {
6877 global selectedline currentid showneartags tagphase ctext
6879 if {$selectedline eq {} || !$showneartags} return
6880 switch -- $tagphase {
6882 set dtags [desctags $currentid]
6884 appendrefs precedes $dtags idtags
6888 set atags [anctags $currentid]
6890 appendrefs follows $atags idtags
6894 set dheads [descheads $currentid]
6895 if {$dheads ne {}} {
6896 if {[appendrefs branch $dheads idheads] > 1
6897 && [$ctext get "branch -3c"] eq "h"} {
6898 # turn "Branch" into "Branches"
6899 $ctext conf -state normal
6900 $ctext insert "branch -2c" "es"
6901 $ctext conf -state disabled
6906 if {[incr tagphase] <= 2} {
6907 after idle dispnexttag
6911 proc make_secsel {id} {
6912 global linehtag linentag linedtag canv canv2 canv3
6914 if {![info exists linehtag($id)]} return
6916 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6917 -tags secsel -fill [$canv cget -selectbackground]]
6919 $canv2 delete secsel
6920 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6921 -tags secsel -fill [$canv2 cget -selectbackground]]
6923 $canv3 delete secsel
6924 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6925 -tags secsel -fill [$canv3 cget -selectbackground]]
6929 proc make_idmark {id} {
6930 global linehtag canv fgcolor
6932 if {![info exists linehtag($id)]} return
6934 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6935 -tags markid -outline $fgcolor]
6939 proc selectline {l isnew {desired_loc {}}} {
6940 global canv ctext commitinfo selectedline
6941 global canvy0 linespc parents children curview
6942 global currentid sha1entry
6943 global commentend idtags linknum
6944 global mergemax numcommits pending_select
6945 global cmitmode showneartags allcommits
6946 global targetrow targetid lastscrollrows
6947 global autoselect autosellen jump_to_here
6949 catch {unset pending_select}
6954 if {$l < 0 || $l >= $numcommits} return
6955 set id [commitonrow $l]
6960 if {$lastscrollrows < $numcommits} {
6964 set y [expr {$canvy0 + $l * $linespc}]
6965 set ymax [lindex [$canv cget -scrollregion] 3]
6966 set ytop [expr {$y - $linespc - 1}]
6967 set ybot [expr {$y + $linespc + 1}]
6968 set wnow [$canv yview]
6969 set wtop [expr {[lindex $wnow 0] * $ymax}]
6970 set wbot [expr {[lindex $wnow 1] * $ymax}]
6971 set wh [expr {$wbot - $wtop}]
6973 if {$ytop < $wtop} {
6974 if {$ybot < $wtop} {
6975 set newtop [expr {$y - $wh / 2.0}]
6978 if {$newtop > $wtop - $linespc} {
6979 set newtop [expr {$wtop - $linespc}]
6982 } elseif {$ybot > $wbot} {
6983 if {$ytop > $wbot} {
6984 set newtop [expr {$y - $wh / 2.0}]
6986 set newtop [expr {$ybot - $wh}]
6987 if {$newtop < $wtop + $linespc} {
6988 set newtop [expr {$wtop + $linespc}]
6992 if {$newtop != $wtop} {
6996 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7003 addtohistory [list selbyid $id 0] savecmitpos
7006 $sha1entry delete 0 end
7007 $sha1entry insert 0 $id
7009 $sha1entry selection range 0 $autosellen
7013 $ctext conf -state normal
7016 if {![info exists commitinfo($id)]} {
7019 set info $commitinfo($id)
7020 set date [formatdate [lindex $info 2]]
7021 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
7022 set date [formatdate [lindex $info 4]]
7023 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
7024 if {[info exists idtags($id)]} {
7025 $ctext insert end [mc "Tags:"]
7026 foreach tag $idtags($id) {
7027 $ctext insert end " $tag"
7029 $ctext insert end "\n"
7033 set olds $parents($curview,$id)
7034 if {[llength $olds] > 1} {
7037 if {$np >= $mergemax} {
7042 $ctext insert end "[mc "Parent"]: " $tag
7043 appendwithlinks [commit_descriptor $p] {}
7048 append headers "[mc "Parent"]: [commit_descriptor $p]"
7052 foreach c $children($curview,$id) {
7053 append headers "[mc "Child"]: [commit_descriptor $c]"
7056 # make anything that looks like a SHA1 ID be a clickable link
7057 appendwithlinks $headers {}
7058 if {$showneartags} {
7059 if {![info exists allcommits]} {
7062 $ctext insert end "[mc "Branch"]: "
7063 $ctext mark set branch "end -1c"
7064 $ctext mark gravity branch left
7065 $ctext insert end "\n[mc "Follows"]: "
7066 $ctext mark set follows "end -1c"
7067 $ctext mark gravity follows left
7068 $ctext insert end "\n[mc "Precedes"]: "
7069 $ctext mark set precedes "end -1c"
7070 $ctext mark gravity precedes left
7071 $ctext insert end "\n"
7074 $ctext insert end "\n"
7075 set comment [lindex $info 5]
7076 if {[string first "\r" $comment] >= 0} {
7077 set comment [string map {"\r" "\n "} $comment]
7079 appendwithlinks $comment {comment}
7081 $ctext tag remove found 1.0 end
7082 $ctext conf -state disabled
7083 set commentend [$ctext index "end - 1c"]
7085 set jump_to_here $desired_loc
7086 init_flist [mc "Comments"]
7087 if {$cmitmode eq "tree"} {
7089 } elseif {[llength $olds] <= 1} {
7096 proc selfirstline {} {
7101 proc sellastline {} {
7104 set l [expr {$numcommits - 1}]
7108 proc selnextline {dir} {
7111 if {$selectedline eq {}} return
7112 set l [expr {$selectedline + $dir}]
7117 proc selnextpage {dir} {
7118 global canv linespc selectedline numcommits
7120 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7124 allcanvs yview scroll [expr {$dir * $lpp}] units
7126 if {$selectedline eq {}} return
7127 set l [expr {$selectedline + $dir * $lpp}]
7130 } elseif {$l >= $numcommits} {
7131 set l [expr $numcommits - 1]
7137 proc unselectline {} {
7138 global selectedline currentid
7141 catch {unset currentid}
7142 allcanvs delete secsel
7146 proc reselectline {} {
7149 if {$selectedline ne {}} {
7150 selectline $selectedline 0
7154 proc addtohistory {cmd {saveproc {}}} {
7155 global history historyindex curview
7159 set elt [list $curview $cmd $saveproc {}]
7160 if {$historyindex > 0
7161 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7165 if {$historyindex < [llength $history]} {
7166 set history [lreplace $history $historyindex end $elt]
7168 lappend history $elt
7171 if {$historyindex > 1} {
7172 .tf.bar.leftbut conf -state normal
7174 .tf.bar.leftbut conf -state disabled
7176 .tf.bar.rightbut conf -state disabled
7179 # save the scrolling position of the diff display pane
7180 proc save_position {} {
7181 global historyindex history
7183 if {$historyindex < 1} return
7184 set hi [expr {$historyindex - 1}]
7185 set fn [lindex $history $hi 2]
7187 lset history $hi 3 [eval $fn]
7191 proc unset_posvars {} {
7194 if {[info exists last_posvars]} {
7195 foreach {var val} $last_posvars {
7204 global curview last_posvars
7206 set view [lindex $elt 0]
7207 set cmd [lindex $elt 1]
7208 set pv [lindex $elt 3]
7209 if {$curview != $view} {
7213 foreach {var val} $pv {
7217 set last_posvars $pv
7222 global history historyindex
7225 if {$historyindex > 1} {
7227 incr historyindex -1
7228 godo [lindex $history [expr {$historyindex - 1}]]
7229 .tf.bar.rightbut conf -state normal
7231 if {$historyindex <= 1} {
7232 .tf.bar.leftbut conf -state disabled
7237 global history historyindex
7240 if {$historyindex < [llength $history]} {
7242 set cmd [lindex $history $historyindex]
7245 .tf.bar.leftbut conf -state normal
7247 if {$historyindex >= [llength $history]} {
7248 .tf.bar.rightbut conf -state disabled
7253 global treefilelist treeidlist diffids diffmergeid treepending
7254 global nullid nullid2
7257 catch {unset diffmergeid}
7258 if {![info exists treefilelist($id)]} {
7259 if {![info exists treepending]} {
7260 if {$id eq $nullid} {
7261 set cmd [list | git ls-files]
7262 } elseif {$id eq $nullid2} {
7263 set cmd [list | git ls-files --stage -t]
7265 set cmd [list | git ls-tree -r $id]
7267 if {[catch {set gtf [open $cmd r]}]} {
7271 set treefilelist($id) {}
7272 set treeidlist($id) {}
7273 fconfigure $gtf -blocking 0 -encoding binary
7274 filerun $gtf [list gettreeline $gtf $id]
7281 proc gettreeline {gtf id} {
7282 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7285 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7286 if {$diffids eq $nullid} {
7289 set i [string first "\t" $line]
7290 if {$i < 0} continue
7291 set fname [string range $line [expr {$i+1}] end]
7292 set line [string range $line 0 [expr {$i-1}]]
7293 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7294 set sha1 [lindex $line 2]
7295 lappend treeidlist($id) $sha1
7297 if {[string index $fname 0] eq "\""} {
7298 set fname [lindex $fname 0]
7300 set fname [encoding convertfrom $fname]
7301 lappend treefilelist($id) $fname
7304 return [expr {$nl >= 1000? 2: 1}]
7308 if {$cmitmode ne "tree"} {
7309 if {![info exists diffmergeid]} {
7310 gettreediffs $diffids
7312 } elseif {$id ne $diffids} {
7321 global treefilelist treeidlist diffids nullid nullid2
7322 global ctext_file_names ctext_file_lines
7323 global ctext commentend
7325 set i [lsearch -exact $treefilelist($diffids) $f]
7327 puts "oops, $f not in list for id $diffids"
7330 if {$diffids eq $nullid} {
7331 if {[catch {set bf [open $f r]} err]} {
7332 puts "oops, can't read $f: $err"
7336 set blob [lindex $treeidlist($diffids) $i]
7337 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7338 puts "oops, error reading blob $blob: $err"
7342 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7343 filerun $bf [list getblobline $bf $diffids]
7344 $ctext config -state normal
7345 clear_ctext $commentend
7346 lappend ctext_file_names $f
7347 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7348 $ctext insert end "\n"
7349 $ctext insert end "$f\n" filesep
7350 $ctext config -state disabled
7351 $ctext yview $commentend
7355 proc getblobline {bf id} {
7356 global diffids cmitmode ctext
7358 if {$id ne $diffids || $cmitmode ne "tree"} {
7362 $ctext config -state normal
7364 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7365 $ctext insert end "$line\n"
7368 global jump_to_here ctext_file_names commentend
7370 # delete last newline
7371 $ctext delete "end - 2c" "end - 1c"
7373 if {$jump_to_here ne {} &&
7374 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7375 set lnum [expr {[lindex $jump_to_here 1] +
7376 [lindex [split $commentend .] 0]}]
7377 mark_ctext_line $lnum
7379 $ctext config -state disabled
7382 $ctext config -state disabled
7383 return [expr {$nl >= 1000? 2: 1}]
7386 proc mark_ctext_line {lnum} {
7387 global ctext markbgcolor
7389 $ctext tag delete omark
7390 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7391 $ctext tag conf omark -background $markbgcolor
7395 proc mergediff {id} {
7397 global diffids treediffs
7398 global parents curview
7402 set treediffs($id) {}
7403 set np [llength $parents($curview,$id)]
7408 proc startdiff {ids} {
7409 global treediffs diffids treepending diffmergeid nullid nullid2
7413 catch {unset diffmergeid}
7414 if {![info exists treediffs($ids)] ||
7415 [lsearch -exact $ids $nullid] >= 0 ||
7416 [lsearch -exact $ids $nullid2] >= 0} {
7417 if {![info exists treepending]} {
7425 # If the filename (name) is under any of the passed filter paths
7426 # then return true to include the file in the listing.
7427 proc path_filter {filter name} {
7428 set worktree [gitworktree]
7430 set fq_p [file normalize $p]
7431 set fq_n [file normalize [file join $worktree $name]]
7432 if {[string match [file normalize $fq_p]* $fq_n]} {
7439 proc addtocflist {ids} {
7442 add_flist $treediffs($ids)
7446 proc diffcmd {ids flags} {
7447 global nullid nullid2
7449 set i [lsearch -exact $ids $nullid]
7450 set j [lsearch -exact $ids $nullid2]
7452 if {[llength $ids] > 1 && $j < 0} {
7453 # comparing working directory with some specific revision
7454 set cmd [concat | git diff-index $flags]
7456 lappend cmd -R [lindex $ids 1]
7458 lappend cmd [lindex $ids 0]
7461 # comparing working directory with index
7462 set cmd [concat | git diff-files $flags]
7467 } elseif {$j >= 0} {
7468 set cmd [concat | git diff-index --cached $flags]
7469 if {[llength $ids] > 1} {
7470 # comparing index with specific revision
7472 lappend cmd -R [lindex $ids 1]
7474 lappend cmd [lindex $ids 0]
7477 # comparing index with HEAD
7481 set cmd [concat | git diff-tree -r $flags $ids]
7486 proc gettreediffs {ids} {
7487 global treediff treepending
7489 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7491 set treepending $ids
7493 fconfigure $gdtf -blocking 0 -encoding binary
7494 filerun $gdtf [list gettreediffline $gdtf $ids]
7497 proc gettreediffline {gdtf ids} {
7498 global treediff treediffs treepending diffids diffmergeid
7499 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7504 if {$perfile_attrs} {
7505 # cache_gitattr is slow, and even slower on win32 where we
7506 # have to invoke it for only about 30 paths at a time
7508 if {[tk windowingsystem] == "win32"} {
7512 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7513 set i [string first "\t" $line]
7515 set file [string range $line [expr {$i+1}] end]
7516 if {[string index $file 0] eq "\""} {
7517 set file [lindex $file 0]
7519 set file [encoding convertfrom $file]
7520 if {$file ne [lindex $treediff end]} {
7521 lappend treediff $file
7522 lappend sublist $file
7526 if {$perfile_attrs} {
7527 cache_gitattr encoding $sublist
7530 return [expr {$nr >= $max? 2: 1}]
7533 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7535 foreach f $treediff {
7536 if {[path_filter $vfilelimit($curview) $f]} {
7540 set treediffs($ids) $flist
7542 set treediffs($ids) $treediff
7545 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7547 } elseif {$ids != $diffids} {
7548 if {![info exists diffmergeid]} {
7549 gettreediffs $diffids
7557 # empty string or positive integer
7558 proc diffcontextvalidate {v} {
7559 return [regexp {^(|[1-9][0-9]*)$} $v]
7562 proc diffcontextchange {n1 n2 op} {
7563 global diffcontextstring diffcontext
7565 if {[string is integer -strict $diffcontextstring]} {
7566 if {$diffcontextstring >= 0} {
7567 set diffcontext $diffcontextstring
7573 proc changeignorespace {} {
7577 proc changeworddiff {name ix op} {
7581 proc getblobdiffs {ids} {
7582 global blobdifffd diffids env
7583 global diffinhdr treediffs
7587 global limitdiffs vfilelimit curview
7588 global diffencoding targetline diffnparents
7589 global git_version currdiffsubmod
7592 if {[package vcompare $git_version "1.6.1"] >= 0} {
7593 set textconv "--textconv"
7596 if {[package vcompare $git_version "1.6.6"] >= 0} {
7597 set submodule "--submodule"
7599 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
7603 if {$worddiff ne [mc "Line diff"]} {
7604 append cmd " --word-diff=porcelain"
7606 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7607 set cmd [concat $cmd -- $vfilelimit($curview)]
7609 if {[catch {set bdf [open $cmd r]} err]} {
7610 error_popup [mc "Error getting diffs: %s" $err]
7616 set diffencoding [get_path_encoding {}]
7617 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7618 set blobdifffd($ids) $bdf
7619 set currdiffsubmod ""
7620 filerun $bdf [list getblobdiffline $bdf $diffids]
7623 proc savecmitpos {} {
7624 global ctext cmitmode
7626 if {$cmitmode eq "tree"} {
7629 return [list target_scrollpos [$ctext index @0,0]]
7632 proc savectextpos {} {
7635 return [list target_scrollpos [$ctext index @0,0]]
7638 proc maybe_scroll_ctext {ateof} {
7639 global ctext target_scrollpos
7641 if {![info exists target_scrollpos]} return
7643 set nlines [expr {[winfo height $ctext]
7644 / [font metrics textfont -linespace]}]
7645 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7647 $ctext yview $target_scrollpos
7648 unset target_scrollpos
7651 proc setinlist {var i val} {
7654 while {[llength [set $var]] < $i} {
7657 if {[llength [set $var]] == $i} {
7664 proc makediffhdr {fname ids} {
7665 global ctext curdiffstart treediffs diffencoding
7666 global ctext_file_names jump_to_here targetline diffline
7668 set fname [encoding convertfrom $fname]
7669 set diffencoding [get_path_encoding $fname]
7670 set i [lsearch -exact $treediffs($ids) $fname]
7672 setinlist difffilestart $i $curdiffstart
7674 lset ctext_file_names end $fname
7675 set l [expr {(78 - [string length $fname]) / 2}]
7676 set pad [string range "----------------------------------------" 1 $l]
7677 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7679 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7680 set targetline [lindex $jump_to_here 1]
7685 proc getblobdiffline {bdf ids} {
7686 global diffids blobdifffd ctext curdiffstart
7687 global diffnexthead diffnextnote difffilestart
7688 global ctext_file_names ctext_file_lines
7689 global diffinhdr treediffs mergemax diffnparents
7690 global diffencoding jump_to_here targetline diffline currdiffsubmod
7694 $ctext conf -state normal
7695 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7696 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7700 if {![string compare -length 5 "diff " $line]} {
7701 if {![regexp {^diff (--cc|--git) } $line m type]} {
7702 set line [encoding convertfrom $line]
7703 $ctext insert end "$line\n" hunksep
7706 # start of a new file
7708 $ctext insert end "\n"
7709 set curdiffstart [$ctext index "end - 1c"]
7710 lappend ctext_file_names ""
7711 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7712 $ctext insert end "\n" filesep
7714 if {$type eq "--cc"} {
7715 # start of a new file in a merge diff
7716 set fname [string range $line 10 end]
7717 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7718 lappend treediffs($ids) $fname
7719 add_flist [list $fname]
7723 set line [string range $line 11 end]
7724 # If the name hasn't changed the length will be odd,
7725 # the middle char will be a space, and the two bits either
7726 # side will be a/name and b/name, or "a/name" and "b/name".
7727 # If the name has changed we'll get "rename from" and
7728 # "rename to" or "copy from" and "copy to" lines following
7729 # this, and we'll use them to get the filenames.
7730 # This complexity is necessary because spaces in the
7731 # filename(s) don't get escaped.
7732 set l [string length $line]
7733 set i [expr {$l / 2}]
7734 if {!(($l & 1) && [string index $line $i] eq " " &&
7735 [string range $line 2 [expr {$i - 1}]] eq \
7736 [string range $line [expr {$i + 3}] end])} {
7739 # unescape if quoted and chop off the a/ from the front
7740 if {[string index $line 0] eq "\""} {
7741 set fname [string range [lindex $line 0] 2 end]
7743 set fname [string range $line 2 [expr {$i - 1}]]
7746 makediffhdr $fname $ids
7748 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7749 set fname [encoding convertfrom [string range $line 16 end]]
7750 $ctext insert end "\n"
7751 set curdiffstart [$ctext index "end - 1c"]
7752 lappend ctext_file_names $fname
7753 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7754 $ctext insert end "$line\n" filesep
7755 set i [lsearch -exact $treediffs($ids) $fname]
7757 setinlist difffilestart $i $curdiffstart
7760 } elseif {![string compare -length 2 "@@" $line]} {
7761 regexp {^@@+} $line ats
7762 set line [encoding convertfrom $diffencoding $line]
7763 $ctext insert end "$line\n" hunksep
7764 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7767 set diffnparents [expr {[string length $ats] - 1}]
7770 } elseif {![string compare -length 10 "Submodule " $line]} {
7771 # start of a new submodule
7772 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7773 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7775 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7777 if {$currdiffsubmod != $fname} {
7778 $ctext insert end "\n"; # Add newline after commit message
7780 set curdiffstart [$ctext index "end - 1c"]
7781 lappend ctext_file_names ""
7782 if {$currdiffsubmod != $fname} {
7783 lappend ctext_file_lines $fname
7784 makediffhdr $fname $ids
7785 set currdiffsubmod $fname
7786 $ctext insert end "\n$line\n" filesep
7788 $ctext insert end "$line\n" filesep
7790 } elseif {![string compare -length 3 " >" $line]} {
7791 set $currdiffsubmod ""
7792 set line [encoding convertfrom $diffencoding $line]
7793 $ctext insert end "$line\n" dresult
7794 } elseif {![string compare -length 3 " <" $line]} {
7795 set $currdiffsubmod ""
7796 set line [encoding convertfrom $diffencoding $line]
7797 $ctext insert end "$line\n" d0
7798 } elseif {$diffinhdr} {
7799 if {![string compare -length 12 "rename from " $line]} {
7800 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7801 if {[string index $fname 0] eq "\""} {
7802 set fname [lindex $fname 0]
7804 set fname [encoding convertfrom $fname]
7805 set i [lsearch -exact $treediffs($ids) $fname]
7807 setinlist difffilestart $i $curdiffstart
7809 } elseif {![string compare -length 10 $line "rename to "] ||
7810 ![string compare -length 8 $line "copy to "]} {
7811 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7812 if {[string index $fname 0] eq "\""} {
7813 set fname [lindex $fname 0]
7815 makediffhdr $fname $ids
7816 } elseif {[string compare -length 3 $line "---"] == 0} {
7819 } elseif {[string compare -length 3 $line "+++"] == 0} {
7823 $ctext insert end "$line\n" filesep
7826 set line [string map {\x1A ^Z} \
7827 [encoding convertfrom $diffencoding $line]]
7828 # parse the prefix - one ' ', '-' or '+' for each parent
7829 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7830 set tag [expr {$diffnparents > 1? "m": "d"}]
7831 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7832 set words_pre_markup ""
7833 set words_post_markup ""
7834 if {[string trim $prefix " -+"] eq {}} {
7835 # prefix only has " ", "-" and "+" in it: normal diff line
7836 set num [string first "-" $prefix]
7838 set line [string range $line 1 end]
7841 # removed line, first parent with line is $num
7842 if {$num >= $mergemax} {
7845 if {$dowords && $worddiff eq [mc "Markup words"]} {
7846 $ctext insert end "\[-$line-\]" $tag$num
7848 $ctext insert end "$line" $tag$num
7851 $ctext insert end "\n" $tag$num
7855 if {[string first "+" $prefix] >= 0} {
7857 lappend tags ${tag}result
7858 if {$diffnparents > 1} {
7859 set num [string first " " $prefix]
7861 if {$num >= $mergemax} {
7867 set words_pre_markup "{+"
7868 set words_post_markup "+}"
7870 if {$targetline ne {}} {
7871 if {$diffline == $targetline} {
7872 set seehere [$ctext index "end - 1 chars"]
7878 if {$dowords && $worddiff eq [mc "Markup words"]} {
7879 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7881 $ctext insert end "$line" $tags
7884 $ctext insert end "\n" $tags
7887 } elseif {$dowords && $prefix eq "~"} {
7888 $ctext insert end "\n" {}
7890 # "\ No newline at end of file",
7891 # or something else we don't recognize
7892 $ctext insert end "$line\n" hunksep
7896 if {[info exists seehere]} {
7897 mark_ctext_line [lindex [split $seehere .] 0]
7899 maybe_scroll_ctext [eof $bdf]
7900 $ctext conf -state disabled
7905 return [expr {$nr >= 1000? 2: 1}]
7908 proc changediffdisp {} {
7909 global ctext diffelide
7911 $ctext tag conf d0 -elide [lindex $diffelide 0]
7912 $ctext tag conf dresult -elide [lindex $diffelide 1]
7915 proc highlightfile {loc cline} {
7916 global ctext cflist cflist_top
7919 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7920 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7921 $cflist see $cline.0
7922 set cflist_top $cline
7926 global difffilestart ctext cmitmode
7928 if {$cmitmode eq "tree"} return
7931 set here [$ctext index @0,0]
7932 foreach loc $difffilestart {
7933 if {[$ctext compare $loc >= $here]} {
7934 highlightfile $prev $prevline
7940 highlightfile $prev $prevline
7944 global difffilestart ctext cmitmode
7946 if {$cmitmode eq "tree"} return
7947 set here [$ctext index @0,0]
7949 foreach loc $difffilestart {
7951 if {[$ctext compare $loc > $here]} {
7952 highlightfile $loc $line
7958 proc clear_ctext {{first 1.0}} {
7959 global ctext smarktop smarkbot
7960 global ctext_file_names ctext_file_lines
7963 set l [lindex [split $first .] 0]
7964 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7967 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7970 $ctext delete $first end
7971 if {$first eq "1.0"} {
7972 catch {unset pendinglinks}
7974 set ctext_file_names {}
7975 set ctext_file_lines {}
7978 proc settabs {{firstab {}}} {
7979 global firsttabstop tabstop ctext have_tk85
7981 if {$firstab ne {} && $have_tk85} {
7982 set firsttabstop $firstab
7984 set w [font measure textfont "0"]
7985 if {$firsttabstop != 0} {
7986 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7987 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7988 } elseif {$have_tk85 || $tabstop != 8} {
7989 $ctext conf -tabs [expr {$tabstop * $w}]
7991 $ctext conf -tabs {}
7995 proc incrsearch {name ix op} {
7996 global ctext searchstring searchdirn
7998 $ctext tag remove found 1.0 end
7999 if {[catch {$ctext index anchor}]} {
8000 # no anchor set, use start of selection, or of visible area
8001 set sel [$ctext tag ranges sel]
8003 $ctext mark set anchor [lindex $sel 0]
8004 } elseif {$searchdirn eq "-forwards"} {
8005 $ctext mark set anchor @0,0
8007 $ctext mark set anchor @0,[winfo height $ctext]
8010 if {$searchstring ne {}} {
8011 set here [$ctext search $searchdirn -- $searchstring anchor]
8020 global sstring ctext searchstring searchdirn
8023 $sstring icursor end
8024 set searchdirn -forwards
8025 if {$searchstring ne {}} {
8026 set sel [$ctext tag ranges sel]
8028 set start "[lindex $sel 0] + 1c"
8029 } elseif {[catch {set start [$ctext index anchor]}]} {
8032 set match [$ctext search -count mlen -- $searchstring $start]
8033 $ctext tag remove sel 1.0 end
8039 set mend "$match + $mlen c"
8040 $ctext tag add sel $match $mend
8041 $ctext mark unset anchor
8045 proc dosearchback {} {
8046 global sstring ctext searchstring searchdirn
8049 $sstring icursor end
8050 set searchdirn -backwards
8051 if {$searchstring ne {}} {
8052 set sel [$ctext tag ranges sel]
8054 set start [lindex $sel 0]
8055 } elseif {[catch {set start [$ctext index anchor]}]} {
8056 set start @0,[winfo height $ctext]
8058 set match [$ctext search -backwards -count ml -- $searchstring $start]
8059 $ctext tag remove sel 1.0 end
8065 set mend "$match + $ml c"
8066 $ctext tag add sel $match $mend
8067 $ctext mark unset anchor
8071 proc searchmark {first last} {
8072 global ctext searchstring
8076 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8077 if {$match eq {}} break
8078 set mend "$match + $mlen c"
8079 $ctext tag add found $match $mend
8083 proc searchmarkvisible {doall} {
8084 global ctext smarktop smarkbot
8086 set topline [lindex [split [$ctext index @0,0] .] 0]
8087 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8088 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8089 # no overlap with previous
8090 searchmark $topline $botline
8091 set smarktop $topline
8092 set smarkbot $botline
8094 if {$topline < $smarktop} {
8095 searchmark $topline [expr {$smarktop-1}]
8096 set smarktop $topline
8098 if {$botline > $smarkbot} {
8099 searchmark [expr {$smarkbot+1}] $botline
8100 set smarkbot $botline
8105 proc scrolltext {f0 f1} {
8108 .bleft.bottom.sb set $f0 $f1
8109 if {$searchstring ne {}} {
8115 global linespc charspc canvx0 canvy0
8116 global xspc1 xspc2 lthickness
8118 set linespc [font metrics mainfont -linespace]
8119 set charspc [font measure mainfont "m"]
8120 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8121 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8122 set lthickness [expr {int($linespc / 9) + 1}]
8123 set xspc1(0) $linespc
8131 set ymax [lindex [$canv cget -scrollregion] 3]
8132 if {$ymax eq {} || $ymax == 0} return
8133 set span [$canv yview]
8136 allcanvs yview moveto [lindex $span 0]
8138 if {$selectedline ne {}} {
8139 selectline $selectedline 0
8140 allcanvs yview moveto [lindex $span 0]
8144 proc parsefont {f n} {
8147 set fontattr($f,family) [lindex $n 0]
8149 if {$s eq {} || $s == 0} {
8152 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8154 set fontattr($f,size) $s
8155 set fontattr($f,weight) normal
8156 set fontattr($f,slant) roman
8157 foreach style [lrange $n 2 end] {
8160 "bold" {set fontattr($f,weight) $style}
8162 "italic" {set fontattr($f,slant) $style}
8167 proc fontflags {f {isbold 0}} {
8170 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8171 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8172 -slant $fontattr($f,slant)]
8178 set n [list $fontattr($f,family) $fontattr($f,size)]
8179 if {$fontattr($f,weight) eq "bold"} {
8182 if {$fontattr($f,slant) eq "italic"} {
8188 proc incrfont {inc} {
8189 global mainfont textfont ctext canv cflist showrefstop
8190 global stopped entries fontattr
8193 set s $fontattr(mainfont,size)
8198 set fontattr(mainfont,size) $s
8199 font config mainfont -size $s
8200 font config mainfontbold -size $s
8201 set mainfont [fontname mainfont]
8202 set s $fontattr(textfont,size)
8207 set fontattr(textfont,size) $s
8208 font config textfont -size $s
8209 font config textfontbold -size $s
8210 set textfont [fontname textfont]
8217 global sha1entry sha1string
8218 if {[string length $sha1string] == 40} {
8219 $sha1entry delete 0 end
8223 proc sha1change {n1 n2 op} {
8224 global sha1string currentid sha1but
8225 if {$sha1string == {}
8226 || ([info exists currentid] && $sha1string == $currentid)} {
8231 if {[$sha1but cget -state] == $state} return
8232 if {$state == "normal"} {
8233 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8235 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8239 proc gotocommit {} {
8240 global sha1string tagids headids curview varcid
8242 if {$sha1string == {}
8243 || ([info exists currentid] && $sha1string == $currentid)} return
8244 if {[info exists tagids($sha1string)]} {
8245 set id $tagids($sha1string)
8246 } elseif {[info exists headids($sha1string)]} {
8247 set id $headids($sha1string)
8249 set id [string tolower $sha1string]
8250 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8251 set matches [longid $id]
8252 if {$matches ne {}} {
8253 if {[llength $matches] > 1} {
8254 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8257 set id [lindex $matches 0]
8260 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8261 error_popup [mc "Revision %s is not known" $sha1string]
8266 if {[commitinview $id $curview]} {
8267 selectline [rowofcommit $id] 1
8270 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8271 set msg [mc "SHA1 id %s is not known" $sha1string]
8273 set msg [mc "Revision %s is not in the current view" $sha1string]
8278 proc lineenter {x y id} {
8279 global hoverx hovery hoverid hovertimer
8280 global commitinfo canv
8282 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8286 if {[info exists hovertimer]} {
8287 after cancel $hovertimer
8289 set hovertimer [after 500 linehover]
8293 proc linemotion {x y id} {
8294 global hoverx hovery hoverid hovertimer
8296 if {[info exists hoverid] && $id == $hoverid} {
8299 if {[info exists hovertimer]} {
8300 after cancel $hovertimer
8302 set hovertimer [after 500 linehover]
8306 proc lineleave {id} {
8307 global hoverid hovertimer canv
8309 if {[info exists hoverid] && $id == $hoverid} {
8311 if {[info exists hovertimer]} {
8312 after cancel $hovertimer
8320 global hoverx hovery hoverid hovertimer
8321 global canv linespc lthickness
8324 set text [lindex $commitinfo($hoverid) 0]
8325 set ymax [lindex [$canv cget -scrollregion] 3]
8326 if {$ymax == {}} return
8327 set yfrac [lindex [$canv yview] 0]
8328 set x [expr {$hoverx + 2 * $linespc}]
8329 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8330 set x0 [expr {$x - 2 * $lthickness}]
8331 set y0 [expr {$y - 2 * $lthickness}]
8332 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8333 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8334 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8335 -fill \#ffff80 -outline black -width 1 -tags hover]
8337 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8342 proc clickisonarrow {id y} {
8345 set ranges [rowranges $id]
8346 set thresh [expr {2 * $lthickness + 6}]
8347 set n [expr {[llength $ranges] - 1}]
8348 for {set i 1} {$i < $n} {incr i} {
8349 set row [lindex $ranges $i]
8350 if {abs([yc $row] - $y) < $thresh} {
8357 proc arrowjump {id n y} {
8360 # 1 <-> 2, 3 <-> 4, etc...
8361 set n [expr {(($n - 1) ^ 1) + 1}]
8362 set row [lindex [rowranges $id] $n]
8364 set ymax [lindex [$canv cget -scrollregion] 3]
8365 if {$ymax eq {} || $ymax <= 0} return
8366 set view [$canv yview]
8367 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8368 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8372 allcanvs yview moveto $yfrac
8375 proc lineclick {x y id isnew} {
8376 global ctext commitinfo children canv thickerline curview
8378 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8383 # draw this line thicker than normal
8387 set ymax [lindex [$canv cget -scrollregion] 3]
8388 if {$ymax eq {}} return
8389 set yfrac [lindex [$canv yview] 0]
8390 set y [expr {$y + $yfrac * $ymax}]
8392 set dirn [clickisonarrow $id $y]
8394 arrowjump $id $dirn $y
8399 addtohistory [list lineclick $x $y $id 0] savectextpos
8401 # fill the details pane with info about this line
8402 $ctext conf -state normal
8405 $ctext insert end "[mc "Parent"]:\t"
8406 $ctext insert end $id link0
8408 set info $commitinfo($id)
8409 $ctext insert end "\n\t[lindex $info 0]\n"
8410 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8411 set date [formatdate [lindex $info 2]]
8412 $ctext insert end "\t[mc "Date"]:\t$date\n"
8413 set kids $children($curview,$id)
8415 $ctext insert end "\n[mc "Children"]:"
8417 foreach child $kids {
8419 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8420 set info $commitinfo($child)
8421 $ctext insert end "\n\t"
8422 $ctext insert end $child link$i
8423 setlink $child link$i
8424 $ctext insert end "\n\t[lindex $info 0]"
8425 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8426 set date [formatdate [lindex $info 2]]
8427 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8430 maybe_scroll_ctext 1
8431 $ctext conf -state disabled
8435 proc normalline {} {
8437 if {[info exists thickerline]} {
8444 proc selbyid {id {isnew 1}} {
8446 if {[commitinview $id $curview]} {
8447 selectline [rowofcommit $id] $isnew
8453 if {![info exists startmstime]} {
8454 set startmstime [clock clicks -milliseconds]
8456 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8459 proc rowmenu {x y id} {
8460 global rowctxmenu selectedline rowmenuid curview
8461 global nullid nullid2 fakerowmenu mainhead markedid
8465 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8470 if {$id ne $nullid && $id ne $nullid2} {
8471 set menu $rowctxmenu
8472 if {$mainhead ne {}} {
8473 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8475 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8477 if {[info exists markedid] && $markedid ne $id} {
8478 $menu entryconfigure 9 -state normal
8479 $menu entryconfigure 10 -state normal
8480 $menu entryconfigure 11 -state normal
8482 $menu entryconfigure 9 -state disabled
8483 $menu entryconfigure 10 -state disabled
8484 $menu entryconfigure 11 -state disabled
8487 set menu $fakerowmenu
8489 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8490 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8491 $menu entryconfigure [mca "Make patch"] -state $state
8492 tk_popup $menu $x $y
8496 global rowmenuid markedid canv
8498 set markedid $rowmenuid
8499 make_idmark $markedid
8505 if {[info exists markedid]} {
8510 proc replace_by_kids {l r} {
8511 global curview children
8513 set id [commitonrow $r]
8514 set l [lreplace $l 0 0]
8515 foreach kid $children($curview,$id) {
8516 lappend l [rowofcommit $kid]
8518 return [lsort -integer -decreasing -unique $l]
8521 proc find_common_desc {} {
8522 global markedid rowmenuid curview children
8524 if {![info exists markedid]} return
8525 if {![commitinview $markedid $curview] ||
8526 ![commitinview $rowmenuid $curview]} return
8527 #set t1 [clock clicks -milliseconds]
8528 set l1 [list [rowofcommit $markedid]]
8529 set l2 [list [rowofcommit $rowmenuid]]
8531 set r1 [lindex $l1 0]
8532 set r2 [lindex $l2 0]
8533 if {$r1 eq {} || $r2 eq {}} break
8539 set l1 [replace_by_kids $l1 $r1]
8541 set l2 [replace_by_kids $l2 $r2]
8544 #set t2 [clock clicks -milliseconds]
8545 #puts "took [expr {$t2-$t1}]ms"
8548 proc compare_commits {} {
8549 global markedid rowmenuid curview children
8551 if {![info exists markedid]} return
8552 if {![commitinview $markedid $curview]} return
8553 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8554 do_cmp_commits $markedid $rowmenuid
8557 proc getpatchid {id} {
8560 if {![info exists patchids($id)]} {
8561 set cmd [diffcmd [list $id] {-p --root}]
8562 # trim off the initial "|"
8563 set cmd [lrange $cmd 1 end]
8565 set x [eval exec $cmd | git patch-id]
8566 set patchids($id) [lindex $x 0]
8568 set patchids($id) "error"
8571 return $patchids($id)
8574 proc do_cmp_commits {a b} {
8575 global ctext curview parents children patchids commitinfo
8577 $ctext conf -state normal
8580 for {set i 0} {$i < 100} {incr i} {
8583 if {[llength $parents($curview,$a)] > 1} {
8584 appendshortlink $a [mc "Skipping merge commit "] "\n"
8587 set patcha [getpatchid $a]
8589 if {[llength $parents($curview,$b)] > 1} {
8590 appendshortlink $b [mc "Skipping merge commit "] "\n"
8593 set patchb [getpatchid $b]
8595 if {!$skipa && !$skipb} {
8596 set heada [lindex $commitinfo($a) 0]
8597 set headb [lindex $commitinfo($b) 0]
8598 if {$patcha eq "error"} {
8599 appendshortlink $a [mc "Error getting patch ID for "] \
8600 [mc " - stopping\n"]
8603 if {$patchb eq "error"} {
8604 appendshortlink $b [mc "Error getting patch ID for "] \
8605 [mc " - stopping\n"]
8608 if {$patcha eq $patchb} {
8609 if {$heada eq $headb} {
8610 appendshortlink $a [mc "Commit "]
8611 appendshortlink $b " == " " $heada\n"
8613 appendshortlink $a [mc "Commit "] " $heada\n"
8614 appendshortlink $b [mc " is the same patch as\n "] \
8620 $ctext insert end "\n"
8621 appendshortlink $a [mc "Commit "] " $heada\n"
8622 appendshortlink $b [mc " differs from\n "] \
8624 $ctext insert end [mc "Diff of commits:\n\n"]
8625 $ctext conf -state disabled
8632 set kids [real_children $curview,$a]
8633 if {[llength $kids] != 1} {
8634 $ctext insert end "\n"
8635 appendshortlink $a [mc "Commit "] \
8636 [mc " has %s children - stopping\n" [llength $kids]]
8639 set a [lindex $kids 0]
8642 set kids [real_children $curview,$b]
8643 if {[llength $kids] != 1} {
8644 appendshortlink $b [mc "Commit "] \
8645 [mc " has %s children - stopping\n" [llength $kids]]
8648 set b [lindex $kids 0]
8651 $ctext conf -state disabled
8654 proc diffcommits {a b} {
8655 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8657 set tmpdir [gitknewtmpdir]
8658 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8659 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8661 exec git diff-tree -p --pretty $a >$fna
8662 exec git diff-tree -p --pretty $b >$fnb
8664 error_popup [mc "Error writing commit to file: %s" $err]
8668 set fd [open "| diff -U$diffcontext $fna $fnb" r]
8670 error_popup [mc "Error diffing commits: %s" $err]
8673 set diffids [list commits $a $b]
8674 set blobdifffd($diffids) $fd
8676 set currdiffsubmod ""
8677 filerun $fd [list getblobdiffline $fd $diffids]
8680 proc diffvssel {dirn} {
8681 global rowmenuid selectedline
8683 if {$selectedline eq {}} return
8685 set oldid [commitonrow $selectedline]
8686 set newid $rowmenuid
8688 set oldid $rowmenuid
8689 set newid [commitonrow $selectedline]
8691 addtohistory [list doseldiff $oldid $newid] savectextpos
8692 doseldiff $oldid $newid
8695 proc doseldiff {oldid newid} {
8699 $ctext conf -state normal
8701 init_flist [mc "Top"]
8702 $ctext insert end "[mc "From"] "
8703 $ctext insert end $oldid link0
8704 setlink $oldid link0
8705 $ctext insert end "\n "
8706 $ctext insert end [lindex $commitinfo($oldid) 0]
8707 $ctext insert end "\n\n[mc "To"] "
8708 $ctext insert end $newid link1
8709 setlink $newid link1
8710 $ctext insert end "\n "
8711 $ctext insert end [lindex $commitinfo($newid) 0]
8712 $ctext insert end "\n"
8713 $ctext conf -state disabled
8714 $ctext tag remove found 1.0 end
8715 startdiff [list $oldid $newid]
8719 global rowmenuid currentid commitinfo patchtop patchnum NS
8721 if {![info exists currentid]} return
8722 set oldid $currentid
8723 set oldhead [lindex $commitinfo($oldid) 0]
8724 set newid $rowmenuid
8725 set newhead [lindex $commitinfo($newid) 0]
8728 catch {destroy $top}
8730 make_transient $top .
8731 ${NS}::label $top.title -text [mc "Generate patch"]
8732 grid $top.title - -pady 10
8733 ${NS}::label $top.from -text [mc "From:"]
8734 ${NS}::entry $top.fromsha1 -width 40
8735 $top.fromsha1 insert 0 $oldid
8736 $top.fromsha1 conf -state readonly
8737 grid $top.from $top.fromsha1 -sticky w
8738 ${NS}::entry $top.fromhead -width 60
8739 $top.fromhead insert 0 $oldhead
8740 $top.fromhead conf -state readonly
8741 grid x $top.fromhead -sticky w
8742 ${NS}::label $top.to -text [mc "To:"]
8743 ${NS}::entry $top.tosha1 -width 40
8744 $top.tosha1 insert 0 $newid
8745 $top.tosha1 conf -state readonly
8746 grid $top.to $top.tosha1 -sticky w
8747 ${NS}::entry $top.tohead -width 60
8748 $top.tohead insert 0 $newhead
8749 $top.tohead conf -state readonly
8750 grid x $top.tohead -sticky w
8751 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8752 grid $top.rev x -pady 10 -padx 5
8753 ${NS}::label $top.flab -text [mc "Output file:"]
8754 ${NS}::entry $top.fname -width 60
8755 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8757 grid $top.flab $top.fname -sticky w
8758 ${NS}::frame $top.buts
8759 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8760 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8761 bind $top <Key-Return> mkpatchgo
8762 bind $top <Key-Escape> mkpatchcan
8763 grid $top.buts.gen $top.buts.can
8764 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8765 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8766 grid $top.buts - -pady 10 -sticky ew
8770 proc mkpatchrev {} {
8773 set oldid [$patchtop.fromsha1 get]
8774 set oldhead [$patchtop.fromhead get]
8775 set newid [$patchtop.tosha1 get]
8776 set newhead [$patchtop.tohead get]
8777 foreach e [list fromsha1 fromhead tosha1 tohead] \
8778 v [list $newid $newhead $oldid $oldhead] {
8779 $patchtop.$e conf -state normal
8780 $patchtop.$e delete 0 end
8781 $patchtop.$e insert 0 $v
8782 $patchtop.$e conf -state readonly
8787 global patchtop nullid nullid2
8789 set oldid [$patchtop.fromsha1 get]
8790 set newid [$patchtop.tosha1 get]
8791 set fname [$patchtop.fname get]
8792 set cmd [diffcmd [list $oldid $newid] -p]
8793 # trim off the initial "|"
8794 set cmd [lrange $cmd 1 end]
8795 lappend cmd >$fname &
8796 if {[catch {eval exec $cmd} err]} {
8797 error_popup "[mc "Error creating patch:"] $err" $patchtop
8799 catch {destroy $patchtop}
8803 proc mkpatchcan {} {
8806 catch {destroy $patchtop}
8811 global rowmenuid mktagtop commitinfo NS
8815 catch {destroy $top}
8817 make_transient $top .
8818 ${NS}::label $top.title -text [mc "Create tag"]
8819 grid $top.title - -pady 10
8820 ${NS}::label $top.id -text [mc "ID:"]
8821 ${NS}::entry $top.sha1 -width 40
8822 $top.sha1 insert 0 $rowmenuid
8823 $top.sha1 conf -state readonly
8824 grid $top.id $top.sha1 -sticky w
8825 ${NS}::entry $top.head -width 60
8826 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8827 $top.head conf -state readonly
8828 grid x $top.head -sticky w
8829 ${NS}::label $top.tlab -text [mc "Tag name:"]
8830 ${NS}::entry $top.tag -width 60
8831 grid $top.tlab $top.tag -sticky w
8832 ${NS}::label $top.op -text [mc "Tag message is optional"]
8833 grid $top.op -columnspan 2 -sticky we
8834 ${NS}::label $top.mlab -text [mc "Tag message:"]
8835 ${NS}::entry $top.msg -width 60
8836 grid $top.mlab $top.msg -sticky w
8837 ${NS}::frame $top.buts
8838 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8839 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8840 bind $top <Key-Return> mktaggo
8841 bind $top <Key-Escape> mktagcan
8842 grid $top.buts.gen $top.buts.can
8843 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8844 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8845 grid $top.buts - -pady 10 -sticky ew
8850 global mktagtop env tagids idtags
8852 set id [$mktagtop.sha1 get]
8853 set tag [$mktagtop.tag get]
8854 set msg [$mktagtop.msg get]
8856 error_popup [mc "No tag name specified"] $mktagtop
8859 if {[info exists tagids($tag)]} {
8860 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8865 exec git tag -a -m $msg $tag $id
8867 exec git tag $tag $id
8870 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8874 set tagids($tag) $id
8875 lappend idtags($id) $tag
8883 proc redrawtags {id} {
8884 global canv linehtag idpos currentid curview cmitlisted markedid
8885 global canvxmax iddrawn circleitem mainheadid circlecolors
8887 if {![commitinview $id $curview]} return
8888 if {![info exists iddrawn($id)]} return
8889 set row [rowofcommit $id]
8890 if {$id eq $mainheadid} {
8893 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8895 $canv itemconf $circleitem($row) -fill $ofill
8896 $canv delete tag.$id
8897 set xt [eval drawtags $id $idpos($id)]
8898 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8899 set text [$canv itemcget $linehtag($id) -text]
8900 set font [$canv itemcget $linehtag($id) -font]
8901 set xr [expr {$xt + [font measure $font $text]}]
8902 if {$xr > $canvxmax} {
8906 if {[info exists currentid] && $currentid == $id} {
8909 if {[info exists markedid] && $markedid eq $id} {
8917 catch {destroy $mktagtop}
8922 if {![domktag]} return
8926 proc writecommit {} {
8927 global rowmenuid wrcomtop commitinfo wrcomcmd NS
8929 set top .writecommit
8931 catch {destroy $top}
8933 make_transient $top .
8934 ${NS}::label $top.title -text [mc "Write commit to file"]
8935 grid $top.title - -pady 10
8936 ${NS}::label $top.id -text [mc "ID:"]
8937 ${NS}::entry $top.sha1 -width 40
8938 $top.sha1 insert 0 $rowmenuid
8939 $top.sha1 conf -state readonly
8940 grid $top.id $top.sha1 -sticky w
8941 ${NS}::entry $top.head -width 60
8942 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8943 $top.head conf -state readonly
8944 grid x $top.head -sticky w
8945 ${NS}::label $top.clab -text [mc "Command:"]
8946 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8947 grid $top.clab $top.cmd -sticky w -pady 10
8948 ${NS}::label $top.flab -text [mc "Output file:"]
8949 ${NS}::entry $top.fname -width 60
8950 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8951 grid $top.flab $top.fname -sticky w
8952 ${NS}::frame $top.buts
8953 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8954 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8955 bind $top <Key-Return> wrcomgo
8956 bind $top <Key-Escape> wrcomcan
8957 grid $top.buts.gen $top.buts.can
8958 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8959 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8960 grid $top.buts - -pady 10 -sticky ew
8967 set id [$wrcomtop.sha1 get]
8968 set cmd "echo $id | [$wrcomtop.cmd get]"
8969 set fname [$wrcomtop.fname get]
8970 if {[catch {exec sh -c $cmd >$fname &} err]} {
8971 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8973 catch {destroy $wrcomtop}
8980 catch {destroy $wrcomtop}
8985 global rowmenuid mkbrtop NS
8988 catch {destroy $top}
8990 make_transient $top .
8991 ${NS}::label $top.title -text [mc "Create new branch"]
8992 grid $top.title - -pady 10
8993 ${NS}::label $top.id -text [mc "ID:"]
8994 ${NS}::entry $top.sha1 -width 40
8995 $top.sha1 insert 0 $rowmenuid
8996 $top.sha1 conf -state readonly
8997 grid $top.id $top.sha1 -sticky w
8998 ${NS}::label $top.nlab -text [mc "Name:"]
8999 ${NS}::entry $top.name -width 40
9000 grid $top.nlab $top.name -sticky w
9001 ${NS}::frame $top.buts
9002 ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9003 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9004 bind $top <Key-Return> [list mkbrgo $top]
9005 bind $top <Key-Escape> "catch {destroy $top}"
9006 grid $top.buts.go $top.buts.can
9007 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9008 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9009 grid $top.buts - -pady 10 -sticky ew
9014 global headids idheads
9016 set name [$top.name get]
9017 set id [$top.sha1 get]
9021 error_popup [mc "Please specify a name for the new branch"] $top
9024 if {[info exists headids($name)]} {
9025 if {![confirm_popup [mc \
9026 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9029 set old_id $headids($name)
9032 catch {destroy $top}
9033 lappend cmdargs $name $id
9037 eval exec git branch $cmdargs
9043 if {$old_id ne {}} {
9049 set headids($name) $id
9050 lappend idheads($id) $name
9059 proc exec_citool {tool_args {baseid {}}} {
9060 global commitinfo env
9062 set save_env [array get env GIT_AUTHOR_*]
9064 if {$baseid ne {}} {
9065 if {![info exists commitinfo($baseid)]} {
9068 set author [lindex $commitinfo($baseid) 1]
9069 set date [lindex $commitinfo($baseid) 2]
9070 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9071 $author author name email]
9073 set env(GIT_AUTHOR_NAME) $name
9074 set env(GIT_AUTHOR_EMAIL) $email
9075 set env(GIT_AUTHOR_DATE) $date
9079 eval exec git citool $tool_args &
9081 array unset env GIT_AUTHOR_*
9082 array set env $save_env
9085 proc cherrypick {} {
9086 global rowmenuid curview
9087 global mainhead mainheadid
9090 set oldhead [exec git rev-parse HEAD]
9091 set dheads [descheads $rowmenuid]
9092 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9093 set ok [confirm_popup [mc "Commit %s is already\
9094 included in branch %s -- really re-apply it?" \
9095 [string range $rowmenuid 0 7] $mainhead]]
9098 nowbusy cherrypick [mc "Cherry-picking"]
9100 # Unfortunately git-cherry-pick writes stuff to stderr even when
9101 # no error occurs, and exec takes that as an indication of error...
9102 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9105 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9107 error_popup [mc "Cherry-pick failed because of local changes\
9108 to file '%s'.\nPlease commit, reset or stash\
9109 your changes and try again." $fname]
9110 } elseif {[regexp -line \
9111 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9113 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9114 conflict.\nDo you wish to run git citool to\
9116 # Force citool to read MERGE_MSG
9117 file delete [file join $gitdir "GITGUI_MSG"]
9118 exec_citool {} $rowmenuid
9126 set newhead [exec git rev-parse HEAD]
9127 if {$newhead eq $oldhead} {
9129 error_popup [mc "No changes committed"]
9132 addnewchild $newhead $oldhead
9133 if {[commitinview $oldhead $curview]} {
9134 # XXX this isn't right if we have a path limit...
9135 insertrow $newhead $oldhead $curview
9136 if {$mainhead ne {}} {
9137 movehead $newhead $mainhead
9138 movedhead $newhead $mainhead
9140 set mainheadid $newhead
9149 global mainhead rowmenuid confirm_ok resettype NS
9152 set w ".confirmreset"
9155 wm title $w [mc "Confirm reset"]
9156 ${NS}::label $w.m -text \
9157 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9158 pack $w.m -side top -fill x -padx 20 -pady 20
9159 ${NS}::labelframe $w.f -text [mc "Reset type:"]
9161 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9162 -text [mc "Soft: Leave working tree and index untouched"]
9163 grid $w.f.soft -sticky w
9164 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9165 -text [mc "Mixed: Leave working tree untouched, reset index"]
9166 grid $w.f.mixed -sticky w
9167 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9168 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9169 grid $w.f.hard -sticky w
9170 pack $w.f -side top -fill x -padx 4
9171 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9172 pack $w.ok -side left -fill x -padx 20 -pady 20
9173 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9174 bind $w <Key-Escape> [list destroy $w]
9175 pack $w.cancel -side right -fill x -padx 20 -pady 20
9176 bind $w <Visibility> "grab $w; focus $w"
9178 if {!$confirm_ok} return
9179 if {[catch {set fd [open \
9180 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9184 filerun $fd [list readresetstat $fd]
9185 nowbusy reset [mc "Resetting"]
9190 proc readresetstat {fd} {
9191 global mainhead mainheadid showlocalchanges rprogcoord
9193 if {[gets $fd line] >= 0} {
9194 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9195 set rprogcoord [expr {1.0 * $m / $n}]
9203 if {[catch {close $fd} err]} {
9206 set oldhead $mainheadid
9207 set newhead [exec git rev-parse HEAD]
9208 if {$newhead ne $oldhead} {
9209 movehead $newhead $mainhead
9210 movedhead $newhead $mainhead
9211 set mainheadid $newhead
9215 if {$showlocalchanges} {
9221 # context menu for a head
9222 proc headmenu {x y id head} {
9223 global headmenuid headmenuhead headctxmenu mainhead
9227 set headmenuhead $head
9229 if {[string match "remotes/*" $head]} {
9232 if {$head eq $mainhead} {
9235 $headctxmenu entryconfigure 0 -state $state
9236 $headctxmenu entryconfigure 1 -state $state
9237 tk_popup $headctxmenu $x $y
9241 global headmenuid headmenuhead headids
9242 global showlocalchanges
9244 # check the tree is clean first??
9245 nowbusy checkout [mc "Checking out"]
9249 set fd [open [list | git checkout $headmenuhead 2>@1] r]
9253 if {$showlocalchanges} {
9257 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9261 proc readcheckoutstat {fd newhead newheadid} {
9262 global mainhead mainheadid headids showlocalchanges progresscoords
9263 global viewmainheadid curview
9265 if {[gets $fd line] >= 0} {
9266 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9267 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9272 set progresscoords {0 0}
9275 if {[catch {close $fd} err]} {
9278 set oldmainid $mainheadid
9279 set mainhead $newhead
9280 set mainheadid $newheadid
9281 set viewmainheadid($curview) $newheadid
9282 redrawtags $oldmainid
9283 redrawtags $newheadid
9285 if {$showlocalchanges} {
9291 global headmenuid headmenuhead mainhead
9294 set head $headmenuhead
9296 # this check shouldn't be needed any more...
9297 if {$head eq $mainhead} {
9298 error_popup [mc "Cannot delete the currently checked-out branch"]
9301 set dheads [descheads $id]
9302 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9303 # the stuff on this branch isn't on any other branch
9304 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9305 branch.\nReally delete branch %s?" $head $head]]} return
9309 if {[catch {exec git branch -D $head} err]} {
9314 removehead $id $head
9315 removedhead $id $head
9322 # Display a list of tags and heads
9324 global showrefstop bgcolor fgcolor selectbgcolor NS
9325 global bglist fglist reflistfilter reflist maincursor
9328 set showrefstop $top
9329 if {[winfo exists $top]} {
9335 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9336 make_transient $top .
9337 text $top.list -background $bgcolor -foreground $fgcolor \
9338 -selectbackground $selectbgcolor -font mainfont \
9339 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9340 -width 30 -height 20 -cursor $maincursor \
9341 -spacing1 1 -spacing3 1 -state disabled
9342 $top.list tag configure highlight -background $selectbgcolor
9343 lappend bglist $top.list
9344 lappend fglist $top.list
9345 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9346 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9347 grid $top.list $top.ysb -sticky nsew
9348 grid $top.xsb x -sticky ew
9350 ${NS}::label $top.f.l -text "[mc "Filter"]: "
9351 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9352 set reflistfilter "*"
9353 trace add variable reflistfilter write reflistfilter_change
9354 pack $top.f.e -side right -fill x -expand 1
9355 pack $top.f.l -side left
9356 grid $top.f - -sticky ew -pady 2
9357 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9358 bind $top <Key-Escape> [list destroy $top]
9360 grid columnconfigure $top 0 -weight 1
9361 grid rowconfigure $top 0 -weight 1
9362 bind $top.list <1> {break}
9363 bind $top.list <B1-Motion> {break}
9364 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9369 proc sel_reflist {w x y} {
9370 global showrefstop reflist headids tagids otherrefids
9372 if {![winfo exists $showrefstop]} return
9373 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9374 set ref [lindex $reflist [expr {$l-1}]]
9375 set n [lindex $ref 0]
9376 switch -- [lindex $ref 1] {
9377 "H" {selbyid $headids($n)}
9378 "T" {selbyid $tagids($n)}
9379 "o" {selbyid $otherrefids($n)}
9381 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9384 proc unsel_reflist {} {
9387 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9388 $showrefstop.list tag remove highlight 0.0 end
9391 proc reflistfilter_change {n1 n2 op} {
9392 global reflistfilter
9394 after cancel refill_reflist
9395 after 200 refill_reflist
9398 proc refill_reflist {} {
9399 global reflist reflistfilter showrefstop headids tagids otherrefids
9402 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9404 foreach n [array names headids] {
9405 if {[string match $reflistfilter $n]} {
9406 if {[commitinview $headids($n) $curview]} {
9407 lappend refs [list $n H]
9409 interestedin $headids($n) {run refill_reflist}
9413 foreach n [array names tagids] {
9414 if {[string match $reflistfilter $n]} {
9415 if {[commitinview $tagids($n) $curview]} {
9416 lappend refs [list $n T]
9418 interestedin $tagids($n) {run refill_reflist}
9422 foreach n [array names otherrefids] {
9423 if {[string match $reflistfilter $n]} {
9424 if {[commitinview $otherrefids($n) $curview]} {
9425 lappend refs [list $n o]
9427 interestedin $otherrefids($n) {run refill_reflist}
9431 set refs [lsort -index 0 $refs]
9432 if {$refs eq $reflist} return
9434 # Update the contents of $showrefstop.list according to the
9435 # differences between $reflist (old) and $refs (new)
9436 $showrefstop.list conf -state normal
9437 $showrefstop.list insert end "\n"
9440 while {$i < [llength $reflist] || $j < [llength $refs]} {
9441 if {$i < [llength $reflist]} {
9442 if {$j < [llength $refs]} {
9443 set cmp [string compare [lindex $reflist $i 0] \
9444 [lindex $refs $j 0]]
9446 set cmp [string compare [lindex $reflist $i 1] \
9447 [lindex $refs $j 1]]
9457 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9465 set l [expr {$j + 1}]
9466 $showrefstop.list image create $l.0 -align baseline \
9467 -image reficon-[lindex $refs $j 1] -padx 2
9468 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9474 # delete last newline
9475 $showrefstop.list delete end-2c end-1c
9476 $showrefstop.list conf -state disabled
9479 # Stuff for finding nearby tags
9480 proc getallcommits {} {
9481 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9482 global idheads idtags idotherrefs allparents tagobjid
9485 if {![info exists allcommits]} {
9491 set allccache [file join $gitdir "gitk.cache"]
9493 set f [open $allccache r]
9502 set cmd [list | git rev-list --parents]
9503 set allcupdate [expr {$seeds ne {}}]
9507 set refs [concat [array names idheads] [array names idtags] \
9508 [array names idotherrefs]]
9511 foreach name [array names tagobjid] {
9512 lappend tagobjs $tagobjid($name)
9514 foreach id [lsort -unique $refs] {
9515 if {![info exists allparents($id)] &&
9516 [lsearch -exact $tagobjs $id] < 0} {
9527 set fd [open [concat $cmd $ids] r]
9528 fconfigure $fd -blocking 0
9531 filerun $fd [list getallclines $fd]
9537 # Since most commits have 1 parent and 1 child, we group strings of
9538 # such commits into "arcs" joining branch/merge points (BMPs), which
9539 # are commits that either don't have 1 parent or don't have 1 child.
9541 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9542 # arcout(id) - outgoing arcs for BMP
9543 # arcids(a) - list of IDs on arc including end but not start
9544 # arcstart(a) - BMP ID at start of arc
9545 # arcend(a) - BMP ID at end of arc
9546 # growing(a) - arc a is still growing
9547 # arctags(a) - IDs out of arcids (excluding end) that have tags
9548 # archeads(a) - IDs out of arcids (excluding end) that have heads
9549 # The start of an arc is at the descendent end, so "incoming" means
9550 # coming from descendents, and "outgoing" means going towards ancestors.
9552 proc getallclines {fd} {
9553 global allparents allchildren idtags idheads nextarc
9554 global arcnos arcids arctags arcout arcend arcstart archeads growing
9555 global seeds allcommits cachedarcs allcupdate
9558 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9559 set id [lindex $line 0]
9560 if {[info exists allparents($id)]} {
9565 set olds [lrange $line 1 end]
9566 set allparents($id) $olds
9567 if {![info exists allchildren($id)]} {
9568 set allchildren($id) {}
9573 if {[llength $olds] == 1 && [llength $a] == 1} {
9574 lappend arcids($a) $id
9575 if {[info exists idtags($id)]} {
9576 lappend arctags($a) $id
9578 if {[info exists idheads($id)]} {
9579 lappend archeads($a) $id
9581 if {[info exists allparents($olds)]} {
9582 # seen parent already
9583 if {![info exists arcout($olds)]} {
9586 lappend arcids($a) $olds
9587 set arcend($a) $olds
9590 lappend allchildren($olds) $id
9591 lappend arcnos($olds) $a
9595 foreach a $arcnos($id) {
9596 lappend arcids($a) $id
9603 lappend allchildren($p) $id
9604 set a [incr nextarc]
9605 set arcstart($a) $id
9612 if {[info exists allparents($p)]} {
9613 # seen it already, may need to make a new branch
9614 if {![info exists arcout($p)]} {
9617 lappend arcids($a) $p
9621 lappend arcnos($p) $a
9626 global cached_dheads cached_dtags cached_atags
9627 catch {unset cached_dheads}
9628 catch {unset cached_dtags}
9629 catch {unset cached_atags}
9632 return [expr {$nid >= 1000? 2: 1}]
9636 fconfigure $fd -blocking 1
9639 # got an error reading the list of commits
9640 # if we were updating, try rereading the whole thing again
9646 error_popup "[mc "Error reading commit topology information;\
9647 branch and preceding/following tag information\
9648 will be incomplete."]\n($err)"
9651 if {[incr allcommits -1] == 0} {
9661 proc recalcarc {a} {
9662 global arctags archeads arcids idtags idheads
9666 foreach id [lrange $arcids($a) 0 end-1] {
9667 if {[info exists idtags($id)]} {
9670 if {[info exists idheads($id)]} {
9675 set archeads($a) $ah
9679 global arcnos arcids nextarc arctags archeads idtags idheads
9680 global arcstart arcend arcout allparents growing
9683 if {[llength $a] != 1} {
9684 puts "oops splitarc called but [llength $a] arcs already"
9688 set i [lsearch -exact $arcids($a) $p]
9690 puts "oops splitarc $p not in arc $a"
9693 set na [incr nextarc]
9694 if {[info exists arcend($a)]} {
9695 set arcend($na) $arcend($a)
9697 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9698 set j [lsearch -exact $arcnos($l) $a]
9699 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9701 set tail [lrange $arcids($a) [expr {$i+1}] end]
9702 set arcids($a) [lrange $arcids($a) 0 $i]
9704 set arcstart($na) $p
9706 set arcids($na) $tail
9707 if {[info exists growing($a)]} {
9713 if {[llength $arcnos($id)] == 1} {
9716 set j [lsearch -exact $arcnos($id) $a]
9717 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9721 # reconstruct tags and heads lists
9722 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9727 set archeads($na) {}
9731 # Update things for a new commit added that is a child of one
9732 # existing commit. Used when cherry-picking.
9733 proc addnewchild {id p} {
9734 global allparents allchildren idtags nextarc
9735 global arcnos arcids arctags arcout arcend arcstart archeads growing
9736 global seeds allcommits
9738 if {![info exists allcommits] || ![info exists arcnos($p)]} return
9739 set allparents($id) [list $p]
9740 set allchildren($id) {}
9743 lappend allchildren($p) $id
9744 set a [incr nextarc]
9745 set arcstart($a) $id
9748 set arcids($a) [list $p]
9750 if {![info exists arcout($p)]} {
9753 lappend arcnos($p) $a
9754 set arcout($id) [list $a]
9757 # This implements a cache for the topology information.
9758 # The cache saves, for each arc, the start and end of the arc,
9759 # the ids on the arc, and the outgoing arcs from the end.
9760 proc readcache {f} {
9761 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9762 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9767 if {$lim - $a > 500} {
9768 set lim [expr {$a + 500}]
9772 # finish reading the cache and setting up arctags, etc.
9774 if {$line ne "1"} {error "bad final version"}
9776 foreach id [array names idtags] {
9777 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9778 [llength $allparents($id)] == 1} {
9779 set a [lindex $arcnos($id) 0]
9780 if {$arctags($a) eq {}} {
9785 foreach id [array names idheads] {
9786 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9787 [llength $allparents($id)] == 1} {
9788 set a [lindex $arcnos($id) 0]
9789 if {$archeads($a) eq {}} {
9794 foreach id [lsort -unique $possible_seeds] {
9795 if {$arcnos($id) eq {}} {
9801 while {[incr a] <= $lim} {
9803 if {[llength $line] != 3} {error "bad line"}
9804 set s [lindex $line 0]
9806 lappend arcout($s) $a
9807 if {![info exists arcnos($s)]} {
9808 lappend possible_seeds $s
9811 set e [lindex $line 1]
9816 if {![info exists arcout($e)]} {
9820 set arcids($a) [lindex $line 2]
9821 foreach id $arcids($a) {
9822 lappend allparents($s) $id
9824 lappend arcnos($id) $a
9826 if {![info exists allparents($s)]} {
9827 set allparents($s) {}
9832 set nextarc [expr {$a - 1}]
9845 global nextarc cachedarcs possible_seeds
9849 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9850 # make sure it's an integer
9851 set cachedarcs [expr {int([lindex $line 1])}]
9852 if {$cachedarcs < 0} {error "bad number of arcs"}
9854 set possible_seeds {}
9862 proc dropcache {err} {
9863 global allcwait nextarc cachedarcs seeds
9865 #puts "dropping cache ($err)"
9866 foreach v {arcnos arcout arcids arcstart arcend growing \
9867 arctags archeads allparents allchildren} {
9878 proc writecache {f} {
9879 global cachearc cachedarcs allccache
9880 global arcstart arcend arcnos arcids arcout
9884 if {$lim - $a > 1000} {
9885 set lim [expr {$a + 1000}]
9888 while {[incr a] <= $lim} {
9889 if {[info exists arcend($a)]} {
9890 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9892 puts $f [list $arcstart($a) {} $arcids($a)]
9897 catch {file delete $allccache}
9898 #puts "writing cache failed ($err)"
9901 set cachearc [expr {$a - 1}]
9902 if {$a > $cachedarcs} {
9911 global nextarc cachedarcs cachearc allccache
9913 if {$nextarc == $cachedarcs} return
9915 set cachedarcs $nextarc
9917 set f [open $allccache w]
9918 puts $f [list 1 $cachedarcs]
9923 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9924 # or 0 if neither is true.
9925 proc anc_or_desc {a b} {
9926 global arcout arcstart arcend arcnos cached_isanc
9928 if {$arcnos($a) eq $arcnos($b)} {
9929 # Both are on the same arc(s); either both are the same BMP,
9930 # or if one is not a BMP, the other is also not a BMP or is
9931 # the BMP at end of the arc (and it only has 1 incoming arc).
9932 # Or both can be BMPs with no incoming arcs.
9933 if {$a eq $b || $arcnos($a) eq {}} {
9936 # assert {[llength $arcnos($a)] == 1}
9937 set arc [lindex $arcnos($a) 0]
9938 set i [lsearch -exact $arcids($arc) $a]
9939 set j [lsearch -exact $arcids($arc) $b]
9940 if {$i < 0 || $i > $j} {
9947 if {![info exists arcout($a)]} {
9948 set arc [lindex $arcnos($a) 0]
9949 if {[info exists arcend($arc)]} {
9950 set aend $arcend($arc)
9954 set a $arcstart($arc)
9958 if {![info exists arcout($b)]} {
9959 set arc [lindex $arcnos($b) 0]
9960 if {[info exists arcend($arc)]} {
9961 set bend $arcend($arc)
9965 set b $arcstart($arc)
9975 if {[info exists cached_isanc($a,$bend)]} {
9976 if {$cached_isanc($a,$bend)} {
9980 if {[info exists cached_isanc($b,$aend)]} {
9981 if {$cached_isanc($b,$aend)} {
9984 if {[info exists cached_isanc($a,$bend)]} {
9989 set todo [list $a $b]
9992 for {set i 0} {$i < [llength $todo]} {incr i} {
9993 set x [lindex $todo $i]
9994 if {$anc($x) eq {}} {
9997 foreach arc $arcnos($x) {
9998 set xd $arcstart($arc)
10000 set cached_isanc($a,$bend) 1
10001 set cached_isanc($b,$aend) 0
10003 } elseif {$xd eq $aend} {
10004 set cached_isanc($b,$aend) 1
10005 set cached_isanc($a,$bend) 0
10008 if {![info exists anc($xd)]} {
10009 set anc($xd) $anc($x)
10011 } elseif {$anc($xd) ne $anc($x)} {
10016 set cached_isanc($a,$bend) 0
10017 set cached_isanc($b,$aend) 0
10021 # This identifies whether $desc has an ancestor that is
10022 # a growing tip of the graph and which is not an ancestor of $anc
10023 # and returns 0 if so and 1 if not.
10024 # If we subsequently discover a tag on such a growing tip, and that
10025 # turns out to be a descendent of $anc (which it could, since we
10026 # don't necessarily see children before parents), then $desc
10027 # isn't a good choice to display as a descendent tag of
10028 # $anc (since it is the descendent of another tag which is
10029 # a descendent of $anc). Similarly, $anc isn't a good choice to
10030 # display as a ancestor tag of $desc.
10032 proc is_certain {desc anc} {
10033 global arcnos arcout arcstart arcend growing problems
10036 if {[llength $arcnos($anc)] == 1} {
10037 # tags on the same arc are certain
10038 if {$arcnos($desc) eq $arcnos($anc)} {
10041 if {![info exists arcout($anc)]} {
10042 # if $anc is partway along an arc, use the start of the arc instead
10043 set a [lindex $arcnos($anc) 0]
10044 set anc $arcstart($a)
10047 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10050 set a [lindex $arcnos($desc) 0]
10056 set anclist [list $x]
10060 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10061 set x [lindex $anclist $i]
10066 foreach a $arcout($x) {
10067 if {[info exists growing($a)]} {
10068 if {![info exists growanc($x)] && $dl($x)} {
10074 if {[info exists dl($y)]} {
10078 if {![info exists done($y)]} {
10081 if {[info exists growanc($x)]} {
10085 for {set k 0} {$k < [llength $xl]} {incr k} {
10086 set z [lindex $xl $k]
10087 foreach c $arcout($z) {
10088 if {[info exists arcend($c)]} {
10090 if {[info exists dl($v)] && $dl($v)} {
10092 if {![info exists done($v)]} {
10095 if {[info exists growanc($v)]} {
10105 } elseif {$y eq $anc || !$dl($x)} {
10116 foreach x [array names growanc] {
10125 proc validate_arctags {a} {
10126 global arctags idtags
10129 set na $arctags($a)
10130 foreach id $arctags($a) {
10132 if {![info exists idtags($id)]} {
10133 set na [lreplace $na $i $i]
10137 set arctags($a) $na
10140 proc validate_archeads {a} {
10141 global archeads idheads
10144 set na $archeads($a)
10145 foreach id $archeads($a) {
10147 if {![info exists idheads($id)]} {
10148 set na [lreplace $na $i $i]
10152 set archeads($a) $na
10155 # Return the list of IDs that have tags that are descendents of id,
10156 # ignoring IDs that are descendents of IDs already reported.
10157 proc desctags {id} {
10158 global arcnos arcstart arcids arctags idtags allparents
10159 global growing cached_dtags
10161 if {![info exists allparents($id)]} {
10164 set t1 [clock clicks -milliseconds]
10166 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10167 # part-way along an arc; check that arc first
10168 set a [lindex $arcnos($id) 0]
10169 if {$arctags($a) ne {}} {
10170 validate_arctags $a
10171 set i [lsearch -exact $arcids($a) $id]
10173 foreach t $arctags($a) {
10174 set j [lsearch -exact $arcids($a) $t]
10175 if {$j >= $i} break
10182 set id $arcstart($a)
10183 if {[info exists idtags($id)]} {
10187 if {[info exists cached_dtags($id)]} {
10188 return $cached_dtags($id)
10192 set todo [list $id]
10195 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10196 set id [lindex $todo $i]
10198 set ta [info exists hastaggedancestor($id)]
10202 # ignore tags on starting node
10203 if {!$ta && $i > 0} {
10204 if {[info exists idtags($id)]} {
10205 set tagloc($id) $id
10207 } elseif {[info exists cached_dtags($id)]} {
10208 set tagloc($id) $cached_dtags($id)
10212 foreach a $arcnos($id) {
10213 set d $arcstart($a)
10214 if {!$ta && $arctags($a) ne {}} {
10215 validate_arctags $a
10216 if {$arctags($a) ne {}} {
10217 lappend tagloc($id) [lindex $arctags($a) end]
10220 if {$ta || $arctags($a) ne {}} {
10221 set tomark [list $d]
10222 for {set j 0} {$j < [llength $tomark]} {incr j} {
10223 set dd [lindex $tomark $j]
10224 if {![info exists hastaggedancestor($dd)]} {
10225 if {[info exists done($dd)]} {
10226 foreach b $arcnos($dd) {
10227 lappend tomark $arcstart($b)
10229 if {[info exists tagloc($dd)]} {
10232 } elseif {[info exists queued($dd)]} {
10235 set hastaggedancestor($dd) 1
10239 if {![info exists queued($d)]} {
10242 if {![info exists hastaggedancestor($d)]} {
10249 foreach id [array names tagloc] {
10250 if {![info exists hastaggedancestor($id)]} {
10251 foreach t $tagloc($id) {
10252 if {[lsearch -exact $tags $t] < 0} {
10258 set t2 [clock clicks -milliseconds]
10261 # remove tags that are descendents of other tags
10262 for {set i 0} {$i < [llength $tags]} {incr i} {
10263 set a [lindex $tags $i]
10264 for {set j 0} {$j < $i} {incr j} {
10265 set b [lindex $tags $j]
10266 set r [anc_or_desc $a $b]
10268 set tags [lreplace $tags $j $j]
10271 } elseif {$r == -1} {
10272 set tags [lreplace $tags $i $i]
10279 if {[array names growing] ne {}} {
10280 # graph isn't finished, need to check if any tag could get
10281 # eclipsed by another tag coming later. Simply ignore any
10282 # tags that could later get eclipsed.
10285 if {[is_certain $t $origid]} {
10289 if {$tags eq $ctags} {
10290 set cached_dtags($origid) $tags
10295 set cached_dtags($origid) $tags
10297 set t3 [clock clicks -milliseconds]
10298 if {0 && $t3 - $t1 >= 100} {
10299 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10300 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10305 proc anctags {id} {
10306 global arcnos arcids arcout arcend arctags idtags allparents
10307 global growing cached_atags
10309 if {![info exists allparents($id)]} {
10312 set t1 [clock clicks -milliseconds]
10314 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10315 # part-way along an arc; check that arc first
10316 set a [lindex $arcnos($id) 0]
10317 if {$arctags($a) ne {}} {
10318 validate_arctags $a
10319 set i [lsearch -exact $arcids($a) $id]
10320 foreach t $arctags($a) {
10321 set j [lsearch -exact $arcids($a) $t]
10327 if {![info exists arcend($a)]} {
10331 if {[info exists idtags($id)]} {
10335 if {[info exists cached_atags($id)]} {
10336 return $cached_atags($id)
10340 set todo [list $id]
10344 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10345 set id [lindex $todo $i]
10347 set td [info exists hastaggeddescendent($id)]
10351 # ignore tags on starting node
10352 if {!$td && $i > 0} {
10353 if {[info exists idtags($id)]} {
10354 set tagloc($id) $id
10356 } elseif {[info exists cached_atags($id)]} {
10357 set tagloc($id) $cached_atags($id)
10361 foreach a $arcout($id) {
10362 if {!$td && $arctags($a) ne {}} {
10363 validate_arctags $a
10364 if {$arctags($a) ne {}} {
10365 lappend tagloc($id) [lindex $arctags($a) 0]
10368 if {![info exists arcend($a)]} continue
10370 if {$td || $arctags($a) ne {}} {
10371 set tomark [list $d]
10372 for {set j 0} {$j < [llength $tomark]} {incr j} {
10373 set dd [lindex $tomark $j]
10374 if {![info exists hastaggeddescendent($dd)]} {
10375 if {[info exists done($dd)]} {
10376 foreach b $arcout($dd) {
10377 if {[info exists arcend($b)]} {
10378 lappend tomark $arcend($b)
10381 if {[info exists tagloc($dd)]} {
10384 } elseif {[info exists queued($dd)]} {
10387 set hastaggeddescendent($dd) 1
10391 if {![info exists queued($d)]} {
10394 if {![info exists hastaggeddescendent($d)]} {
10400 set t2 [clock clicks -milliseconds]
10403 foreach id [array names tagloc] {
10404 if {![info exists hastaggeddescendent($id)]} {
10405 foreach t $tagloc($id) {
10406 if {[lsearch -exact $tags $t] < 0} {
10413 # remove tags that are ancestors of other tags
10414 for {set i 0} {$i < [llength $tags]} {incr i} {
10415 set a [lindex $tags $i]
10416 for {set j 0} {$j < $i} {incr j} {
10417 set b [lindex $tags $j]
10418 set r [anc_or_desc $a $b]
10420 set tags [lreplace $tags $j $j]
10423 } elseif {$r == 1} {
10424 set tags [lreplace $tags $i $i]
10431 if {[array names growing] ne {}} {
10432 # graph isn't finished, need to check if any tag could get
10433 # eclipsed by another tag coming later. Simply ignore any
10434 # tags that could later get eclipsed.
10437 if {[is_certain $origid $t]} {
10441 if {$tags eq $ctags} {
10442 set cached_atags($origid) $tags
10447 set cached_atags($origid) $tags
10449 set t3 [clock clicks -milliseconds]
10450 if {0 && $t3 - $t1 >= 100} {
10451 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10452 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10457 # Return the list of IDs that have heads that are descendents of id,
10458 # including id itself if it has a head.
10459 proc descheads {id} {
10460 global arcnos arcstart arcids archeads idheads cached_dheads
10463 if {![info exists allparents($id)]} {
10467 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10468 # part-way along an arc; check it first
10469 set a [lindex $arcnos($id) 0]
10470 if {$archeads($a) ne {}} {
10471 validate_archeads $a
10472 set i [lsearch -exact $arcids($a) $id]
10473 foreach t $archeads($a) {
10474 set j [lsearch -exact $arcids($a) $t]
10479 set id $arcstart($a)
10482 set todo [list $id]
10485 for {set i 0} {$i < [llength $todo]} {incr i} {
10486 set id [lindex $todo $i]
10487 if {[info exists cached_dheads($id)]} {
10488 set ret [concat $ret $cached_dheads($id)]
10490 if {[info exists idheads($id)]} {
10493 foreach a $arcnos($id) {
10494 if {$archeads($a) ne {}} {
10495 validate_archeads $a
10496 if {$archeads($a) ne {}} {
10497 set ret [concat $ret $archeads($a)]
10500 set d $arcstart($a)
10501 if {![info exists seen($d)]} {
10508 set ret [lsort -unique $ret]
10509 set cached_dheads($origid) $ret
10510 return [concat $ret $aret]
10513 proc addedtag {id} {
10514 global arcnos arcout cached_dtags cached_atags
10516 if {![info exists arcnos($id)]} return
10517 if {![info exists arcout($id)]} {
10518 recalcarc [lindex $arcnos($id) 0]
10520 catch {unset cached_dtags}
10521 catch {unset cached_atags}
10524 proc addedhead {hid head} {
10525 global arcnos arcout cached_dheads
10527 if {![info exists arcnos($hid)]} return
10528 if {![info exists arcout($hid)]} {
10529 recalcarc [lindex $arcnos($hid) 0]
10531 catch {unset cached_dheads}
10534 proc removedhead {hid head} {
10535 global cached_dheads
10537 catch {unset cached_dheads}
10540 proc movedhead {hid head} {
10541 global arcnos arcout cached_dheads
10543 if {![info exists arcnos($hid)]} return
10544 if {![info exists arcout($hid)]} {
10545 recalcarc [lindex $arcnos($hid) 0]
10547 catch {unset cached_dheads}
10550 proc changedrefs {} {
10551 global cached_dheads cached_dtags cached_atags
10552 global arctags archeads arcnos arcout idheads idtags
10554 foreach id [concat [array names idheads] [array names idtags]] {
10555 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10556 set a [lindex $arcnos($id) 0]
10557 if {![info exists donearc($a)]} {
10563 catch {unset cached_dtags}
10564 catch {unset cached_atags}
10565 catch {unset cached_dheads}
10568 proc rereadrefs {} {
10569 global idtags idheads idotherrefs mainheadid
10571 set refids [concat [array names idtags] \
10572 [array names idheads] [array names idotherrefs]]
10573 foreach id $refids {
10574 if {![info exists ref($id)]} {
10575 set ref($id) [listrefs $id]
10578 set oldmainhead $mainheadid
10581 set refids [lsort -unique [concat $refids [array names idtags] \
10582 [array names idheads] [array names idotherrefs]]]
10583 foreach id $refids {
10584 set v [listrefs $id]
10585 if {![info exists ref($id)] || $ref($id) != $v} {
10589 if {$oldmainhead ne $mainheadid} {
10590 redrawtags $oldmainhead
10591 redrawtags $mainheadid
10596 proc listrefs {id} {
10597 global idtags idheads idotherrefs
10600 if {[info exists idtags($id)]} {
10604 if {[info exists idheads($id)]} {
10605 set y $idheads($id)
10608 if {[info exists idotherrefs($id)]} {
10609 set z $idotherrefs($id)
10611 return [list $x $y $z]
10614 proc showtag {tag isnew} {
10615 global ctext tagcontents tagids linknum tagobjid
10618 addtohistory [list showtag $tag 0] savectextpos
10620 $ctext conf -state normal
10624 if {![info exists tagcontents($tag)]} {
10626 set tagcontents($tag) [exec git cat-file tag $tag]
10629 if {[info exists tagcontents($tag)]} {
10630 set text $tagcontents($tag)
10632 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
10634 appendwithlinks $text {}
10635 maybe_scroll_ctext 1
10636 $ctext conf -state disabled
10648 if {[info exists gitktmpdir]} {
10649 catch {file delete -force $gitktmpdir}
10653 proc mkfontdisp {font top which} {
10654 global fontattr fontpref $font NS use_ttk
10656 set fontpref($font) [set $font]
10657 ${NS}::button $top.${font}but -text $which \
10658 -command [list choosefont $font $which]
10659 ${NS}::label $top.$font -relief flat -font $font \
10660 -text $fontattr($font,family) -justify left
10661 grid x $top.${font}but $top.$font -sticky w
10664 proc choosefont {font which} {
10665 global fontparam fontlist fonttop fontattr
10668 set fontparam(which) $which
10669 set fontparam(font) $font
10670 set fontparam(family) [font actual $font -family]
10671 set fontparam(size) $fontattr($font,size)
10672 set fontparam(weight) $fontattr($font,weight)
10673 set fontparam(slant) $fontattr($font,slant)
10676 if {![winfo exists $top]} {
10678 eval font config sample [font actual $font]
10680 make_transient $top $prefstop
10681 wm title $top [mc "Gitk font chooser"]
10682 ${NS}::label $top.l -textvariable fontparam(which)
10683 pack $top.l -side top
10684 set fontlist [lsort [font families]]
10685 ${NS}::frame $top.f
10686 listbox $top.f.fam -listvariable fontlist \
10687 -yscrollcommand [list $top.f.sb set]
10688 bind $top.f.fam <<ListboxSelect>> selfontfam
10689 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10690 pack $top.f.sb -side right -fill y
10691 pack $top.f.fam -side left -fill both -expand 1
10692 pack $top.f -side top -fill both -expand 1
10693 ${NS}::frame $top.g
10694 spinbox $top.g.size -from 4 -to 40 -width 4 \
10695 -textvariable fontparam(size) \
10696 -validatecommand {string is integer -strict %s}
10697 checkbutton $top.g.bold -padx 5 \
10698 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10699 -variable fontparam(weight) -onvalue bold -offvalue normal
10700 checkbutton $top.g.ital -padx 5 \
10701 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
10702 -variable fontparam(slant) -onvalue italic -offvalue roman
10703 pack $top.g.size $top.g.bold $top.g.ital -side left
10704 pack $top.g -side top
10705 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10707 $top.c create text 100 25 -anchor center -text $which -font sample \
10708 -fill black -tags text
10709 bind $top.c <Configure> [list centertext $top.c]
10710 pack $top.c -side top -fill x
10711 ${NS}::frame $top.buts
10712 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10713 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10714 bind $top <Key-Return> fontok
10715 bind $top <Key-Escape> fontcan
10716 grid $top.buts.ok $top.buts.can
10717 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10718 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10719 pack $top.buts -side bottom -fill x
10720 trace add variable fontparam write chg_fontparam
10723 $top.c itemconf text -text $which
10725 set i [lsearch -exact $fontlist $fontparam(family)]
10727 $top.f.fam selection set $i
10732 proc centertext {w} {
10733 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10737 global fontparam fontpref prefstop
10739 set f $fontparam(font)
10740 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10741 if {$fontparam(weight) eq "bold"} {
10742 lappend fontpref($f) "bold"
10744 if {$fontparam(slant) eq "italic"} {
10745 lappend fontpref($f) "italic"
10748 $w conf -text $fontparam(family) -font $fontpref($f)
10754 global fonttop fontparam
10756 if {[info exists fonttop]} {
10757 catch {destroy $fonttop}
10758 catch {font delete sample}
10764 if {[package vsatisfies [package provide Tk] 8.6]} {
10765 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10766 # function to make use of it.
10767 proc choosefont {font which} {
10768 tk fontchooser configure -title $which -font $font \
10769 -command [list on_choosefont $font $which]
10770 tk fontchooser show
10772 proc on_choosefont {font which newfont} {
10774 puts stderr "$font $newfont"
10775 array set f [font actual $newfont]
10776 set fontparam(which) $which
10777 set fontparam(font) $font
10778 set fontparam(family) $f(-family)
10779 set fontparam(size) $f(-size)
10780 set fontparam(weight) $f(-weight)
10781 set fontparam(slant) $f(-slant)
10786 proc selfontfam {} {
10787 global fonttop fontparam
10789 set i [$fonttop.f.fam curselection]
10791 set fontparam(family) [$fonttop.f.fam get $i]
10795 proc chg_fontparam {v sub op} {
10798 font config sample -$sub $fontparam($sub)
10801 # Create a property sheet tab page
10802 proc create_prefs_page {w} {
10804 set parent [join [lrange [split $w .] 0 end-1] .]
10805 if {[winfo class $parent] eq "TNotebook"} {
10808 ${NS}::labelframe $w
10812 proc prefspage_general {notebook} {
10813 global NS maxwidth maxgraphpct showneartags showlocalchanges
10814 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10815 global hideremotes want_ttk have_ttk
10817 set page [create_prefs_page $notebook.general]
10819 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
10820 grid $page.ldisp - -sticky w -pady 10
10821 ${NS}::label $page.spacer -text " "
10822 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
10823 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10824 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
10825 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
10826 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10827 grid x $page.maxpctl $page.maxpct -sticky w
10828 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
10829 -variable showlocalchanges
10830 grid x $page.showlocal -sticky w
10831 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
10832 -variable autoselect
10833 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10834 grid x $page.autoselect $page.autosellen -sticky w
10835 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
10836 -variable hideremotes
10837 grid x $page.hideremotes -sticky w
10839 ${NS}::label $page.ddisp -text [mc "Diff display options"]
10840 grid $page.ddisp - -sticky w -pady 10
10841 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
10842 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10843 grid x $page.tabstopl $page.tabstop -sticky w
10844 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags"] \
10845 -variable showneartags
10846 grid x $page.ntag -sticky w
10847 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
10848 -variable limitdiffs
10849 grid x $page.ldiff -sticky w
10850 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
10851 -variable perfile_attrs
10852 grid x $page.lattr -sticky w
10854 ${NS}::entry $page.extdifft -textvariable extdifftool
10855 ${NS}::frame $page.extdifff
10856 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
10857 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10858 pack $page.extdifff.l $page.extdifff.b -side left
10859 pack configure $page.extdifff.l -padx 10
10860 grid x $page.extdifff $page.extdifft -sticky ew
10862 ${NS}::label $page.lgen -text [mc "General options"]
10863 grid $page.lgen - -sticky w -pady 10
10864 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
10865 -text [mc "Use themed widgets"]
10867 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
10869 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
10871 grid x $page.want_ttk $page.ttk_note -sticky w
10875 proc prefspage_colors {notebook} {
10876 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10878 set page [create_prefs_page $notebook.colors]
10880 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
10881 grid $page.cdisp - -sticky w -pady 10
10882 label $page.ui -padx 40 -relief sunk -background $uicolor
10883 ${NS}::button $page.uibut -text [mc "Interface"] \
10884 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
10885 grid x $page.uibut $page.ui -sticky w
10886 label $page.bg -padx 40 -relief sunk -background $bgcolor
10887 ${NS}::button $page.bgbut -text [mc "Background"] \
10888 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
10889 grid x $page.bgbut $page.bg -sticky w
10890 label $page.fg -padx 40 -relief sunk -background $fgcolor
10891 ${NS}::button $page.fgbut -text [mc "Foreground"] \
10892 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
10893 grid x $page.fgbut $page.fg -sticky w
10894 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10895 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
10896 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
10897 [list $ctext tag conf d0 -foreground]]
10898 grid x $page.diffoldbut $page.diffold -sticky w
10899 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10900 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
10901 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
10902 [list $ctext tag conf dresult -foreground]]
10903 grid x $page.diffnewbut $page.diffnew -sticky w
10904 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10905 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
10906 -command [list choosecolor diffcolors 2 $page.hunksep \
10907 [mc "diff hunk header"] \
10908 [list $ctext tag conf hunksep -foreground]]
10909 grid x $page.hunksepbut $page.hunksep -sticky w
10910 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
10911 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
10912 -command [list choosecolor markbgcolor {} $page.markbgsep \
10913 [mc "marked line background"] \
10914 [list $ctext tag conf omark -background]]
10915 grid x $page.markbgbut $page.markbgsep -sticky w
10916 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10917 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
10918 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
10919 grid x $page.selbgbut $page.selbgsep -sticky w
10923 proc prefspage_fonts {notebook} {
10925 set page [create_prefs_page $notebook.fonts]
10926 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
10927 grid $page.cfont - -sticky w -pady 10
10928 mkfontdisp mainfont $page [mc "Main font"]
10929 mkfontdisp textfont $page [mc "Diff display font"]
10930 mkfontdisp uifont $page [mc "User interface font"]
10935 global maxwidth maxgraphpct use_ttk NS
10936 global oldprefs prefstop showneartags showlocalchanges
10937 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10938 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10939 global hideremotes want_ttk have_ttk
10943 if {[winfo exists $top]} {
10947 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10948 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10949 set oldprefs($v) [set $v]
10952 wm title $top [mc "Gitk preferences"]
10953 make_transient $top .
10955 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
10956 set notebook [ttk::notebook $top.notebook]
10958 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
10961 lappend pages [prefspage_general $notebook] [mc "General"]
10962 lappend pages [prefspage_colors $notebook] [mc "Colors"]
10963 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
10964 foreach {page title} $pages {
10965 if {$use_notebook} {
10966 $notebook add $page -text $title
10968 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
10969 -text $title -command [list raise $page]]
10970 $page configure -text $title
10971 grid $btn -row 0 -column [incr col] -sticky w
10972 grid $page -row 1 -column 0 -sticky news -columnspan 100
10976 if {!$use_notebook} {
10977 grid columnconfigure $notebook 0 -weight 1
10978 grid rowconfigure $notebook 1 -weight 1
10979 raise [lindex $pages 0]
10982 grid $notebook -sticky news -padx 2 -pady 2
10983 grid rowconfigure $top 0 -weight 1
10984 grid columnconfigure $top 0 -weight 1
10986 ${NS}::frame $top.buts
10987 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10988 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10989 bind $top <Key-Return> prefsok
10990 bind $top <Key-Escape> prefscan
10991 grid $top.buts.ok $top.buts.can
10992 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10993 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10994 grid $top.buts - - -pady 10 -sticky ew
10995 grid columnconfigure $top 2 -weight 1
10996 bind $top <Visibility> [list focus $top.buts.ok]
10999 proc choose_extdiff {} {
11002 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11004 set extdifftool $prog
11008 proc choosecolor {v vi w x cmd} {
11011 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11012 -title [mc "Gitk: choose color for %s" $x]]
11013 if {$c eq {}} return
11014 $w conf -background $c
11019 proc setselbg {c} {
11020 global bglist cflist
11021 foreach w $bglist {
11022 $w configure -selectbackground $c
11024 $cflist tag configure highlight \
11025 -background [$cflist cget -selectbackground]
11026 allcanvs itemconf secsel -fill $c
11029 # This sets the background color and the color scheme for the whole UI.
11030 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11031 # if we don't specify one ourselves, which makes the checkbuttons and
11032 # radiobuttons look bad. This chooses white for selectColor if the
11033 # background color is light, or black if it is dark.
11035 if {[tk windowingsystem] eq "win32"} { return }
11036 set bg [winfo rgb . $c]
11038 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11041 tk_setPalette background $c selectColor $selc
11047 foreach w $bglist {
11048 $w conf -background $c
11055 foreach w $fglist {
11056 $w conf -foreground $c
11058 allcanvs itemconf text -fill $c
11059 $canv itemconf circle -outline $c
11060 $canv itemconf markid -outline $c
11064 global oldprefs prefstop
11066 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11067 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11069 set $v $oldprefs($v)
11071 catch {destroy $prefstop}
11077 global maxwidth maxgraphpct
11078 global oldprefs prefstop showneartags showlocalchanges
11079 global fontpref mainfont textfont uifont
11080 global limitdiffs treediffs perfile_attrs
11083 catch {destroy $prefstop}
11087 if {$mainfont ne $fontpref(mainfont)} {
11088 set mainfont $fontpref(mainfont)
11089 parsefont mainfont $mainfont
11090 eval font configure mainfont [fontflags mainfont]
11091 eval font configure mainfontbold [fontflags mainfont 1]
11095 if {$textfont ne $fontpref(textfont)} {
11096 set textfont $fontpref(textfont)
11097 parsefont textfont $textfont
11098 eval font configure textfont [fontflags textfont]
11099 eval font configure textfontbold [fontflags textfont 1]
11101 if {$uifont ne $fontpref(uifont)} {
11102 set uifont $fontpref(uifont)
11103 parsefont uifont $uifont
11104 eval font configure uifont [fontflags uifont]
11107 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11108 if {$showlocalchanges} {
11114 if {$limitdiffs != $oldprefs(limitdiffs) ||
11115 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11116 # treediffs elements are limited by path;
11117 # won't have encodings cached if perfile_attrs was just turned on
11118 catch {unset treediffs}
11120 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11121 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11123 } elseif {$showneartags != $oldprefs(showneartags) ||
11124 $limitdiffs != $oldprefs(limitdiffs)} {
11127 if {$hideremotes != $oldprefs(hideremotes)} {
11132 proc formatdate {d} {
11133 global datetimeformat
11135 set d [clock format [lindex $d 0] -format $datetimeformat]
11140 # This list of encoding names and aliases is distilled from
11141 # http://www.iana.org/assignments/character-sets.
11142 # Not all of them are supported by Tcl.
11143 set encoding_aliases {
11144 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11145 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11146 { ISO-10646-UTF-1 csISO10646UTF1 }
11147 { ISO_646.basic:1983 ref csISO646basic1983 }
11148 { INVARIANT csINVARIANT }
11149 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11150 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11151 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11152 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11153 { NATS-DANO iso-ir-9-1 csNATSDANO }
11154 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11155 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11156 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11157 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11158 { ISO-2022-KR csISO2022KR }
11160 { ISO-2022-JP csISO2022JP }
11161 { ISO-2022-JP-2 csISO2022JP2 }
11162 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11163 csISO13JISC6220jp }
11164 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11165 { IT iso-ir-15 ISO646-IT csISO15Italian }
11166 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11167 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11168 { greek7-old iso-ir-18 csISO18Greek7Old }
11169 { latin-greek iso-ir-19 csISO19LatinGreek }
11170 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11171 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11172 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11173 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11174 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11175 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11176 { INIS iso-ir-49 csISO49INIS }
11177 { INIS-8 iso-ir-50 csISO50INIS8 }
11178 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11179 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11180 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11181 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11182 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11183 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11184 csISO60Norwegian1 }
11185 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11186 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11187 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11188 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11189 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11190 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11191 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11192 { greek7 iso-ir-88 csISO88Greek7 }
11193 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11194 { iso-ir-90 csISO90 }
11195 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11196 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11197 csISO92JISC62991984b }
11198 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11199 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11200 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11201 csISO95JIS62291984handadd }
11202 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11203 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11204 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11205 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11206 CP819 csISOLatin1 }
11207 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11208 { T.61-7bit iso-ir-102 csISO102T617bit }
11209 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11210 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11211 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11212 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11213 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11214 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11215 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11216 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11217 arabic csISOLatinArabic }
11218 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11219 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11220 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11221 greek greek8 csISOLatinGreek }
11222 { T.101-G2 iso-ir-128 csISO128T101G2 }
11223 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11225 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11226 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11227 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11228 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11229 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11230 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11231 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11232 csISOLatinCyrillic }
11233 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11234 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11235 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11236 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11237 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11238 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11239 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11240 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11241 { ISO_10367-box iso-ir-155 csISO10367Box }
11242 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11243 { latin-lap lap iso-ir-158 csISO158Lap }
11244 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11245 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11248 { JIS_X0201 X0201 csHalfWidthKatakana }
11249 { KSC5636 ISO646-KR csKSC5636 }
11250 { ISO-10646-UCS-2 csUnicode }
11251 { ISO-10646-UCS-4 csUCS4 }
11252 { DEC-MCS dec csDECMCS }
11253 { hp-roman8 roman8 r8 csHPRoman8 }
11254 { macintosh mac csMacintosh }
11255 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11257 { IBM038 EBCDIC-INT cp038 csIBM038 }
11258 { IBM273 CP273 csIBM273 }
11259 { IBM274 EBCDIC-BE CP274 csIBM274 }
11260 { IBM275 EBCDIC-BR cp275 csIBM275 }
11261 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11262 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11263 { IBM280 CP280 ebcdic-cp-it csIBM280 }
11264 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11265 { IBM284 CP284 ebcdic-cp-es csIBM284 }
11266 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11267 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11268 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11269 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11270 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11271 { IBM424 cp424 ebcdic-cp-he csIBM424 }
11272 { IBM437 cp437 437 csPC8CodePage437 }
11273 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11274 { IBM775 cp775 csPC775Baltic }
11275 { IBM850 cp850 850 csPC850Multilingual }
11276 { IBM851 cp851 851 csIBM851 }
11277 { IBM852 cp852 852 csPCp852 }
11278 { IBM855 cp855 855 csIBM855 }
11279 { IBM857 cp857 857 csIBM857 }
11280 { IBM860 cp860 860 csIBM860 }
11281 { IBM861 cp861 861 cp-is csIBM861 }
11282 { IBM862 cp862 862 csPC862LatinHebrew }
11283 { IBM863 cp863 863 csIBM863 }
11284 { IBM864 cp864 csIBM864 }
11285 { IBM865 cp865 865 csIBM865 }
11286 { IBM866 cp866 866 csIBM866 }
11287 { IBM868 CP868 cp-ar csIBM868 }
11288 { IBM869 cp869 869 cp-gr csIBM869 }
11289 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11290 { IBM871 CP871 ebcdic-cp-is csIBM871 }
11291 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11292 { IBM891 cp891 csIBM891 }
11293 { IBM903 cp903 csIBM903 }
11294 { IBM904 cp904 904 csIBBM904 }
11295 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11296 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11297 { IBM1026 CP1026 csIBM1026 }
11298 { EBCDIC-AT-DE csIBMEBCDICATDE }
11299 { EBCDIC-AT-DE-A csEBCDICATDEA }
11300 { EBCDIC-CA-FR csEBCDICCAFR }
11301 { EBCDIC-DK-NO csEBCDICDKNO }
11302 { EBCDIC-DK-NO-A csEBCDICDKNOA }
11303 { EBCDIC-FI-SE csEBCDICFISE }
11304 { EBCDIC-FI-SE-A csEBCDICFISEA }
11305 { EBCDIC-FR csEBCDICFR }
11306 { EBCDIC-IT csEBCDICIT }
11307 { EBCDIC-PT csEBCDICPT }
11308 { EBCDIC-ES csEBCDICES }
11309 { EBCDIC-ES-A csEBCDICESA }
11310 { EBCDIC-ES-S csEBCDICESS }
11311 { EBCDIC-UK csEBCDICUK }
11312 { EBCDIC-US csEBCDICUS }
11313 { UNKNOWN-8BIT csUnknown8BiT }
11314 { MNEMONIC csMnemonic }
11316 { VISCII csVISCII }
11319 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11320 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11321 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11322 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11323 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11324 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11325 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11326 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11327 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11328 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11329 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11330 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11331 { IBM1047 IBM-1047 }
11332 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11333 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11334 { UNICODE-1-1 csUnicode11 }
11335 { CESU-8 csCESU-8 }
11336 { BOCU-1 csBOCU-1 }
11337 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11338 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11340 { ISO-8859-15 ISO_8859-15 Latin-9 }
11341 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11342 { GBK CP936 MS936 windows-936 }
11343 { JIS_Encoding csJISEncoding }
11344 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11345 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11347 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11348 { ISO-10646-UCS-Basic csUnicodeASCII }
11349 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11350 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11351 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11352 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11353 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11354 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11355 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11356 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11357 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11358 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11359 { Adobe-Standard-Encoding csAdobeStandardEncoding }
11360 { Ventura-US csVenturaUS }
11361 { Ventura-International csVenturaInternational }
11362 { PC8-Danish-Norwegian csPC8DanishNorwegian }
11363 { PC8-Turkish csPC8Turkish }
11364 { IBM-Symbols csIBMSymbols }
11365 { IBM-Thai csIBMThai }
11366 { HP-Legal csHPLegal }
11367 { HP-Pi-font csHPPiFont }
11368 { HP-Math8 csHPMath8 }
11369 { Adobe-Symbol-Encoding csHPPSMath }
11370 { HP-DeskTop csHPDesktop }
11371 { Ventura-Math csVenturaMath }
11372 { Microsoft-Publishing csMicrosoftPublishing }
11373 { Windows-31J csWindows31J }
11374 { GB2312 csGB2312 }
11378 proc tcl_encoding {enc} {
11379 global encoding_aliases tcl_encoding_cache
11380 if {[info exists tcl_encoding_cache($enc)]} {
11381 return $tcl_encoding_cache($enc)
11383 set names [encoding names]
11384 set lcnames [string tolower $names]
11385 set enc [string tolower $enc]
11386 set i [lsearch -exact $lcnames $enc]
11388 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11389 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11390 set i [lsearch -exact $lcnames $encx]
11394 foreach l $encoding_aliases {
11395 set ll [string tolower $l]
11396 if {[lsearch -exact $ll $enc] < 0} continue
11397 # look through the aliases for one that tcl knows about
11399 set i [lsearch -exact $lcnames $e]
11401 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11402 set i [lsearch -exact $lcnames $ex]
11412 set tclenc [lindex $names $i]
11414 set tcl_encoding_cache($enc) $tclenc
11418 proc gitattr {path attr default} {
11419 global path_attr_cache
11420 if {[info exists path_attr_cache($attr,$path)]} {
11421 set r $path_attr_cache($attr,$path)
11423 set r "unspecified"
11424 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11425 regexp "(.*): $attr: (.*)" $line m f r
11427 set path_attr_cache($attr,$path) $r
11429 if {$r eq "unspecified"} {
11435 proc cache_gitattr {attr pathlist} {
11436 global path_attr_cache
11438 foreach path $pathlist {
11439 if {![info exists path_attr_cache($attr,$path)]} {
11440 lappend newlist $path
11444 if {[tk windowingsystem] == "win32"} {
11445 # windows has a 32k limit on the arguments to a command...
11448 while {$newlist ne {}} {
11449 set head [lrange $newlist 0 [expr {$lim - 1}]]
11450 set newlist [lrange $newlist $lim end]
11451 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11452 foreach row [split $rlist "\n"] {
11453 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11454 if {[string index $path 0] eq "\""} {
11455 set path [encoding convertfrom [lindex $path 0]]
11457 set path_attr_cache($attr,$path) $value
11464 proc get_path_encoding {path} {
11465 global gui_encoding perfile_attrs
11466 set tcl_enc $gui_encoding
11467 if {$path ne {} && $perfile_attrs} {
11468 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11476 # First check that Tcl/Tk is recent enough
11477 if {[catch {package require Tk 8.4} err]} {
11478 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11479 Gitk requires at least Tcl/Tk 8.4." list
11484 set wrcomcmd "git diff-tree --stdin -p --pretty"
11488 set gitencoding [exec git config --get i18n.commitencoding]
11491 set gitencoding [exec git config --get i18n.logoutputencoding]
11493 if {$gitencoding == ""} {
11494 set gitencoding "utf-8"
11496 set tclencoding [tcl_encoding $gitencoding]
11497 if {$tclencoding == {}} {
11498 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11501 set gui_encoding [encoding system]
11503 set enc [exec git config --get gui.encoding]
11505 set tclenc [tcl_encoding $enc]
11506 if {$tclenc ne {}} {
11507 set gui_encoding $tclenc
11509 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11514 if {[tk windowingsystem] eq "aqua"} {
11515 set mainfont {{Lucida Grande} 9}
11516 set textfont {Monaco 9}
11517 set uifont {{Lucida Grande} 9 bold}
11519 set mainfont {Helvetica 9}
11520 set textfont {Courier 9}
11521 set uifont {Helvetica 9 bold}
11524 set findmergefiles 0
11532 set cmitmode "patch"
11533 set wrapcomment "none"
11538 set showlocalchanges 1
11540 set datetimeformat "%Y-%m-%d %H:%M:%S"
11543 set perfile_attrs 0
11546 if {[tk windowingsystem] eq "aqua"} {
11547 set extdifftool "opendiff"
11549 set extdifftool "meld"
11552 set colors {green red blue magenta darkgrey brown orange}
11553 if {[tk windowingsystem] eq "win32"} {
11554 set uicolor SystemButtonFace
11555 set bgcolor SystemWindow
11556 set fgcolor SystemButtonText
11557 set selectbgcolor SystemHighlight
11562 set selectbgcolor gray85
11564 set diffcolors {red "#00a000" blue}
11568 set markbgcolor "#e0e0ff"
11570 set circlecolors {white blue gray blue blue}
11572 # button for popping up context menus
11573 if {[tk windowingsystem] eq "aqua"} {
11574 set ctxbut <Button-2>
11576 set ctxbut <Button-3>
11579 ## For msgcat loading, first locate the installation location.
11580 if { [info exists ::env(GITK_MSGSDIR)] } {
11581 ## Msgsdir was manually set in the environment.
11582 set gitk_msgsdir $::env(GITK_MSGSDIR)
11584 ## Let's guess the prefix from argv0.
11585 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11586 set gitk_libdir [file join $gitk_prefix share gitk lib]
11587 set gitk_msgsdir [file join $gitk_libdir msgs]
11591 ## Internationalization (i18n) through msgcat and gettext. See
11592 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11593 package require msgcat
11594 namespace import ::msgcat::mc
11595 ## And eventually load the actual message catalog
11596 ::msgcat::mcload $gitk_msgsdir
11598 catch {source ~/.gitk}
11600 parsefont mainfont $mainfont
11601 eval font create mainfont [fontflags mainfont]
11602 eval font create mainfontbold [fontflags mainfont 1]
11604 parsefont textfont $textfont
11605 eval font create textfont [fontflags textfont]
11606 eval font create textfontbold [fontflags textfont 1]
11608 parsefont uifont $uifont
11609 eval font create uifont [fontflags uifont]
11615 # check that we can find a .git directory somewhere...
11616 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
11617 show_error {} . [mc "Cannot find a git repository here."]
11622 set selectheadid {}
11625 set cmdline_files {}
11627 set revtreeargscmd {}
11628 foreach arg $argv {
11629 switch -glob -- $arg {
11632 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11635 "--select-commit=*" {
11636 set selecthead [string range $arg 16 end]
11639 set revtreeargscmd [string range $arg 10 end]
11642 lappend revtreeargs $arg
11648 if {$selecthead eq "HEAD"} {
11652 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11653 # no -- on command line, but some arguments (other than --argscmd)
11655 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11656 set cmdline_files [split $f "\n"]
11657 set n [llength $cmdline_files]
11658 set revtreeargs [lrange $revtreeargs 0 end-$n]
11659 # Unfortunately git rev-parse doesn't produce an error when
11660 # something is both a revision and a filename. To be consistent
11661 # with git log and git rev-list, check revtreeargs for filenames.
11662 foreach arg $revtreeargs {
11663 if {[file exists $arg]} {
11664 show_error {} . [mc "Ambiguous argument '%s': both revision\
11665 and filename" $arg]
11670 # unfortunately we get both stdout and stderr in $err,
11671 # so look for "fatal:".
11672 set i [string first "fatal:" $err]
11674 set err [string range $err [expr {$i + 6}] end]
11676 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11681 set nullid "0000000000000000000000000000000000000000"
11682 set nullid2 "0000000000000000000000000000000000000001"
11683 set nullfile "/dev/null"
11685 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11686 if {![info exists have_ttk]} {
11687 set have_ttk [llength [info commands ::ttk::style]]
11689 set use_ttk [expr {$have_ttk && $want_ttk}]
11690 set NS [expr {$use_ttk ? "ttk" : ""}]
11692 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11695 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11696 set show_notes "--show-notes"
11706 set highlight_paths {}
11708 set searchdirn -forwards
11711 set diffelide {0 0}
11712 set markingmatches 0
11713 set linkentercount 0
11714 set need_redisplay 0
11721 set selectedhlview [mc "None"]
11722 set highlight_related [mc "None"]
11723 set highlight_files {}
11724 set viewfiles(0) {}
11727 set viewargscmd(0) {}
11729 set selectedline {}
11737 set hasworktree [hasworktree]
11739 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
11740 set cdup [exec git rev-parse --show-cdup]
11742 set worktree [exec git rev-parse --show-toplevel]
11746 image create photo gitlogo -width 16 -height 16
11748 image create photo gitlogominus -width 4 -height 2
11749 gitlogominus put #C00000 -to 0 0 4 2
11750 gitlogo copy gitlogominus -to 1 5
11751 gitlogo copy gitlogominus -to 6 5
11752 gitlogo copy gitlogominus -to 11 5
11753 image delete gitlogominus
11755 image create photo gitlogoplus -width 4 -height 4
11756 gitlogoplus put #008000 -to 1 0 3 4
11757 gitlogoplus put #008000 -to 0 1 4 3
11758 gitlogo copy gitlogoplus -to 1 9
11759 gitlogo copy gitlogoplus -to 6 9
11760 gitlogo copy gitlogoplus -to 11 9
11761 image delete gitlogoplus
11763 image create photo gitlogo32 -width 32 -height 32
11764 gitlogo32 copy gitlogo -zoom 2 2
11766 wm iconphoto . -default gitlogo gitlogo32
11768 # wait for the window to become visible
11769 tkwait visibility .
11770 wm title . "$appname: [reponame]"
11774 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11775 # create a view for the files/dirs specified on the command line
11779 set viewname(1) [mc "Command line"]
11780 set viewfiles(1) $cmdline_files
11781 set viewargs(1) $revtreeargs
11782 set viewargscmd(1) $revtreeargscmd
11786 .bar.view entryconf [mca "Edit view..."] -state normal
11787 .bar.view entryconf [mca "Delete view"] -state normal
11790 if {[info exists permviews]} {
11791 foreach v $permviews {
11794 set viewname($n) [lindex $v 0]
11795 set viewfiles($n) [lindex $v 1]
11796 set viewargs($n) [lindex $v 2]
11797 set viewargscmd($n) [lindex $v 3]
11803 if {[tk windowingsystem] eq "win32"} {
11811 # indent-tabs-mode: t